Commit eccb2d89 authored by vivian's avatar vivian

: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.
parent 74430537
......@@ -92,7 +92,8 @@ module GHC (
typeKind,
parseName,
RunResult(..),
runStmt, parseImportDecl, SingleStep(..),
runStmt, runStmtWithLocation,
parseImportDecl, SingleStep(..),
resume,
Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
resumeHistory, resumeHistoryIx),
......
......@@ -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
......
......@@ -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
......
......@@ -2387,6 +2387,19 @@ bar
</listitem>
</varlistentry>
<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>
......
......@@ -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
......
......@@ -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 1 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
......@@ -1251,6 +1263,39 @@ quit _ = return True
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment