X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=4e9617602280fe2cf5dac5fb4b032e3fdf9124b1;hp=5df5e4ea2549fe9c83ada1910af5ce6366350b98;hb=b017f34bebf1588e5e579d7c653413e2a4c2d170;hpb=8dbd52c7606588ab7fc7ffd3a54641b7cadc4431 diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 5df5e4e..4e96176 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -51,7 +51,7 @@ module Lexer ( getMessages, popContext, pushCurrentContext, setLastToken, setSrcLoc, getLexState, popLexState, pushLexState, - extension, standaloneDerivingEnabled, bangPatEnabled, + extension, bangPatEnabled, addWarning, lexTokenStream ) where @@ -701,7 +701,6 @@ reservedSymsFM = listToUFM $ explicitForallEnabled i) ,("→", ITrarrow, unicodeSyntaxEnabled) ,("←", ITlarrow, unicodeSyntaxEnabled) - ,("⋯", ITdotdot, unicodeSyntaxEnabled) ,("⤙", ITlarrowtail, \i -> unicodeSyntaxEnabled i && arrowsEnabled i) ,("⤚", ITrarrowtail, \i -> unicodeSyntaxEnabled i && arrowsEnabled i) @@ -1736,8 +1735,6 @@ unicodeSyntaxBit :: Int unicodeSyntaxBit = 14 -- the forall symbol, arrow symbols, etc unboxedTuplesBit :: Int unboxedTuplesBit = 15 -- (# and #) -standaloneDerivingBit :: Int -standaloneDerivingBit = 16 -- standalone instance deriving declarations transformComprehensionsBit :: Int transformComprehensionsBit = 17 qqBit :: Int @@ -1781,8 +1778,6 @@ unicodeSyntaxEnabled :: Int -> Bool unicodeSyntaxEnabled flags = testBit flags unicodeSyntaxBit unboxedTuplesEnabled :: Int -> Bool unboxedTuplesEnabled flags = testBit flags unboxedTuplesBit -standaloneDerivingEnabled :: Int -> Bool -standaloneDerivingEnabled flags = testBit flags standaloneDerivingBit qqEnabled :: Int -> Bool qqEnabled flags = testBit flags qqBit -- inRulePrag :: Int -> Bool @@ -1821,8 +1816,8 @@ pragState dynflags buf loc = -- create a parse state -- -mkPState :: StringBuffer -> SrcLoc -> DynFlags -> PState -mkPState buf loc flags = +mkPState :: DynFlags -> StringBuffer -> SrcLoc -> PState +mkPState flags buf loc = PState { buffer = buf, dflags = flags, @@ -1833,7 +1828,6 @@ mkPState buf loc flags = extsBitmap = fromIntegral bitmap, context = [], lex_state = [bol, 0], - -- we begin in the layout state if toplev_layout is set alr_pending_implicit_tokens = [], alr_next_token = Nothing, alr_last_loc = noSrcSpan, @@ -1860,7 +1854,6 @@ mkPState buf loc flags = .|. recBit `setBitIf` dopt Opt_Arrows flags .|. unicodeSyntaxBit `setBitIf` dopt Opt_UnicodeSyntax flags .|. unboxedTuplesBit `setBitIf` dopt Opt_UnboxedTuples flags - .|. standaloneDerivingBit `setBitIf` dopt Opt_StandaloneDeriving flags .|. transformComprehensionsBit `setBitIf` dopt Opt_TransformListComp flags .|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags .|. newQualOpsBit `setBitIf` dopt Opt_NewQualifiedOperators flags @@ -2054,6 +2047,18 @@ alternativeLayoutRuleToken t -- Note that we use lastLoc, as we may need to close -- more layouts, or give a semicolon return (L lastLoc ITccurly) + -- This next case is to handle a transitional issue: + (ITvbar, ALRLayout _ col : ls, _) + | newLine && thisCol == col && transitional -> + do addWarning Opt_WarnAlternativeLayoutRuleTransitional + thisLoc + (transitionalAlternativeLayoutWarning + "`|' at the same depth as implicit layout block") + setALRContext ls + setNextToken t + -- Note that we use lastLoc, as we may need to close + -- more layouts, or give a semicolon + return (L lastLoc ITccurly) (_, ALRLayout _ col : ls, _) | newLine && thisCol == col -> do setNextToken t @@ -2196,7 +2201,8 @@ reportLexError loc1 loc2 buf str lexTokenStream :: StringBuffer -> SrcLoc -> DynFlags -> ParseResult [Located Token] lexTokenStream buf loc dflags = unP go initState - where initState = mkPState buf loc (dopt_set (dopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream) + where dflags' = dopt_set (dopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream + initState = mkPState dflags' buf loc go = do ltok <- lexer return case ltok of