X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=5e6535678e11299986f21103223fd053b566e23c;hp=9237384efcb1e7fd32a3a4532d2d2e059b3297a7;hb=4edbeb14e25f71824c53c524028d12440928707e;hpb=a056bcdea7901557f8c97f0da69ae194338e550d

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 } ->