X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=56d036e9f18a8bc0044da4fec1ebc4d20bbf4e6f;hb=b88025eabcd83f65d1d81f09272f5172f06a60e7;hp=4806a8a3ef9bc36774c60fb447914dae66bc9ebc;hpb=190f24892156953d73b55401d0467a6f1a88ce5d;p=ghc-hetmet.git diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 4806a8a..56d036e 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -43,10 +43,10 @@ import DynFlags import Ctype import Util ( maybePrefixMatch, readRational ) -import DATA_BITS +import Data.Bits 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 ) @@ -690,24 +690,23 @@ pop _span _buf _len = do popLexState; lexToken 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) - = atEnd buf || currentChar buf `notElem` "!#$%&*+./<=>?@\\^|-~" + = nextCharIs buf (`notElem` "!#$%&*+./<=>?@\\^|-~") isNormalComment bits _ _ (AI _ _ buf) - = (if haddockEnabled bits then False else (followedBySpaceDoc buf)) - || notFollowedByDocOrPragma + | haddockEnabled bits = notFollowedByDocOrPragma + | otherwise = nextCharIs buf (/='#') 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)