From 488aa22f393c0addb4c0e0b63cfe0aaea32b85d7 Mon Sep 17 00:00:00 2001 From: Ben Sklaroff Date: Thu, 12 Jul 2018 11:41:10 -0400 Subject: Add ITcomment_line_prag token to Hyperlinker Parser This token is necessary for parsing #line pragmas inside nested comments. Reviewers: bgamari Reviewed By: bgamari Differential Revision: https://phabricator.haskell.org/D4935 --- haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'haddock-api/src/Haddock/Backends') diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs index acb2c892..f8494242 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs @@ -144,7 +144,7 @@ spanToNewline 0 str@(c:_) | ((lexed, str') : _) <- R.lex str, not (isSpace c) = -- A Haskell line comment then case span (/= '\n') str' of (str'', '\n':rest) -> (lexed ++ str'' ++ "\n", rest) - (_, _) -> (str, "") + (_, _) -> (str, "") -- An actual Haskell token else let (str'', rest) = spanToNewline 0 str' @@ -165,10 +165,10 @@ ghcToks = reverse . (\(_,ts,_) -> ts) . foldl' go (start, [], False) go :: (RealSrcLoc, [T.Token], Bool) -- ^ current position, tokens accumulated, currently in pragma (or not) - + -> (Located L.Token, String) -- ^ next token, its content - + -> (RealSrcLoc, [T.Token], Bool) -- ^ new position, new tokens accumulated, currently in pragma (or not) @@ -179,12 +179,12 @@ ghcToks = reverse . (\(_,ts,_) -> ts) . foldl' go (start, [], False) ) where (next_pos, white) = mkWhitespace pos l - + classifiedTok = [ Token (classify' tok) raw rss | RealSrcSpan rss <- [l] , not (null raw) ] - + classify' | in_prag = const TkPragma | otherwise = classify @@ -378,6 +378,7 @@ classify tok = ITLarrowtail {} -> TkGlyph ITRarrowtail {} -> TkGlyph + ITcomment_line_prag -> TkUnknown ITunknown {} -> TkUnknown ITeof -> TkUnknown -- cgit v1.2.3