typeKind,
parseName,
RunResult(..),
- runStmt, parseImportDecl, SingleStep(..),
+ runStmt, runStmtWithLocation,
+ parseImportDecl, SingleStep(..),
resume,
Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
resumeHistory, resumeHistoryIx),
#ifdef GHCI
, hscGetModuleExports
, hscTcRnLookupRdrName
- , hscStmt, hscTcExpr, hscImport, hscKcType
+ , hscStmt, hscStmtWithLocation
+ , hscTcExpr, hscImport, hscKcType
, hscCompileCoreExpr
#endif
-> 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
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
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
module InteractiveEval (
#ifdef GHCI
RunResult(..), Status(..), Resume(..), History(..),
- runStmt, parseImportDecl, SingleStep(..),
+ runStmt, runStmtWithLocation,
+ parseImportDecl, SingleStep(..),
resume,
abandon, abandonAll,
getResumeContext,
-- | 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
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
<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>
stop :: String,
options :: [GHCiOption],
prelude :: GHC.Module,
+ line_number :: !Int, -- input line
break_ctr :: !Int,
breaks :: ![(Int, BreakLocation)],
tickarrays :: ModuleEnv TickArray,
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
("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),
" :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" ++
-- session = session,
options = [],
prelude = prel_mod,
+ line_number = 1,
break_ctr = 0,
breaks = [],
tickarrays = emptyModuleEnv,
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
-- 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
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
-- #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
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
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 ()
projects / ghc-hetmet.git / commitdiff