X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=9237384efcb1e7fd32a3a4532d2d2e059b3297a7;hp=07179b858460b66e518665facdc5277208279f55;hb=d2f11ea842a25bebd51d6c0c730a756c1d987e25;hpb=5289f5d85610f71625a439747a09384876655eb5 diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 07179b8..9237384 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -211,7 +211,7 @@ $tab+ { warn Opt_WarnTabs (text "Warning: Tab character") } -- context if the curly brace is missing. -- Careful! This stuff is quite delicate. { - \{ / { notFollowedBy '-' } { pop_and open_brace } + \{ / { notFollowedBy '-' } { hopefully_open_brace } -- we might encounter {-# here, but {- has been handled already \n ; ^\# (line)? { begin line_prag1 } @@ -369,10 +369,8 @@ $tab+ { warn Opt_WarnTabs (text "Warning: Tab character") } -- ToDo: - move `var` and (sym) into lexical syntax? -- - remove backquote from $special? <0> { - @qual @varsym / { ifExtension oldQualOps } { idtoken qvarsym } - @qual @consym / { ifExtension oldQualOps } { idtoken qconsym } - @qual \( @varsym \) / { ifExtension newQualOps } { idtoken prefixqvarsym } - @qual \( @consym \) / { ifExtension newQualOps } { idtoken prefixqconsym } + @qual @varsym { idtoken qvarsym } + @qual @consym { idtoken qconsym } @varsym { varsym } @consym { consym } } @@ -512,8 +510,8 @@ data Token | ITvocurly | ITvccurly | ITobrack - | ITopabrack -- [:, for parallel arrays with -XParr - | ITcpabrack -- :], for parallel arrays with -XParr + | ITopabrack -- [:, for parallel arrays with -XParallelArrays + | ITcpabrack -- :], for parallel arrays with -XParallelArrays | ITcbrack | IToparen | ITcparen @@ -757,6 +755,19 @@ pop :: Action pop _span _buf _len = do _ <- popLexState lexToken +hopefully_open_brace :: Action +hopefully_open_brace span buf len + = do relaxed <- extension relaxedLayout + ctx <- getContext + (AI l _) <- getInput + let offset = srcLocCol l + isOK = relaxed || + case ctx of + Layout prev_off : _ -> prev_off < offset + _ -> True + if isOK then pop_and open_brace span buf len + else failSpanMsgP span (text "Missing block") + pop_and :: Action -> Action pop_and act span buf len = do _ <- popLexState act span buf len @@ -1107,10 +1118,12 @@ new_layout_context strict span _buf _len = do (AI l _) <- getInput let offset = srcLocCol l ctx <- getContext + nondecreasing <- extension nondecreasingIndentation + let strict' = strict || not nondecreasing case ctx of Layout prev_off : _ | - (strict && prev_off >= offset || - not strict && prev_off > offset) -> do + (strict' && prev_off >= offset || + not strict' && prev_off > offset) -> do -- token is indented to the left of the previous context. -- we must generate a {} sequence now. pushLexState layout_left @@ -1625,7 +1638,7 @@ alexGetChar (AI loc s) EnclosingMark -> other_graphic DecimalNumber -> digit LetterNumber -> other_graphic - OtherNumber -> other_graphic + OtherNumber -> digit -- see #4373 ConnectorPunctuation -> symbol DashPunctuation -> symbol OpenPunctuation -> other_graphic @@ -1711,7 +1724,7 @@ setAlrExpectingOCurly :: Maybe ALRLayout -> P () setAlrExpectingOCurly b = P $ \s -> POk (s {alr_expecting_ocurly = b}) () -- for reasons of efficiency, flags indicating language extensions (eg, --- -fglasgow-exts or -XParr) are represented by a bitmap stored in an unboxed +-- -fglasgow-exts or -XParallelArrays) are represented by a bitmap stored in an unboxed -- integer genericsBit :: Int @@ -1755,12 +1768,14 @@ inRulePragBit :: Int inRulePragBit = 19 rawTokenStreamBit :: Int rawTokenStreamBit = 20 -- producing a token stream with all comments included -newQualOpsBit :: Int -newQualOpsBit = 21 -- Haskell' qualified operator syntax, e.g. Prelude.(+) recBit :: Int recBit = 22 -- rec alternativeLayoutRuleBit :: Int alternativeLayoutRuleBit = 23 +relaxedLayoutBit :: Int +relaxedLayoutBit = 24 +nondecreasingIndentationBit :: Int +nondecreasingIndentationBit = 25 always :: Int -> Bool always _ = True @@ -1798,12 +1813,12 @@ qqEnabled flags = testBit flags qqBit -- inRulePrag flags = testBit flags inRulePragBit rawTokenStreamEnabled :: Int -> Bool rawTokenStreamEnabled flags = testBit flags rawTokenStreamBit -newQualOps :: Int -> Bool -newQualOps flags = testBit flags newQualOpsBit -oldQualOps :: Int -> Bool -oldQualOps flags = not (newQualOps flags) alternativeLayoutRule :: Int -> Bool alternativeLayoutRule flags = testBit flags alternativeLayoutRuleBit +relaxedLayout :: Int -> Bool +relaxedLayout flags = testBit flags relaxedLayoutBit +nondecreasingIndentation :: Int -> Bool +nondecreasingIndentation flags = testBit flags nondecreasingIndentationBit -- PState for parsing options pragmas -- @@ -1836,12 +1851,12 @@ mkPState flags buf loc = where bitmap = genericsBit `setBitIf` xopt Opt_Generics flags .|. ffiBit `setBitIf` xopt Opt_ForeignFunctionInterface flags - .|. parrBit `setBitIf` xopt Opt_PArr flags - .|. arrowsBit `setBitIf` xopt Opt_Arrows flags + .|. parrBit `setBitIf` xopt Opt_ParallelArrays flags + .|. arrowsBit `setBitIf` xopt Opt_Arrows flags .|. thBit `setBitIf` xopt Opt_TemplateHaskell flags - .|. qqBit `setBitIf` xopt Opt_QuasiQuotes flags - .|. ipBit `setBitIf` xopt Opt_ImplicitParams flags - .|. explicitForallBit `setBitIf` xopt Opt_ExplicitForAll flags + .|. qqBit `setBitIf` xopt Opt_QuasiQuotes flags + .|. ipBit `setBitIf` xopt Opt_ImplicitParams flags + .|. explicitForallBit `setBitIf` xopt Opt_ExplicitForAll flags .|. bangPatBit `setBitIf` xopt Opt_BangPatterns flags .|. tyFamBit `setBitIf` xopt Opt_TypeFamilies flags .|. haddockBit `setBitIf` dopt Opt_Haddock flags @@ -1855,8 +1870,9 @@ mkPState flags buf loc = .|. datatypeContextsBit `setBitIf` xopt Opt_DatatypeContexts flags .|. transformComprehensionsBit `setBitIf` xopt Opt_TransformListComp flags .|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags - .|. newQualOpsBit `setBitIf` xopt Opt_NewQualifiedOperators flags .|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags + .|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags + .|. nondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags -- setBitIf :: Int -> Bool -> Int b `setBitIf` cond | cond = bit b