Fixed up the parsing of PRAGMAs to make it a bit simple, and match with other changes to the lexer and parser
This commit is contained in:
parent
1e538fc592
commit
7b55c96781
|
@ -1349,14 +1349,13 @@ pragma :: OccParser ()
|
||||||
pragma = do Pragma rawP <- genToken isPragma
|
pragma = do Pragma rawP <- genToken isPragma
|
||||||
m <- getPosition >>* sourcePosToMeta
|
m <- getPosition >>* sourcePosToMeta
|
||||||
pragToks <- case runPragmaLexer "<unknown(pragma)>" rawP of
|
pragToks <- case runPragmaLexer "<unknown(pragma)>" rawP of
|
||||||
Left _ -> return []
|
Left _ -> do warnP m WarnUnknownPreprocessorDirective $
|
||||||
|
"Unknown PRAGMA: " ++ rawP
|
||||||
|
return []
|
||||||
Right toks -> return toks
|
Right toks -> return toks
|
||||||
cs <- getCompState
|
cs <- getCompState
|
||||||
maybeParse <- return $
|
prod <- return $
|
||||||
-- Maybe monad:
|
-- Maybe monad:
|
||||||
(\prod -> do otherToks <- safeTail pragToks
|
|
||||||
eitherToMaybe $ runParser (prod >> getState) ([], cs) "" otherToks
|
|
||||||
) $ -- Maybe monad again:
|
|
||||||
case
|
case
|
||||||
[ do Token _ (Pragma firstTok) <- listToMaybe pragToks
|
[ do Token _ (Pragma firstTok) <- listToMaybe pragToks
|
||||||
matchRegex (mkRegex pt) firstTok
|
matchRegex (mkRegex pt) firstTok
|
||||||
|
@ -1401,10 +1400,15 @@ pragma = do Pragma rawP <- genToken isPragma
|
||||||
, csExternals = (on, fs) : csExternals st
|
, csExternals = (on, fs) : csExternals st
|
||||||
}
|
}
|
||||||
_ -> warnP m WarnUnknownPreprocessorDirective $
|
_ -> warnP m WarnUnknownPreprocessorDirective $
|
||||||
"Unknown PRAGMA: " ++ show (listToMaybe pragToks)
|
"Unknown PRAGMA type: " ++ show (listToMaybe pragToks)
|
||||||
case maybeParse of
|
let otherToks = safeTail pragToks
|
||||||
Just st -> setState st
|
case otherToks of
|
||||||
Nothing -> return ()
|
Nothing -> warnP m WarnUnknownPreprocessorDirective $
|
||||||
|
"Unknown PRAGMA (no tokens): " ++ rawP
|
||||||
|
Just toks -> case runParser (prod >> getState) cs "" toks of
|
||||||
|
Left err -> warnP m WarnUnknownPreprocessorDirective $
|
||||||
|
"Unknown PRAGMA (parse failed): " ++ show err
|
||||||
|
Right st -> setState st
|
||||||
eol
|
eol
|
||||||
where
|
where
|
||||||
isPragma (Token _ p@(Pragma {})) = Just p
|
isPragma (Token _ p@(Pragma {})) = Just p
|
||||||
|
|
Loading…
Reference in New Issue
Block a user