diff options
author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2022-09-18 15:49:50 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-09-20 03:50:42 -0400 |
commit | 59fe128c37b2befb1ece4bf3f8f5c9082bd213eb (patch) | |
tree | 98a239beac6d9ce896d72ab087215f014230cf28 /compiler/GHC/Parser | |
parent | 545ff490144ed3ddd596d2a0c01b0a16b5528f63 (diff) | |
download | haskell-59fe128c37b2befb1ece4bf3f8f5c9082bd213eb.tar.gz |
Fix -Woperator-whitespace for consym (part of #19372)
Due to an oversight, the initial specification and implementation of
-Woperator-whitespace focused on varsym exclusively and completely
ignored consym.
This meant that expressions such as "x+ y" would produce a warning,
while "x:+ y" would not.
The specification was corrected in ghc-proposals pull request #404,
and this patch updates the implementation accordingly.
Regression test included.
Diffstat (limited to 'compiler/GHC/Parser')
-rw-r--r-- | compiler/GHC/Parser/Lexer.x | 45 |
1 files changed, 29 insertions, 16 deletions
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x index e79fbf28b4..8e2efe48f0 100644 --- a/compiler/GHC/Parser/Lexer.x +++ b/compiler/GHC/Parser/Lexer.x @@ -496,7 +496,7 @@ $tab { warnTab } @qvarsym { idtoken qvarsym } @qconsym { idtoken qconsym } @varsym { with_op_ws varsym } - @consym { consym } + @consym { with_op_ws consym } } -- For the normal boxed literals we need to be careful @@ -1681,7 +1681,7 @@ qconsym buf len = ITqconsym $! splitQualName buf len False -- See Note [Whitespace-sensitive operator parsing] varsym :: OpWs -> Action -varsym OpWsPrefix = sym $ \span exts s -> +varsym opws@OpWsPrefix = sym $ \span exts s -> let warnExtConflict errtok = do { addPsMessage (mkSrcSpanPs span) (PsWarnOperatorWhitespaceExtConflict errtok) ; return (ITvarsym s) } @@ -1709,35 +1709,48 @@ varsym OpWsPrefix = sym $ \span exts s -> | s == fsLit "!" -> return ITbang | s == fsLit "~" -> return ITtilde | otherwise -> - do { addPsMessage - (mkSrcSpanPs span) - (PsWarnOperatorWhitespace s OperatorWhitespaceOccurrence_Prefix) + do { warnOperatorWhitespace opws span s ; return (ITvarsym s) } -varsym OpWsSuffix = sym $ \span _ s -> +varsym opws@OpWsSuffix = sym $ \span _ s -> if | s == fsLit "@" -> failMsgP (\srcLoc -> mkPlainErrorMsgEnvelope srcLoc $ PsErrSuffixAT) | s == fsLit "." -> return ITdot | otherwise -> - do { addPsMessage - (mkSrcSpanPs span) - (PsWarnOperatorWhitespace s OperatorWhitespaceOccurrence_Suffix) + do { warnOperatorWhitespace opws span s ; return (ITvarsym s) } -varsym OpWsTightInfix = sym $ \span exts s -> +varsym opws@OpWsTightInfix = sym $ \span exts s -> if | s == fsLit "@" -> return ITat | s == fsLit ".", OverloadedRecordDotBit `xtest` exts -> return (ITproj False) | s == fsLit "." -> return ITdot | otherwise -> - do { addPsMessage - (mkSrcSpanPs span) - (PsWarnOperatorWhitespace s (OperatorWhitespaceOccurrence_TightInfix)) - ; return (ITvarsym s) } + do { warnOperatorWhitespace opws span s + ; return (ITvarsym s) } varsym OpWsLooseInfix = sym $ \_ _ s -> if | s == fsLit "." -> return ITdot | otherwise -> return $ ITvarsym s -consym :: Action -consym = sym (\_span _exts s -> return $ ITconsym s) +consym :: OpWs -> Action +consym opws = sym $ \span _exts s -> + do { warnOperatorWhitespace opws span s + ; return (ITconsym s) } + +warnOperatorWhitespace :: OpWs -> PsSpan -> FastString -> P () +warnOperatorWhitespace opws span s = + whenIsJust (check_unusual_opws opws) $ \opws' -> + addPsMessage + (mkSrcSpanPs span) + (PsWarnOperatorWhitespace s opws') + +-- Check an operator occurrence for unusual whitespace (prefix, suffix, tight infix). +-- This determines if -Woperator-whitespace is triggered. +check_unusual_opws :: OpWs -> Maybe OperatorWhitespaceOccurrence +check_unusual_opws opws = + case opws of + OpWsPrefix -> Just OperatorWhitespaceOccurrence_Prefix + OpWsSuffix -> Just OperatorWhitespaceOccurrence_Suffix + OpWsTightInfix -> Just OperatorWhitespaceOccurrence_TightInfix + OpWsLooseInfix -> Nothing sym :: (PsSpan -> ExtsBitmap -> FastString -> P Token) -> Action sym con span buf len _buf2 = |