FIX: #1253 (Can't use non-layout at top level)

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

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 4238938..4caca44 100644 (file)
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -271,8 +271,8 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
 -- Haddock comments
 
 <0,glaexts> {
-  "-- " / $docsym    { multiline_doc_comment }
-  "{-" \ ? / $docsym { nested_doc_comment }
+  "-- " $docsym    / { ifExtension haddockEnabled } { multiline_doc_comment }
+  "{-" \ ? $docsym / { ifExtension haddockEnabled } { nested_doc_comment }
 }
 
 -- "special" symbols
@@ -379,11 +379,6 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
 }
 
 {
--- work around bug in Alex 2.0
-#if __GLASGOW_HASKELL__ < 503
-unsafeAt arr i = arr ! i
-#endif
-
 -- -----------------------------------------------------------------------------
 -- The token type
 
@@ -646,13 +641,12 @@ reservedSymsFM = listToUFM $
        ,(">>-",        ITRarrowtail,   bit arrowsBit)
 
 #if __GLASGOW_HASKELL__ >= 605
-       ,("λ", ITlam,          bit glaExtsBit)
        ,("∷",   ITdcolon,       bit glaExtsBit)
        ,("⇒",   ITdarrow,    bit glaExtsBit)
        ,("∀",        ITforall,       bit glaExtsBit)
        ,("→",   ITrarrow,    bit glaExtsBit)
        ,("←",   ITlarrow,    bit glaExtsBit)
-       ,("?",  ITdotdot,       bit glaExtsBit)
+       ,("⋯",        ITdotdot,       bit glaExtsBit)
         -- ToDo: ideally, → and ∷ should be "specials", so that they cannot
         -- form part of a large operator.  This would let us have a better
         -- syntax for kinds: ɑ∷*→* would be a legal kind signature. (maybe).
@@ -706,13 +700,7 @@ notFollowedBySymbol _ _ _ (AI _ _ buf)
   = nextCharIs buf (`notElem` "!#$%&*+./<=>?@\\^|-~")
 
 isNormalComment bits _ _ (AI _ _ buf)
-  | haddockEnabled bits = notFollowedByDocOrPragma
-  | otherwise           = nextCharIs buf (/='#')
-  where 
-    notFollowedByDocOrPragma 
-       = not $ spaceAndP buf (`nextCharIs` (`elem` "|^*$#"))
-
-spaceAndP buf p = p buf || nextCharIs buf (==' ') && p (snd (nextChar buf))
+  = nextCharIs buf (/='#')
 
 haddockDisabledAnd p bits _ _ (AI _ _ buf)
   = if haddockEnabled bits then False else (p buf)
@@ -791,13 +779,12 @@ nested_doc_comment span buf _len = withLexedDocType (go "")
       Just (c,input) -> go (c:commentAcc) input docType False
 
 withLexedDocType lexDocComment = do
-  input <- getInput
-  case alexGetChar input of
-    Nothing -> error "Can't happen"
-    Just ('|', input) -> lexDocComment input ITdocCommentNext False
-    Just ('^', input) -> lexDocComment input ITdocCommentPrev False
-    Just ('$', input) -> lexDocComment input ITdocCommentNamed False
-    Just ('*', input) -> lexDocSection 1 input 
+  input@(AI _ _ buf) <- getInput
+  case prevChar buf ' ' of
+    '|' -> lexDocComment input ITdocCommentNext False
+    '^' -> lexDocComment input ITdocCommentPrev False
+    '$' -> lexDocComment input ITdocCommentNamed False
+    '*' -> lexDocSection 1 input 
  where 
     lexDocSection n input = case alexGetChar input of 
       Just ('*', input) -> lexDocSection (n+1) input