diff options
author | Vivian McPhail <haskell.vivian.mcphail@gmail.com> | 2011-02-26 07:31:33 +0000 |
---|---|---|
committer | Vivian McPhail <haskell.vivian.mcphail@gmail.com> | 2011-02-26 07:31:33 +0000 |
commit | eccb2d89eb4b34f31e8ea337d5f8673605f71665 (patch) | |
tree | dbf1de76ef655523c9e7daa818a570692bc6019e /ghc/InteractiveUI.hs | |
parent | 74430537272aecdc8fd85b4877cec76cc042c8ad (diff) | |
download | haskell-eccb2d89eb4b34f31e8ea337d5f8673605f71665.tar.gz |
: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.
Diffstat (limited to 'ghc/InteractiveUI.hs')
-rw-r--r-- | ghc/InteractiveUI.hs | 59 |
1 files changed, 52 insertions, 7 deletions
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index eaf2d2d559..534709fa59 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -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 @@ -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 () |