[Git][ghc/ghc][wip/op-ws-consym-2] Fix -Woperator-whitespace for consym (part of #19372)
Vladislav Zavialov (@int-index)
gitlab at gitlab.haskell.org
Sun Sep 18 14:14:26 UTC 2022
Vladislav Zavialov pushed to branch wip/op-ws-consym-2 at Glasgow Haskell Compiler / GHC
Commits:
07c779a6 by Vladislav Zavialov at 2022-09-18T17:09:29+03:00
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.
- - - - -
5 changed files:
- compiler/GHC/Parser/Lexer.x
- docs/users_guide/9.6.1-notes.rst
- + testsuite/tests/parser/should_compile/T19372consym.hs
- + testsuite/tests/parser/should_compile/T19372consym.stderr
- testsuite/tests/parser/should_compile/all.T
Changes:
=====================================
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 at 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 at 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 at 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 =
=====================================
docs/users_guide/9.6.1-notes.rst
=====================================
@@ -68,6 +68,9 @@ Compiler
- The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included
in :extension:`PolyKinds` and :extension:`DataKinds`.
+- The :ghc-flag:`-Woperator-whitespace` warning no longer ignores constructor symbols
+ (operators starting with ``:``).
+
GHCi
~~~~
=====================================
testsuite/tests/parser/should_compile/T19372consym.hs
=====================================
@@ -0,0 +1,15 @@
+{-# OPTIONS -Woperator-whitespace #-}
+
+module T19372consym where
+
+import Data.List.NonEmpty
+
+a_suffix = \x y -> x: y
+a_prefix = \x y -> x :y
+a_tight_infix = \x y -> x:y
+a_loose_infix = \x y -> x : y -- Only this one should be without a warning.
+
+b_suffix = \x y -> x:| y
+b_prefix = \x y -> x :|y
+b_tight_infix = \x y -> x:|y
+b_loose_infix = \x y -> x :| y -- Only this one should be without a warning.
=====================================
testsuite/tests/parser/should_compile/T19372consym.stderr
=====================================
@@ -0,0 +1,15 @@
+
+T19372consym.hs:12:26: warning: [GHC-40798] [-Woperator-whitespace]
+ The suffix use of a ‘:|’ might be repurposed as special syntax
+ by a future language extension.
+ Suggested fix: Add whitespace around ‘:|’.
+
+T19372consym.hs:13:27: warning: [GHC-40798] [-Woperator-whitespace]
+ The prefix use of a ‘:|’ might be repurposed as special syntax
+ by a future language extension.
+ Suggested fix: Add whitespace around ‘:|’.
+
+T19372consym.hs:14:26: warning: [GHC-40798] [-Woperator-whitespace]
+ The tight infix use of a ‘:|’ might be repurposed as special syntax
+ by a future language extension.
+ Suggested fix: Add whitespace around ‘:|’.
=====================================
testsuite/tests/parser/should_compile/all.T
=====================================
@@ -193,3 +193,4 @@ test('T20718', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-c
test('T20718b', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast -dkeep-comments'])
test('T21589', normal, compile, [''])
+test('T19372consym', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07c779a6dd51efd7649645f9387c5c63d989c2f2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07c779a6dd51efd7649645f9387c5c63d989c2f2
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220918/37eaa64a/attachment-0001.html>
More information about the ghc-commits
mailing list