projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Standalone deriving wibbles: keyword is 'derive' not 'derived'; and add flag document...
[ghc-hetmet.git]
/
compiler
/
parser
/
Lexer.x
diff --git
a/compiler/parser/Lexer.x
b/compiler/parser/Lexer.x
index
4806a8a
..
bb0fc1e
100644
(file)
--- a/
compiler/parser/Lexer.x
+++ b/
compiler/parser/Lexer.x
@@
-43,10
+43,10
@@
import DynFlags
import Ctype
import Util ( maybePrefixMatch, readRational )
import Ctype
import Util ( maybePrefixMatch, readRational )
-import DATA_BITS
+import Data.Bits
import Data.Char ( chr, isSpace )
import Data.Char ( chr, isSpace )
-import Ratio
-import TRACE
+import Data.Ratio
+import Debug.Trace
#if __GLASGOW_HASKELL__ >= 605
import Data.Char ( GeneralCategory(..), generalCategory, isPrint, isUpper )
#if __GLASGOW_HASKELL__ >= 605
import Data.Char ( GeneralCategory(..), generalCategory, isPrint, isUpper )
@@
-233,6
+233,8
@@
$white_no_nl+ ;
"{-#" $whitechar* (DEPRECATED|deprecated)
{ token ITdeprecated_prag }
"{-#" $whitechar* (SCC|scc) { token ITscc_prag }
"{-#" $whitechar* (DEPRECATED|deprecated)
{ token ITdeprecated_prag }
"{-#" $whitechar* (SCC|scc) { token ITscc_prag }
+ "{-#" $whitechar* (GENERATED|generated)
+ { token ITgenerated_prag }
"{-#" $whitechar* (CORE|core) { token ITcore_prag }
"{-#" $whitechar* (UNPACK|unpack) { token ITunpack_prag }
"{-#" $whitechar* (CORE|core) { token ITcore_prag }
"{-#" $whitechar* (UNPACK|unpack) { token ITunpack_prag }
@@
-387,9
+389,9
@@
data Token
| ITdata
| ITdefault
| ITderiving
| ITdata
| ITdefault
| ITderiving
+ | ITderive
| ITdo
| ITelse
| ITdo
| ITelse
- | ITfor
| IThiding
| ITif
| ITimport
| IThiding
| ITif
| ITimport
@@
-432,6
+434,7
@@
data Token
| ITdeprecated_prag
| ITline_prag
| ITscc_prag
| ITdeprecated_prag
| ITline_prag
| ITscc_prag
+ | ITgenerated_prag
| ITcore_prag -- hdaume: core annotations
| ITunpack_prag
| ITclose_prag
| ITcore_prag -- hdaume: core annotations
| ITunpack_prag
| ITclose_prag
@@
-541,7
+544,7
@@
isSpecial :: Token -> Bool
-- not as a keyword.
isSpecial ITas = True
isSpecial IThiding = True
-- not as a keyword.
isSpecial ITas = True
isSpecial IThiding = True
-isSpecial ITfor = True
+isSpecial ITderive = True
isSpecial ITqualified = True
isSpecial ITforall = True
isSpecial ITexport = True
isSpecial ITqualified = True
isSpecial ITforall = True
isSpecial ITexport = True
@@
-573,9
+576,9
@@
reservedWordsFM = listToUFM $
( "data", ITdata, 0 ),
( "default", ITdefault, 0 ),
( "deriving", ITderiving, 0 ),
( "data", ITdata, 0 ),
( "default", ITdefault, 0 ),
( "deriving", ITderiving, 0 ),
+ ( "derive", ITderive, 0 ),
( "do", ITdo, 0 ),
( "else", ITelse, 0 ),
( "do", ITdo, 0 ),
( "else", ITelse, 0 ),
- ( "for", ITfor, 0 ),
( "hiding", IThiding, 0 ),
( "if", ITif, 0 ),
( "import", ITimport, 0 ),
( "hiding", IThiding, 0 ),
( "if", ITif, 0 ),
( "import", ITimport, 0 ),
@@
-690,24
+693,23
@@
pop _span _buf _len = do popLexState; lexToken
pop_and :: Action -> Action
pop_and act span buf len = do popLexState; act span buf len
pop_and :: Action -> Action
pop_and act span buf len = do popLexState; act span buf len
-notFollowedBy char _ _ _ (AI _ _ buf) = atEnd buf || currentChar buf /= char
+{-# INLINE nextCharIs #-}
+nextCharIs buf p = not (atEnd buf) && p (currentChar buf)
+
+notFollowedBy char _ _ _ (AI _ _ buf)
+ = nextCharIs buf (/=char)
notFollowedBySymbol _ _ _ (AI _ _ buf)
notFollowedBySymbol _ _ _ (AI _ _ buf)
- = atEnd buf || currentChar buf `notElem` "!#$%&*+./<=>?@\\^|-~"
+ = nextCharIs buf (`notElem` "!#$%&*+./<=>?@\\^|-~")
isNormalComment bits _ _ (AI _ _ buf)
isNormalComment bits _ _ (AI _ _ buf)
- = (if haddockEnabled bits then False else (followedBySpaceDoc buf))
- || notFollowedByDocOrPragma
+ | haddockEnabled bits = notFollowedByDocOrPragma
+ | otherwise = nextCharIs buf (/='#')
where
where
- notFollowedByDocOrPragma = not $ spaceAndP buf
- (\buf' -> currentChar buf' `elem` "|^*$#")
-
-spaceAndP buf p = p buf || currentChar buf == ' ' && p buf'
- where buf' = snd (nextChar buf)
-
-followedBySpaceDoc buf = spaceAndP buf followedByDoc
+ notFollowedByDocOrPragma
+ = not $ spaceAndP buf (`nextCharIs` (`elem` "|^*$#"))
-followedByDoc buf = currentChar buf `elem` "|^*$"
+spaceAndP buf p = p buf || nextCharIs buf (==' ') && p (snd (nextChar buf))
haddockDisabledAnd p bits _ _ (AI _ _ buf)
= if haddockEnabled bits then False else (p buf)
haddockDisabledAnd p bits _ _ (AI _ _ buf)
= if haddockEnabled bits then False else (p buf)