summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/parser/Lexer.x22
-rw-r--r--docs/users_guide/ghci.xml60
-rw-r--r--ghc/GhciMonad.hs1
-rw-r--r--ghc/InteractiveUI.hs83
4 files changed, 154 insertions, 12 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 9237384efc..5e6535678e 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 80205954e5..ebf195b2a6 100644
--- a/docs/users_guide/ghci.xml
+++ b/docs/users_guide/ghci.xml
@@ -58,8 +58,52 @@ Prelude>
</screen>
<para>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.</para>
+ The expression may not span several lines - as soon as you press enter,
+ GHCi will attempt to evaluate it.</para>
+
+ <para>GHCi also has a multiline mode,
+ <indexterm><primary><literal>:set +m</literal></primary></indexterm>,
+ which is terminated by an empty line:</para>
+
+<screen>
+Prelude> :set +m
+Prelude> let x = 42 in x / 9
+Prelude|
+4.666666666666667
+Prelude>
+</screen>
+
+ <para>In Haskell, a <literal>let</literal> expression is followed
+ by <literal>in</literal>. However, in GHCi, since the expression
+ can also be interpreted in the <literal>IO</literal> monad,
+ a <literal>let</literal> binding with no accompanying
+ <literal>in</literal> statement can be signalled by an empty line,
+ as in the above example.</para>
+
+ <para>Multiline mode is useful when entering monadic
+ <literal>do<literal> statements:</para>
+
+<screen>
+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>
+</screen>
+
+ <para>During a multiline interaction, the user can interrupt and
+ return to the top-level prompt.</para>
+
+<screen>
+Prelude> do
+Prelude| putStrLn "Hello, World!"
+Prelude| ^C
+Prelude>
+</screen>
</sect1>
<sect1 id="loading-source-files">
@@ -2627,6 +2671,18 @@ bar
<variablelist>
<varlistentry>
<term>
+ <literal>+m</literal>
+ <indexterm><primary><literal>+m</literal></primary></indexterm>
+ </term>
+ <listitem>
+ <para>Enable parsing of multiline commands. A multiline command
+ is prompted for when the current input line contains open layout
+ contexts.</para>
+ </listitem>
+ </varlistentry>
+
+ <varlistentry>
+ <term>
<literal>+r</literal>
<indexterm><primary><literal>+r</literal></primary></indexterm>
<indexterm><primary>CAFs</primary><secondary>in GHCi</secondary></indexterm>
diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index fd6349720e..779fad23e9 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 ac056a6a7e..cf90ae78ba 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"
View Lorry Controller Status