:script file scripts in GHCi #1363
authorVivian McPhail <haskell.vivian.mcphail@gmail.com>
Sat, 26 Feb 2011 07:31:33 +0000 (07:31 +0000)
committerVivian McPhail <haskell.vivian.mcphail@gmail.com>
Sat, 26 Feb 2011 07:31:33 +0000 (07:31 +0000)
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.

compiler/main/GHC.hs
compiler/main/HscMain.lhs
compiler/main/InteractiveEval.hs
docs/users_guide/ghci.xml
ghc/GhciMonad.hs
ghc/InteractiveUI.hs

index ce9b688..0d94ade 100644 (file)
@@ -92,7 +92,8 @@ module GHC (
        typeKind,
        parseName,
        RunResult(..),  
-       runStmt, parseImportDecl, SingleStep(..),
+       runStmt, runStmtWithLocation,
+        parseImportDecl, SingleStep(..),
         resume,
         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
                resumeHistory, resumeHistoryIx),
index 582b80d..47bde96 100644 (file)
@@ -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
 
index 43f6aa2..e0a30b4 100644 (file)
@@ -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
index a675cca..7c3fed2 100644 (file)
@@ -2389,6 +2389,19 @@ bar
 
       <varlistentry>
        <term>
+          <literal>:script</literal> <optional><replaceable>n</replaceable></optional> 
+         <literal>filename</literal>
+          <indexterm><primary><literal>:script</literal></primary></indexterm>
+        </term>
+       <listitem>
+    <para>Executes the lines of a file as a series of GHCi commands.  This command
+    is compatible with multiline statements as set by <literal>:set +m</literal>
+    </para>
+       </listitem>
+      </varlistentry>
+
+      <varlistentry>
+       <term>
           <literal>:set</literal> <optional><replaceable>option</replaceable>...</optional>
           <indexterm><primary><literal>:set</literal></primary></indexterm>
         </term>
index 779fad2..2aff483 100644 (file)
@@ -57,6 +57,7 @@ data GHCiState = GHCiState
         stop           :: String,
        options        :: [GHCiOption],
         prelude        :: GHC.Module,
+        line_number    :: !Int,         -- input line
         break_ctr      :: !Int,
         breaks         :: ![(Int, BreakLocation)],
         tickarrays     :: ModuleEnv TickArray,
@@ -254,7 +255,7 @@ runStmt expr step = do
       reflectGHCi x $ do
         GHC.handleSourceError (\e -> do GHC.printException e
                                         return GHC.RunFailed) $ do
-          GHC.runStmt expr step
+          GHC.runStmtWithLocation (progname st) (line_number st) expr step 
 
 resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.RunResult
 resume canLogSpan step = do
index eaf2d2d..534709f 100644 (file)
@@ -143,6 +143,7 @@ builtin_commands = [
   ("quit",      quit,                           noCompletion),
   ("reload",    keepGoing' reloadModule,        noCompletion),
   ("run",       keepGoing runRun,               completeFilename),
+  ("script",    keepGoing' scriptCmd,           completeFilename),
   ("set",       keepGoing setCmd,               completeSetOptions),
   ("show",      keepGoing showCmd,              completeShowOptions),
   ("sprint",    keepGoing sprintCmd,            completeExpression),
@@ -217,6 +218,7 @@ helpText =
  "   :quit                       exit GHCi\n" ++
  "   :reload                     reload the current module set\n" ++
  "   :run function [<arguments> ...] run the function with the given arguments\n" ++
+ "   :script <filename>          run the script <filename>" ++
  "   :type <expr>                show the type of <expr>\n" ++
  "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
  "   :!<command>                 run the shell command <command>\n" ++
@@ -358,6 +360,7 @@ interactiveUI srcs maybe_exprs = do
 --                   session = session,
                    options = [],
                    prelude = prel_mod,
+                   line_number = 1,
                    break_ctr = 0,
                    breaks = [],
                    tickarrays = emptyModuleEnv,
@@ -517,7 +520,13 @@ checkPerms name =
          else return True
 #endif
 
-fileLoop :: MonadIO m => Handle -> InputT m (Maybe String)
+incrementLines :: InputT GHCi ()
+incrementLines = do
+   st <- lift $ getGHCiState
+   let ln = 1+(line_number st)
+   lift $ setGHCiState st{line_number=ln}
+
+fileLoop :: Handle -> InputT GHCi (Maybe String)
 fileLoop hdl = do
    l <- liftIO $ tryIO $ hGetLine hdl
    case l of
@@ -529,7 +538,9 @@ fileLoop hdl = do
                 -- this can happen if the user closed stdin, or
                 -- perhaps did getContents which closes stdin at
                 -- EOF.
-        Right l -> return (Just l)
+        Right l -> do
+           incrementLines
+           return (Just l)
 
 mkPrompt :: GHCi String
 mkPrompt = do
@@ -654,7 +665,7 @@ runOneCommand eh getCmd = do
       ml <- lift $ isOptionSet Multiline
       if ml
         then do 
-          mb_stmt <- checkInputForLayout stmt getCmd
+          mb_stmt <- checkInputForLayout stmt getCmd
           case mb_stmt of
             Nothing      -> return $ Just True
             Just ml_stmt -> do
@@ -666,14 +677,14 @@ runOneCommand eh getCmd = do
 
 -- #4316
 -- lex the input.  If there is an unclosed layout context, request input
-checkInputForLayout :: String -> Int -> InputT GHCi (Maybe String)
+checkInputForLayout :: String -> InputT GHCi (Maybe String)
                     -> InputT GHCi (Maybe String)
-checkInputForLayout stmt line_number getStmt = do
+checkInputForLayout stmt getStmt = do
    dflags' <- lift $ getDynFlags
    let dflags = xopt_set dflags' Opt_AlternativeLayoutRule
    st <- lift $ getGHCiState
    let buf =  stringToStringBuffer stmt
-       loc  = mkSrcLoc (fsLit (progname st)) line_number 1
+       loc  = mkSrcLoc (fsLit (progname st)) (line_number st) 1
        pstate = Lexer.mkPState dflags buf loc
    case Lexer.unP goToEnd pstate of
      (Lexer.POk _ False) -> return $ Just stmt
@@ -696,7 +707,8 @@ checkInputForLayout stmt line_number getStmt = do
          Nothing  -> return Nothing
          Just str -> if str == ""
            then return $ Just stmt
-           else checkInputForLayout (stmt++"\n"++str) (line_number+1) getStmt
+           else do
+             checkInputForLayout (stmt++"\n"++str) getStmt
      where goToEnd = do
              eof <- Lexer.nextIsEOF
              if eof 
@@ -1252,6 +1264,39 @@ shellEscape :: String -> GHCi Bool
 shellEscape str = liftIO (system str >> return False)
 
 -----------------------------------------------------------------------------
+-- running a script file #1363
+
+scriptCmd :: String -> InputT GHCi ()
+scriptCmd s = do
+  case words s of
+    [s]    -> runScript s
+    _      -> ghcError (CmdLineError "syntax:  :script <filename>")
+
+runScript :: String    -- ^ filename
+           -> InputT GHCi ()
+runScript filename = do
+  either_script <- liftIO $ tryIO (openFile filename ReadMode)
+  case either_script of
+    Left _err    -> ghcError (CmdLineError $ "IO error:  \""++filename++"\" "
+                      ++(ioeGetErrorString _err))
+    Right script -> do
+      st <- lift $ getGHCiState
+      let prog = progname st
+          line = line_number st
+      lift $ setGHCiState st{progname=filename,line_number=0}
+      scriptLoop script
+      liftIO $ hClose script
+      new_st <- lift $ getGHCiState
+      lift $ setGHCiState new_st{progname=prog,line_number=line}
+  where scriptLoop script = do
+          res <- runOneCommand handler $ fileLoop script
+          case res of
+            Nothing   -> return ()
+            Just succ -> if succ 
+              then scriptLoop script
+              else return ()
+
+-----------------------------------------------------------------------------
 -- Browsing a module's contents
 
 browseCmd :: Bool -> String -> InputT GHCi ()