X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=c813e3614546de7bf3589944dc5d5e5509a66a8b;hb=d7b36bbbcd56ee14656223d02e32f5a1f52ea17b;hp=613848ade970d5c77e824f9c10b21b83779c8961;hpb=36104d7a0d66df895c8275e3aa7cfe35a322ff04;p=ghc-hetmet.git diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 613848a..c813e36 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -20,6 +20,17 @@ -- - M... should be 3 tokens, not 1. -- - pragma-end should be only valid in a pragma +-- qualified operator NOTES. +-- +-- - If M.(+) is a single lexeme, then.. +-- - Probably (+) should be a single lexeme too, for consistency. +-- Otherwise ( + ) would be a prefix operator, but M.( + ) would not be. +-- - But we have to rule out reserved operators, otherwise (..) becomes +-- a different lexeme. +-- - Should we therefore also rule out reserved operators in the qualified +-- form? This is quite difficult to achieve. We don't do it for +-- qualified varids. + { {-# OPTIONS -w #-} -- The above warning supression flag is a temporary kludge. @@ -229,7 +240,7 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } -- with older versions of GHC which generated these. <0,option_prags> { - "{-#" $whitechar* (RULES|rules) { token ITrules_prag } + "{-#" $whitechar* (RULES|rules) { rulePrag } "{-#" $whitechar* (INLINE|inline) { token (ITinline_prag True) } "{-#" $whitechar* (NO(T?)INLINE|no(t?)inline) { token (ITinline_prag False) } @@ -365,13 +376,15 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } @conid "#"+ / { ifExtension magicHashEnabled } { idtoken conid } } --- ToDo: M.(,,,) - +-- ToDo: - move `var` and (sym) into lexical syntax? +-- - remove backquote from $special? <0> { - @qual @varsym { idtoken qvarsym } - @qual @consym { idtoken qconsym } - @varsym { varsym } - @consym { consym } + @qual @varsym / { ifExtension oldQualOps } { idtoken qvarsym } + @qual @consym / { ifExtension oldQualOps } { idtoken qconsym } + @qual \( @varsym \) / { ifExtension newQualOps } { idtoken prefixqvarsym } + @qual \( @consym \) / { ifExtension newQualOps } { idtoken prefixqconsym } + @varsym { varsym } + @consym { consym } } -- For the normal boxed literals we need to be careful @@ -527,6 +540,8 @@ data Token | ITqconid (FastString,FastString) | ITqvarsym (FastString,FastString) | ITqconsym (FastString,FastString) + | ITprefixqvarsym (FastString,FastString) + | ITprefixqconsym (FastString,FastString) | ITdupipvarid FastString -- GHC extension: implicit param: ?x @@ -873,7 +888,7 @@ withLexedDocType lexDocComment = do -- off again at the end of the pragma. rulePrag :: Action rulePrag span buf len = do - setExts (.|. inRulePragBit) + setExts (.|. bit inRulePragBit) return (L span ITrules_prag) endPrag :: Action @@ -924,14 +939,14 @@ close_brace span _str _len = do popContext return (L span ITccurly) -qvarid buf len = ITqvarid $! splitQualName buf len -qconid buf len = ITqconid $! splitQualName buf len +qvarid buf len = ITqvarid $! splitQualName buf len False +qconid buf len = ITqconid $! splitQualName buf len False -splitQualName :: StringBuffer -> Int -> (FastString,FastString) +splitQualName :: StringBuffer -> Int -> Bool -> (FastString,FastString) -- takes a StringBuffer and a length, and returns the module name -- and identifier parts of a qualified name. Splits at the *last* dot, -- because of hierarchical module names. -splitQualName orig_buf len = split orig_buf orig_buf +splitQualName orig_buf len parens = split orig_buf orig_buf where split buf dot_buf | orig_buf `byteDiff` buf >= len = done dot_buf @@ -951,7 +966,9 @@ splitQualName orig_buf len = split orig_buf orig_buf done dot_buf = (lexemeToFastString orig_buf (qual_size - 1), - lexemeToFastString dot_buf (len - qual_size)) + if parens -- Prelude.(+) + then lexemeToFastString (stepOn dot_buf) (len - qual_size - 2) + else lexemeToFastString dot_buf (len - qual_size)) where qual_size = orig_buf `byteDiff` dot_buf @@ -973,8 +990,10 @@ varid span buf len = conid buf len = ITconid fs where fs = lexemeToFastString buf len -qvarsym buf len = ITqvarsym $! splitQualName buf len -qconsym buf len = ITqconsym $! splitQualName buf len +qvarsym buf len = ITqvarsym $! splitQualName buf len False +qconsym buf len = ITqconsym $! splitQualName buf len False +prefixqvarsym buf len = ITprefixqvarsym $! splitQualName buf len True +prefixqconsym buf len = ITprefixqconsym $! splitQualName buf len True varsym = sym ITvarsym consym = sym ITconsym @@ -1537,13 +1556,13 @@ alexGetChar (AI loc ofs s) DecimalNumber -> digit LetterNumber -> other_graphic OtherNumber -> other_graphic - ConnectorPunctuation -> other_graphic - DashPunctuation -> other_graphic + ConnectorPunctuation -> symbol + DashPunctuation -> symbol OpenPunctuation -> other_graphic ClosePunctuation -> other_graphic InitialQuote -> other_graphic FinalQuote -> other_graphic - OtherPunctuation -> other_graphic + OtherPunctuation -> symbol MathSymbol -> symbol CurrencySymbol -> symbol ModifierSymbol -> symbol @@ -1609,6 +1628,7 @@ transformComprehensionsBit = 17 qqBit = 18 -- enable quasiquoting inRulePragBit = 19 rawTokenStreamBit = 20 -- producing a token stream with all comments included +newQualOpsBit = 21 -- Haskell' qualified operator syntax, e.g. Prelude.(+) genericsEnabled, ffiEnabled, parrEnabled :: Int -> Bool always _ = True @@ -1632,6 +1652,8 @@ transformComprehensionsEnabled flags = testBit flags transformComprehensionsBit qqEnabled flags = testBit flags qqBit inRulePrag flags = testBit flags inRulePragBit rawTokenStreamEnabled flags = testBit flags rawTokenStreamBit +newQualOps flags = testBit flags newQualOpsBit +oldQualOps flags = not (newQualOps flags) -- PState for parsing options pragmas -- @@ -1695,6 +1717,7 @@ mkPState buf loc 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 -- setBitIf :: Int -> Bool -> Int b `setBitIf` cond | cond = bit b