Add (a) CoreM monad, (b) new Annotations feature

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

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 613848a..0dd36ff 100644 (file)
--- 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) }
@@ -250,6 +261,7 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
                                        { token ITgenerated_prag }
   "{-#" $whitechar* (CORE|core)                { token ITcore_prag }
   "{-#" $whitechar* (UNPACK|unpack)    { token ITunpack_prag }
+  "{-#" $whitechar* (ANN|ann)          { token ITann_prag }
 
   -- We ignore all these pragmas, but don't generate a warning for them
   -- CFILES is a hugs-only thing.
@@ -365,13 +377,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
@@ -477,6 +491,7 @@ data Token
   | ITgenerated_prag
   | ITcore_prag                 -- hdaume: core annotations
   | ITunpack_prag
+  | ITann_prag
   | ITclose_prag
   | IToptions_prag String
   | ITinclude_prag String
@@ -527,6 +542,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 +890,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 +941,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 +968,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 +992,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 +1558,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 +1630,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 +1654,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 +1719,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