From 4edbeb14e25f71824c53c524028d12440928707e Mon Sep 17 00:00:00 2001 From: Vivian McPhail Date: Fri, 5 Nov 2010 05:13:08 +0000 Subject: [PATCH] multiline commands in GHCi #4316 This patch adds support for multiline commands in GHCi. The first line of input is lexed. If there is an active layout context once the lexer reaches the end of file, the user is prompted for more input. Multiline input is exited by an empty line and can be escaped with a user interrupt. Multiline mode is toggled with `:set +m` --- compiler/parser/Lexer.x | 22 ++++++++++++ docs/users_guide/ghci.xml | 60 ++++++++++++++++++++++++++++++-- ghc/GhciMonad.hs | 1 + ghc/InteractiveUI.hs | 83 +++++++++++++++++++++++++++++++++++++++------ 4 files changed, 154 insertions(+), 12 deletions(-) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 9237384..5e65356 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -51,6 +51,7 @@ module Lexer ( failLocMsgP, failSpanMsgP, srcParseFail, getMessages, popContext, pushCurrentContext, setLastToken, setSrcLoc, + activeContext, nextIsEOF, getLexState, popLexState, pushLexState, extension, bangPatEnabled, datatypeContextsEnabled, addWarning, @@ -1670,6 +1671,11 @@ getInput = P $ \s@PState{ loc=l, buffer=b } -> POk s (AI l b) setInput :: AlexInput -> P () setInput (AI l b) = P $ \s -> POk s{ loc=l, buffer=b } () +nextIsEOF :: P Bool +nextIsEOF = do + AI _ s <- getInput + return $ atEnd s + pushLexState :: Int -> P () pushLexState ls = P $ \s@PState{ lex_state=l } -> POk s{lex_state=ls:l} () @@ -1684,6 +1690,15 @@ popNextToken = P $ \s@PState{ alr_next_token = m } -> POk (s {alr_next_token = Nothing}) m +activeContext :: P Bool +activeContext = do + ctxt <- getALRContext + expc <- getAlrExpectingOCurly + impt <- implicitTokenPending + case (ctxt,expc) of + ([],Nothing) -> return impt + _other -> return True + setAlrLastLoc :: SrcSpan -> P () setAlrLastLoc l = P $ \s -> POk (s {alr_last_loc = l}) () @@ -1707,6 +1722,13 @@ setJustClosedExplicitLetBlock b setNextToken :: Located Token -> P () setNextToken t = P $ \s -> POk (s {alr_next_token = Just t}) () +implicitTokenPending :: P Bool +implicitTokenPending + = P $ \s@PState{ alr_pending_implicit_tokens = ts } -> + case ts of + [] -> POk s False + _ -> POk s True + popPendingImplicitToken :: P (Maybe (Located Token)) popPendingImplicitToken = P $ \s@PState{ alr_pending_implicit_tokens = ts } -> diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml index 8020595..ebf195b 100644 --- a/docs/users_guide/ghci.xml +++ b/docs/users_guide/ghci.xml @@ -58,8 +58,52 @@ Prelude> GHCi interprets the whole line as an expression to evaluate. - The expression may not span several lines - as soon as you press - enter, GHCi will attempt to evaluate it. + The expression may not span several lines - as soon as you press enter, + GHCi will attempt to evaluate it. + + GHCi also has a multiline mode, + :set +m, + which is terminated by an empty line: + + +Prelude> :set +m +Prelude> let x = 42 in x / 9 +Prelude| +4.666666666666667 +Prelude> + + + In Haskell, a let expression is followed + by in. However, in GHCi, since the expression + can also be interpreted in the IO monad, + a let binding with no accompanying + in statement can be signalled by an empty line, + as in the above example. + + Multiline mode is useful when entering monadic + do statements: + + +Control.Monad.State> flip evalStateT 0 $ do +Control.Monad.State| i <- get +Control.Monad.State| lift $ do +Control.Monad.State| putStrLn "Hello World!" +Control.Monad.State| print i +Control.Monad.State| +"Hello World!" +0 +Control.Monad.State> + + + During a multiline interaction, the user can interrupt and + return to the top-level prompt. + + +Prelude> do +Prelude| putStrLn "Hello, World!" +Prelude| ^C +Prelude> + @@ -2627,6 +2671,18 @@ bar + +m + +m + + + Enable parsing of multiline commands. A multiline command + is prompted for when the current input line contains open layout + contexts. + + + + + +r +r CAFsin GHCi diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs index fd63497..779fad2 100644 --- a/ghc/GhciMonad.hs +++ b/ghc/GhciMonad.hs @@ -90,6 +90,7 @@ data GHCiOption = ShowTiming -- show time/allocs after evaluation | ShowType -- show the type of expressions | RevertCAFs -- revert CAFs after every evaluation + | Multiline -- use multiline commands deriving Eq data BreakLocation diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index ac056a6..cf90ae7 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -27,6 +27,8 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..), Ghc, handleSourceError ) import PprTyThing import DynFlags +import qualified Lexer +import StringBuffer import Packages -- import PackageConfig @@ -257,6 +259,7 @@ helpText = "\n" ++ " Options for ':set' and ':unset':\n" ++ "\n" ++ + " +m allow multiline commands\n" ++ " +r revert top-level expressions after each evaluation\n" ++ " +s print timing/memory stats after each evaluation\n" ++ " +t print type after evaluation\n" ++ @@ -585,30 +588,34 @@ runCommands' :: (SomeException -> GHCi Bool) -- Exception handler -> InputT GHCi (Maybe String) -> InputT GHCi () runCommands' eh getCmd = do b <- ghandle (\e -> case fromException e of - Just UserInterrupt -> return False + Just UserInterrupt -> return $ Just False _ -> case fromException e of Just ghc_e -> do liftIO (print (ghc_e :: GhcException)) - return True + return Nothing _other -> liftIO (Exception.throwIO e)) (runOneCommand eh getCmd) - if b then return () else runCommands' eh getCmd + case b of + Nothing -> return () + Just _ -> runCommands' eh getCmd runOneCommand :: (SomeException -> GHCi Bool) -> InputT GHCi (Maybe String) - -> InputT GHCi Bool + -> InputT GHCi (Maybe Bool) runOneCommand eh getCmd = do mb_cmd <- noSpace (lift queryQueue) mb_cmd <- maybe (noSpace getCmd) (return . Just) mb_cmd case mb_cmd of - Nothing -> return True - Just c -> ghciHandle (lift . eh) $ + Nothing -> return Nothing + Just c -> ghciHandle (\e -> lift $ eh e >>= return . Just) $ handleSourceError printErrorAndKeepGoing (doCommand c) + -- source error's are handled by runStmt + -- is the handler necessary here? where printErrorAndKeepGoing err = do GHC.printException err - return False + return $ Just True noSpace q = q >>= maybe (return Nothing) (\c->case removeSpaces c of @@ -639,9 +646,63 @@ runOneCommand eh getCmd = do normSpace c = c -- QUESTION: is userError the one to use here? collectError = userError "unterminated multiline command :{ .. :}" - doCommand (':' : cmd) = specialCommand cmd - doCommand stmt = do _ <- timeIt $ lift $ runStmt stmt GHC.RunToCompletion - return False + doCommand (':' : cmd) = do + result <- specialCommand cmd + case result of + True -> return Nothing + _ -> return $ Just True + doCommand stmt = do + ml <- lift $ isOptionSet Multiline + if ml + then do + mb_stmt <- checkInputForLayout stmt getCmd + case mb_stmt of + Nothing -> return $ Just True + Just ml_stmt -> do + result <- timeIt $ lift $ runStmt ml_stmt GHC.RunToCompletion + return $ Just result + else do + result <- timeIt $ lift $ runStmt stmt GHC.RunToCompletion + return $ Just result + +-- #4316 +-- lex the input. If there is an unclosed layout context, request input +checkInputForLayout :: String -> InputT GHCi (Maybe String) + -> InputT GHCi (Maybe String) +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 st) 1 + pstate = Lexer.mkPState dflags buf loc + case Lexer.unP goToEnd pstate of + (Lexer.POk _ False) -> return $ Just stmt + _other -> do + st <- lift getGHCiState + let p = prompt st + lift $ setGHCiState st{ prompt = "%s| " } + mb_stmt <- ghciHandle (\ex -> case fromException ex of + Just UserInterrupt -> return Nothing + _ -> case fromException ex of + Just ghc_e -> + do liftIO (print (ghc_e :: GhcException)) + return Nothing + _other -> liftIO (Exception.throwIO ex)) + getStmt + lift $ getGHCiState >>= \st->setGHCiState st{ prompt = p } + -- the recursive call does not recycle parser state + -- as we use a new string buffer + case mb_stmt of + Nothing -> return Nothing + Just str -> if str == "" + then return $ Just stmt + else checkInputForLayout (stmt++"\n"++str) getStmt + where goToEnd = do + eof <- Lexer.nextIsEOF + if eof + then Lexer.activeContext + else Lexer.lexer return >> goToEnd enqueueCommands :: [String] -> GHCi () enqueueCommands cmds = do @@ -1569,12 +1630,14 @@ unsetOpt str Just o -> unsetOption o strToGHCiOpt :: String -> (Maybe GHCiOption) +strToGHCiOpt "m" = Just Multiline strToGHCiOpt "s" = Just ShowTiming strToGHCiOpt "t" = Just ShowType strToGHCiOpt "r" = Just RevertCAFs strToGHCiOpt _ = Nothing optToStr :: GHCiOption -> String +optToStr Multiline = "m" optToStr ShowTiming = "s" optToStr ShowType = "t" optToStr RevertCAFs = "r" -- 1.7.10.4