Commit 9a57cfeb authored by Alec Theriault's avatar Alec Theriault Committed by Ben Gamari

Option for LINE pragmas to get lexed into tokens

This adds a parser-level switch to have 'LINE' and 'COLUMN'
pragmas lexed into actual tokens (as opposed to updating the
position information in the parser).

'lexTokenStream' is the only place where this option is enabled.

Reviewers: bgamari, alexbiehl, mpickering

Reviewed By: mpickering

Subscribers: alanz, rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4336
parent bd58e290
...@@ -652,7 +652,8 @@ data Token ...@@ -652,7 +652,8 @@ data Token
| ITrules_prag SourceText | ITrules_prag SourceText
| ITwarning_prag SourceText | ITwarning_prag SourceText
| ITdeprecated_prag SourceText | ITdeprecated_prag SourceText
| ITline_prag | ITline_prag SourceText -- not usually produced, see 'use_pos_prags'
| ITcolumn_prag SourceText -- not usually produced, see 'use_pos_prags'
| ITscc_prag SourceText | ITscc_prag SourceText
| ITgenerated_prag SourceText | ITgenerated_prag SourceText
| ITcore_prag SourceText -- hdaume: core annotations | ITcore_prag SourceText -- hdaume: core annotations
...@@ -1147,6 +1148,27 @@ rulePrag span buf len = do ...@@ -1147,6 +1148,27 @@ rulePrag span buf len = do
let !src = lexemeToString buf len let !src = lexemeToString buf len
return (L span (ITrules_prag (SourceText src))) return (L span (ITrules_prag (SourceText src)))
-- When 'use_pos_prags' is not set, it is expected that we emit a token instead
-- of updating the position in 'PState'
linePrag :: Action
linePrag span buf len = do
ps <- getPState
if use_pos_prags ps
then begin line_prag2 span buf len
else let !src = lexemeToString buf len
in return (L span (ITline_prag (SourceText src)))
-- When 'use_pos_prags' is not set, it is expected that we emit a token instead
-- of updating the position in 'PState'
columnPrag :: Action
columnPrag span buf len = do
ps <- getPState
let !src = lexemeToString buf len
if use_pos_prags ps
then begin column_prag span buf len
else let !src = lexemeToString buf len
in return (L span (ITcolumn_prag (SourceText src)))
endPrag :: Action endPrag :: Action
endPrag span _buf _len = do endPrag span _buf _len = do
setExts (.&. complement (xbit InRulePragBit)) setExts (.&. complement (xbit InRulePragBit))
...@@ -1892,6 +1914,10 @@ data PState = PState { ...@@ -1892,6 +1914,10 @@ data PState = PState {
-- token doesn't need to close anything: -- token doesn't need to close anything:
alr_justClosedExplicitLetBlock :: Bool, alr_justClosedExplicitLetBlock :: Bool,
-- If this is enabled, '{-# LINE ... -#}' and '{-# COLUMN ... #-}'
-- update the 'loc' field. Otherwise, those pragmas are lexed as tokens.
use_pos_prags :: Bool,
-- The next three are used to implement Annotations giving the -- The next three are used to implement Annotations giving the
-- locations of 'noise' tokens in the source, so that users of -- locations of 'noise' tokens in the source, so that users of
-- the GHC API can do source to source conversions. -- the GHC API can do source to source conversions.
...@@ -2398,6 +2424,7 @@ mkPStatePure options buf loc = ...@@ -2398,6 +2424,7 @@ mkPStatePure options buf loc =
alr_context = [], alr_context = [],
alr_expecting_ocurly = Nothing, alr_expecting_ocurly = Nothing,
alr_justClosedExplicitLetBlock = False, alr_justClosedExplicitLetBlock = False,
use_pos_prags = True,
annotations = [], annotations = [],
comment_q = [], comment_q = [],
annotations_comments = [] annotations_comments = []
...@@ -2809,14 +2836,14 @@ reportLexError loc1 loc2 buf str ...@@ -2809,14 +2836,14 @@ reportLexError loc1 loc2 buf str
lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token] lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token]
lexTokenStream buf loc dflags = unP go initState lexTokenStream buf loc dflags = unP go initState
where dflags' = gopt_set (gopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream where dflags' = gopt_set (gopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream
initState = mkPState dflags' buf loc initState = (mkPState dflags' buf loc) { use_pos_prags = False }
go = do go = do
ltok <- lexer False return ltok <- lexer False return
case ltok of case ltok of
L _ ITeof -> return [] L _ ITeof -> return []
_ -> liftM (ltok:) go _ -> liftM (ltok:) go
linePrags = Map.singleton "line" (begin line_prag2) linePrags = Map.singleton "line" linePrag
fileHeaderPrags = Map.fromList([("options", lex_string_prag IToptions_prag), fileHeaderPrags = Map.fromList([("options", lex_string_prag IToptions_prag),
("options_ghc", lex_string_prag IToptions_prag), ("options_ghc", lex_string_prag IToptions_prag),
...@@ -2861,7 +2888,7 @@ oneWordPrags = Map.fromList [ ...@@ -2861,7 +2888,7 @@ oneWordPrags = Map.fromList [
("incoherent", strtoken (\s -> ITincoherent_prag (SourceText s))), ("incoherent", strtoken (\s -> ITincoherent_prag (SourceText s))),
("ctype", strtoken (\s -> ITctype (SourceText s))), ("ctype", strtoken (\s -> ITctype (SourceText s))),
("complete", strtoken (\s -> ITcomplete_prag (SourceText s))), ("complete", strtoken (\s -> ITcomplete_prag (SourceText s))),
("column", begin column_prag) ("column", columnPrag)
] ]
twoWordPrags = Map.fromList([ twoWordPrags = Map.fromList([
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment