1 files changed, 39 insertions, 15 deletions

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