multiline commands in GHCi #4316

[ghc-hetmet.git] / compiler / parser / Lexer.x

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 9237384..5e65356 100644 (file)
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -51,6 +51,7 @@ module Lexer (
    failLocMsgP, failSpanMsgP, srcParseFail,
    getMessages, 
    popContext, pushCurrentContext, setLastToken, setSrcLoc,
    failLocMsgP, failSpanMsgP, srcParseFail,
    getMessages, 
    popContext, pushCurrentContext, setLastToken, setSrcLoc,

+   activeContext, nextIsEOF,

    getLexState, popLexState, pushLexState,
    extension, bangPatEnabled, datatypeContextsEnabled,
    addWarning,
    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 } ()
 
 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} ()
 
 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
 
     = 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}) ()
 
 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}) ()
 
 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 } ->
 popPendingImplicitToken :: P (Maybe (Located Token))
 popPendingImplicitToken
     = P $ \s@PState{ alr_pending_implicit_tokens = ts } ->