diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2019-02-03 10:27:42 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-02-08 11:00:22 -0500 |
| commit | c1cf2693d6efddeeeb813cd8995a1be136800d17 (patch) | |
| tree | 24130e1f3f9b697e7cb622ebf780f36f2271c5f0 /compiler/parser | |
| parent | 5e9888bd9c22a1315a703f638591b50e657317c4 (diff) | |
| download | haskell-c1cf2693d6efddeeeb813cd8995a1be136800d17.tar.gz | |
Lexer: Alternate Layout Rule injects actual not virtual braces
When the alternate layout rule is activated via a pragma, it injects
tokens for { and } to make sure that the source is parsed properly.
But it injects ITocurly and ITccurly, rather than their virtual
counterparts ITvocurly and ITvccurly.
This causes problems for ghc-exactprint, which tries to print these.
Likewise, any injected ITsemi should have a zero-width SrcSpan.
Test case (the existing T13087.hs)
{-# LANGUAGE AlternativeLayoutRule #-}
{-# LANGUAGE LambdaCase #-}
isOne :: Int -> Bool
isOne = \case 1 -> True
_ -> False
main = return ()
Closes #16279
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Lexer.x | 32 |
1 files changed, 17 insertions, 15 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 0606c56297..8219390e7e 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -2697,23 +2697,23 @@ alternativeLayoutRuleToken t do setAlrExpectingOCurly Nothing setALRContext (ALRLayout expectingOCurly thisCol : context) setNextToken t - return (L thisLoc ITocurly) + return (L thisLoc ITvocurly) | otherwise -> do setAlrExpectingOCurly Nothing - setPendingImplicitTokens [L lastLoc ITccurly] + setPendingImplicitTokens [L lastLoc ITvccurly] setNextToken t - return (L lastLoc ITocurly) + return (L lastLoc ITvocurly) (_, _, Just expectingOCurly) -> do setAlrExpectingOCurly Nothing setALRContext (ALRLayout expectingOCurly thisCol : context) setNextToken t - return (L thisLoc ITocurly) + return (L thisLoc ITvocurly) -- We do the [] cases earlier than in the spec, as we -- have an actual EOF token (ITeof, ALRLayout _ _ : ls, _) -> do setALRContext ls setNextToken t - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) (ITeof, _, _) -> return t -- the other ITeof case omitted; general case below covers it @@ -2724,7 +2724,7 @@ alternativeLayoutRuleToken t | newLine -> do setPendingImplicitTokens [t] setALRContext ls - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) -- This next case is to handle a transitional issue: (ITwhere, ALRLayout _ col : ls, _) | newLine && thisCol == col && transitional -> @@ -2736,7 +2736,7 @@ alternativeLayoutRuleToken t setNextToken t -- Note that we use lastLoc, as we may need to close -- more layouts, or give a semicolon - return (L lastLoc ITccurly) + return (L lastLoc ITvccurly) -- This next case is to handle a transitional issue: (ITvbar, ALRLayout _ col : ls, _) | newLine && thisCol == col && transitional -> @@ -2748,17 +2748,19 @@ alternativeLayoutRuleToken t setNextToken t -- Note that we use lastLoc, as we may need to close -- more layouts, or give a semicolon - return (L lastLoc ITccurly) + return (L lastLoc ITvccurly) (_, ALRLayout _ col : ls, _) | newLine && thisCol == col -> do setNextToken t - return (L thisLoc ITsemi) + let loc = realSrcSpanStart thisLoc + zeroWidthLoc = mkRealSrcSpan loc loc + return (L zeroWidthLoc ITsemi) | newLine && thisCol < col -> do setALRContext ls setNextToken t -- Note that we use lastLoc, as we may need to close -- more layouts, or give a semicolon - return (L lastLoc ITccurly) + return (L lastLoc ITvccurly) -- We need to handle close before open, as 'then' is both -- an open and a close (u, _, _) @@ -2767,7 +2769,7 @@ alternativeLayoutRuleToken t ALRLayout _ _ : ls -> do setALRContext ls setNextToken t - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) ALRNoLayout _ isLet : ls -> do let ls' = if isALRopen u then ALRNoLayout (containsCommas u) False : ls @@ -2790,21 +2792,21 @@ alternativeLayoutRuleToken t (ITin, ALRLayout ALRLayoutLet _ : ls, _) -> do setALRContext ls setPendingImplicitTokens [t] - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) (ITin, ALRLayout _ _ : ls, _) -> do setALRContext ls setNextToken t - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) -- the other ITin case omitted; general case below covers it (ITcomma, ALRLayout _ _ : ls, _) | topNoLayoutContainsCommas ls -> do setALRContext ls setNextToken t - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) (ITwhere, ALRLayout ALRLayoutDo _ : ls, _) -> do setALRContext ls setPendingImplicitTokens [t] - return (L thisLoc ITccurly) + return (L thisLoc ITvccurly) -- the other ITwhere case omitted; general case below covers it (_, _, _) -> return t |