X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=306213302dea7e54f7d2eadcfea3d9d9af8f3ef8;hb=9e5a454cd78650a0c9e2a859693ee1af056b3fb9;hp=eaf2d2d5596bcbc32bdd36cf8f546ee031afa31f;hpb=5100993061f3c7ce3ac19005d88f8299bc54b797;p=ghc-hetmet.git diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index eaf2d2d..3062133 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 [ ...] run the function with the given arguments\n" ++ + " :script run the script " ++ " :type show the type of \n" ++ " :undef undefine user-defined command :\n" ++ " :! run the shell 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, @@ -414,7 +417,7 @@ runGHCi paths maybe_exprs = do -- This would be a good place for runFileInputT. Right hdl -> do runInputTWithPrefs defaultPrefs defaultSettings $ - runCommands $ fileLoop hdl + runCommands False $ fileLoop hdl liftIO (hClose hdl `catchIO` \_ -> return ()) where getDirectory f = case takeDirectory f of "" -> "."; d -> d @@ -449,7 +452,7 @@ runGHCi paths maybe_exprs = do Nothing -> do -- enter the interactive loop - runGHCiInput $ runCommands $ nextInputLine show_prompt is_tty + runGHCiInput $ runCommands True $ nextInputLine show_prompt is_tty Just exprs -> do -- just evaluate the expression we were given enqueueCommands exprs @@ -463,7 +466,7 @@ runGHCi paths maybe_exprs = do -- this used to be topHandlerFastExit, see #2228 $ topHandler e runInputTWithPrefs defaultPrefs defaultSettings $ do - runCommands' handle (return Nothing) + runCommands' handle True (return Nothing) -- and finally, exit liftIO $ when (verbosity dflags > 0) $ putStrLn "Leaving GHCi." @@ -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 @@ -580,12 +591,15 @@ queryQueue = do c:cs -> do setGHCiState st{ cmdqueue = cs } return (Just c) -runCommands :: InputT GHCi (Maybe String) -> InputT GHCi () +runCommands :: Bool -> InputT GHCi (Maybe String) -> InputT GHCi () runCommands = runCommands' handler runCommands' :: (SomeException -> GHCi Bool) -- Exception handler + -> Bool -> InputT GHCi (Maybe String) -> InputT GHCi () -runCommands' eh getCmd = do +runCommands' eh resetLineTo1 getCmd = do + when resetLineTo1 $ lift $ do st <- getGHCiState + setGHCiState $ st { line_number = 0 } b <- ghandle (\e -> case fromException e of Just UserInterrupt -> return $ Just False _ -> case fromException e of @@ -597,7 +611,7 @@ runCommands' eh getCmd = do (runOneCommand eh getCmd) case b of Nothing -> return () - Just _ -> runCommands' eh getCmd + Just _ -> runCommands' eh resetLineTo1 getCmd runOneCommand :: (SomeException -> GHCi Bool) -> InputT GHCi (Maybe String) -> InputT GHCi (Maybe Bool) @@ -654,7 +668,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 +680,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 +710,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 +1267,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 ") + +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 ()