Refactor GHCi UI to fix #11606, #12091, #15721, #16096

Instead of parsing and executing a statement or declaration directly we
now parse them first and then execute in a separate step. This gives us
the flexibility to inspect the parsed declaration before execution.
Using this we now inspect parsed declarations, and if it's a single
declaration of form `x = y` we execute it as `let x = y` instead, fixing
a ton of problems caused by poor declaration support in GHCi.

To avoid any users of the modules I left `execStmt` and `runDecls`
unchanged and added `execStmt'` and `runDecls'` which work on parsed
statements/declarations.

5 files changed, 66 insertions, 41 deletions

diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index aa24ee0a5d..aa9748ee35 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -149,8 +149,7 @@ deSugar hsc_env
           keep_alive <- readIORef keep_var
         ; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules
               final_prs = addExportFlagsAndRules target export_set keep_alive
-                                                 mod rules_for_locals
-                                                 (fromOL all_prs)
+                                                 rules_for_locals (fromOL all_prs)
 
               final_pgm = combineEvBinds ds_ev_binds final_prs
         -- Notice that we put the whole lot in a big Rec, even the foreign binds
@@ -284,9 +283,9 @@ deSugarExpr hsc_env tc_expr = do {
 -}
 
 addExportFlagsAndRules
-    :: HscTarget -> NameSet -> NameSet -> Module -> [CoreRule]
+    :: HscTarget -> NameSet -> NameSet -> [CoreRule]
     -> [(Id, t)] -> [(Id, t)]
-addExportFlagsAndRules target exports keep_alive mod rules prs
+addExportFlagsAndRules target exports keep_alive rules prs
   = mapFst add_one prs
   where
     add_one bndr = add_rules name (add_export name bndr)
@@ -319,20 +318,10 @@ addExportFlagsAndRules target exports keep_alive mod rules prs
         -- simplification), and retain them all in the TypeEnv so they are
         -- available from the command line.
         --
-        -- Most of the time, this can be accomplished by use of
-        -- targetRetainsAllBindings, which returns True if the target is
-        -- HscInteractive. However, there are cases when one can use GHCi with
-        -- a target other than HscInteractive (e.g., with the -fobject-code
-        -- flag enabled, as in #12091). In such scenarios,
-        -- targetRetainsAllBindings can return False, so we must fall back on
-        -- isInteractiveModule to be doubly sure we export entities defined in
-        -- a GHCi session.
-        --
         -- isExternalName separates the user-defined top-level names from those
         -- introduced by the type checker.
     is_exported :: Name -> Bool
-    is_exported | targetRetainsAllBindings target
-                  || isInteractiveModule mod      = isExternalName
+    is_exported | targetRetainsAllBindings target = isExternalName
                 | otherwise                       = (`elemNameSet` exports)
 
 {-
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 8817b41c8a..f289cd4229 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -96,11 +96,11 @@ module GHC (
         -- * Interactive evaluation
 
         -- ** Executing statements
-        execStmt, ExecOptions(..), execOptions, ExecResult(..),
+        execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..),
         resumeExec,
 
         -- ** Adding new declarations
-        runDecls, runDeclsWithLocation,
+        runDecls, runDeclsWithLocation, runParsedDecls,
 
         -- ** Get/set the current context
         parseImportDecl,
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 2ff2ca07af..9a4dd4aafe 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -63,8 +63,8 @@ module HscMain
     , hscGetModuleInterface
     , hscRnImportDecls
     , hscTcRnLookupRdrName
-    , hscStmt, hscStmtWithLocation, hscParsedStmt
-    , hscDecls, hscDeclsWithLocation
+    , hscStmt, hscParseStmtWithLocation, hscStmtWithLocation, hscParsedStmt
+    , hscDecls, hscParseDeclsWithLocation, hscDeclsWithLocation, hscParsedDecls
     , hscTcExpr, TcRnExprMode(..), hscImport, hscKcType
     , hscParseExpr
     , hscCompileCoreExpr
@@ -1602,17 +1602,27 @@ hscDecls :: HscEnv
          -> IO ([TyThing], InteractiveContext)
 hscDecls hsc_env str = hscDeclsWithLocation hsc_env str "<interactive>" 1
 
+hscParseDeclsWithLocation :: HscEnv -> String -> Int -> String -> IO [LHsDecl GhcPs]
+hscParseDeclsWithLocation hsc_env source line_num str = do
+    L _ (HsModule{ hsmodDecls = decls }) <-
+      runInteractiveHsc hsc_env $
+        hscParseThingWithLocation source line_num parseModule str
+    return decls
+
 -- | Compile a decls
 hscDeclsWithLocation :: HscEnv
                      -> String -- ^ The statement
                      -> String -- ^ The source
                      -> Int    -- ^ Starting line
                      -> IO ([TyThing], InteractiveContext)
-hscDeclsWithLocation hsc_env0 str source linenumber =
- runInteractiveHsc hsc_env0 $ do
+hscDeclsWithLocation hsc_env str source linenumber = do
     L _ (HsModule{ hsmodDecls = decls }) <-
+      runInteractiveHsc hsc_env $
         hscParseThingWithLocation source linenumber parseModule str
+    hscParsedDecls hsc_env decls
 
+hscParsedDecls :: HscEnv -> [LHsDecl GhcPs] -> IO ([TyThing], InteractiveContext)
+hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
     {- Rename and typecheck it -}
     hsc_env <- getHscEnv
     tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env decls
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 456332daeb..d17fa5fcef 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -23,7 +23,7 @@ module HscTypes (
         needsTemplateHaskellOrQQ, mgBootModules,
 
         -- * Hsc monad
-        Hsc(..), runHsc, runInteractiveHsc,
+        Hsc(..), runHsc, mkInteractiveHscEnv, runInteractiveHsc,
 
         -- * Information about modules
         ModDetails(..), emptyModDetails,
@@ -253,13 +253,15 @@ runHsc hsc_env (Hsc hsc) = do
     printOrThrowWarnings (hsc_dflags hsc_env) w
     return a
 
+mkInteractiveHscEnv :: HscEnv -> HscEnv
+mkInteractiveHscEnv hsc_env = hsc_env{ hsc_dflags = interactive_dflags }
+  where
+    interactive_dflags = ic_dflags (hsc_IC hsc_env)
+
 runInteractiveHsc :: HscEnv -> Hsc a -> IO a
 -- A variant of runHsc that switches in the DynFlags from the
 -- InteractiveContext before running the Hsc computation.
-runInteractiveHsc hsc_env
-  = runHsc (hsc_env { hsc_dflags = interactive_dflags })
-  where
-    interactive_dflags = ic_dflags (hsc_IC hsc_env)
+runInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env)
 
 -- -----------------------------------------------------------------------------
 -- Source Errors
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index cceec31fec..ad3c500d1f 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -11,8 +11,8 @@
 
 module InteractiveEval (
         Resume(..), History(..),
-        execStmt, ExecOptions(..), execOptions, ExecResult(..), resumeExec,
-        runDecls, runDeclsWithLocation,
+        execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec,
+        runDecls, runDeclsWithLocation, runParsedDecls,
         isStmt, hasImport, isImport, isDecl,
         parseImportDecl, SingleStep(..),
         abandon, abandonAll,
@@ -165,23 +165,40 @@ execStmt
   => String             -- ^ a statement (bind or expression)
   -> ExecOptions
   -> m ExecResult
-execStmt stmt ExecOptions{..} = do
+execStmt input exec_opts@ExecOptions{..} = do
+    hsc_env <- getSession
+
+    mb_stmt <-
+      liftIO $
+      runInteractiveHsc hsc_env $
+      hscParseStmtWithLocation execSourceFile execLineNumber input
+
+    case mb_stmt of
+      -- empty statement / comment
+      Nothing -> return (ExecComplete (Right []) 0)
+      Just stmt -> execStmt' stmt input exec_opts
+
+-- | Like `execStmt`, but takes a parsed statement as argument. Useful when
+-- doing preprocessing on the AST before execution, e.g. in GHCi (see
+-- GHCi.UI.runStmt).
+execStmt' :: GhcMonad m => GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult
+execStmt' stmt stmt_text ExecOptions{..} = do
     hsc_env <- getSession
 
     -- Turn off -fwarn-unused-local-binds when running a statement, to hide
     -- warnings about the implicit bindings we introduce.
+    -- (This is basically `mkInteractiveHscEnv hsc_env`, except we unset
+    -- -wwarn-unused-local-binds)
     let ic       = hsc_IC hsc_env -- use the interactive dflags
         idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedLocalBinds
-        hsc_env' = hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } }
+        hsc_env' = mkInteractiveHscEnv (hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } })
 
-    -- compile to value (IO [HValue]), don't run
-    r <- liftIO $ hscStmtWithLocation hsc_env' stmt
-                    execSourceFile execLineNumber
+    r <- liftIO $ hscParsedStmt hsc_env' stmt
 
     case r of
-      -- empty statement / comment
-      Nothing -> return (ExecComplete (Right []) 0)
-
+      Nothing ->
+        -- empty statement / comment
+        return (ExecComplete (Right []) 0)
       Just (ids, hval, fix_env) -> do
         updateFixityEnv fix_env
 
@@ -195,20 +212,27 @@ execStmt stmt ExecOptions{..} = do
 
             size = ghciHistSize idflags'
 
-        handleRunStatus execSingleStep stmt bindings ids
+        handleRunStatus execSingleStep stmt_text bindings ids
                         status (emptyHistory size)
 
-
 runDecls :: GhcMonad m => String -> m [Name]
 runDecls = runDeclsWithLocation "<interactive>" 1
 
 -- | Run some declarations and return any user-visible names that were brought
 -- into scope.
 runDeclsWithLocation :: GhcMonad m => String -> Int -> String -> m [Name]
-runDeclsWithLocation source linenumber expr =
-  do
+runDeclsWithLocation source line_num input = do
+    hsc_env <- getSession
+    decls <- liftIO (hscParseDeclsWithLocation hsc_env source line_num input)
+    runParsedDecls decls
+
+-- | Like `runDeclsWithLocation`, but takes parsed declarations as argument.
+-- Useful when doing preprocessing on the AST before execution, e.g. in GHCi
+-- (see GHCi.UI.runStmt).
+runParsedDecls :: GhcMonad m => [LHsDecl GhcPs] -> m [Name]
+runParsedDecls decls = do
     hsc_env <- getSession
-    (tyThings, ic) <- liftIO $ hscDeclsWithLocation hsc_env expr source linenumber
+    (tyThings, ic) <- liftIO (hscParsedDecls hsc_env decls)
 
     setSession $ hsc_env { hsc_IC = ic }
     hsc_env <- getSession