:script file scripts in GHCi #1363

This patch adds the script command in GHCi

A file is read and executed as a series of GHCi commands.

Execution terminates on the first error.  The filename and
line number are included in the error.

3 files changed, 39 insertions, 11 deletions

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index ce9b688a1b..0d94ade469 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -92,7 +92,8 @@ module GHC (
 	typeKind,
 	parseName,
 	RunResult(..),  
-	runStmt, parseImportDecl, SingleStep(..),
+	runStmt, runStmtWithLocation,
+        parseImportDecl, SingleStep(..),
         resume,
         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
                resumeHistory, resumeHistoryIx),
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 582b80da6c..47bde9659d 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -62,7 +62,8 @@ module HscMain
 #ifdef GHCI
     , hscGetModuleExports
     , hscTcRnLookupRdrName
-    , hscStmt, hscTcExpr, hscImport, hscKcType
+    , hscStmt, hscStmtWithLocation
+    , hscTcExpr, hscImport, hscKcType
     , hscCompileCoreExpr
 #endif
 
@@ -1075,8 +1076,17 @@ hscStmt		-- Compile a stmt all the way to an HValue, but don't run it
   -> String			-- The statement
   -> IO (Maybe ([Id], HValue))
      -- ^ 'Nothing' <==> empty statement (or comment only), but no parse error
-hscStmt hsc_env stmt = runHsc hsc_env $ do
-    maybe_stmt <- hscParseStmt stmt
+hscStmt hsc_env stmt = hscStmtWithLocation hsc_env stmt "<interactive>" 1
+
+hscStmtWithLocation	-- Compile a stmt all the way to an HValue, but don't run it
+  :: HscEnv
+  -> String			-- The statement
+  -> String                     -- the source
+  -> Int                        -- ^ starting line
+  -> IO (Maybe ([Id], HValue))
+     -- ^ 'Nothing' <==> empty statement (or comment only), but no parse error
+hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do
+    maybe_stmt <- hscParseStmtWithLocation source linenumber stmt
     case maybe_stmt of
       Nothing -> return Nothing
       Just parsed_stmt -> do  -- The real stuff
@@ -1142,6 +1152,11 @@ hscKcType hsc_env str = runHsc hsc_env $ do
 hscParseStmt :: String -> Hsc (Maybe (LStmt RdrName))
 hscParseStmt = hscParseThing parseStmt
 
+hscParseStmtWithLocation :: String -> Int 
+                         -> String -> Hsc (Maybe (LStmt RdrName))
+hscParseStmtWithLocation source linenumber stmt = 
+  hscParseThingWithLocation source linenumber parseStmt stmt
+
 hscParseType :: String -> Hsc (LHsType RdrName)
 hscParseType = hscParseThing parseType
 #endif
@@ -1150,19 +1165,24 @@ hscParseIdentifier :: HscEnv -> String -> IO (Located RdrName)
 hscParseIdentifier hsc_env str = runHsc hsc_env $ 
                                    hscParseThing parseIdentifier str
 
-
 hscParseThing :: (Outputable thing)
 	      => Lexer.P thing
 	      -> String
 	      -> Hsc thing
+hscParseThing = hscParseThingWithLocation "<interactive>" 1
 
-hscParseThing parser str
+hscParseThingWithLocation :: (Outputable thing)
+	      => String -> Int 
+              -> Lexer.P thing
+	      -> String
+	      -> Hsc thing
+hscParseThingWithLocation source linenumber parser str
  = {-# SCC "Parser" #-} do
       dflags <- getDynFlags
       liftIO $ showPass dflags "Parser"
-  
+
       let buf = stringToStringBuffer str
-          loc = mkSrcLoc (fsLit "<interactive>") 1 1
+          loc  = mkSrcLoc (fsLit source) linenumber 1
 
       case unP parser (mkPState dflags buf loc) of
 
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 43f6aa2c0e..e0a30b46dc 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -9,7 +9,8 @@
 module InteractiveEval (
 #ifdef GHCI
         RunResult(..), Status(..), Resume(..), History(..),
-	runStmt, parseImportDecl, SingleStep(..),
+	runStmt, runStmtWithLocation,
+        parseImportDecl, SingleStep(..),
         resume,
         abandon, abandonAll,
         getResumeContext,
@@ -180,7 +181,13 @@ findEnclosingDecls hsc_env inf =
 -- | Run a statement in the current interactive context.  Statement
 -- may bind multple values.
 runStmt :: GhcMonad m => String -> SingleStep -> m RunResult
-runStmt expr step =
+runStmt = runStmtWithLocation "<interactive>" 1
+
+-- | Run a statement in the current interactive context.  Passing debug information
+--   Statement may bind multple values.
+runStmtWithLocation :: GhcMonad m => String -> Int -> 
+                       String -> SingleStep -> m RunResult 
+runStmtWithLocation source linenumber expr step =
   do
     hsc_env <- getSession
 
@@ -192,7 +199,7 @@ runStmt expr step =
     let dflags'  = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
         hsc_env' = hsc_env{ hsc_dflags = dflags' }
 
-    r <- liftIO $ hscStmt hsc_env' expr
+    r <- liftIO $ hscStmtWithLocation hsc_env' expr source linenumber
 
     case r of
       Nothing -> return RunFailed -- empty statement / comment