[Git][ghc/ghc][wip/warn-operator-whitespace] Implement -Woperator-whitespace (#18834)
Vladislav Zavialov
gitlab at gitlab.haskell.org
Tue Oct 13 12:57:46 UTC 2020
Vladislav Zavialov pushed to branch wip/warn-operator-whitespace at Glasgow Haskell Compiler / GHC
Commits:
ce485f06 by Vladislav Zavialov at 2020-10-13T15:57:14+03:00
Implement -Woperator-whitespace (#18834)
This patch implements two related warnings:
-Woperator-whitespace-ext-conflict
warns on uses of infix operators that would be parsed
differently were a particular GHC extension enabled
-Woperator-whitespace
warns on prefix, suffix, and tight infix uses of infix
operators
Updates the containers submodule.
- - - - -
16 changed files:
- compiler/GHC/Cmm/CallConv.hs
- compiler/GHC/CmmToLlvm/Regs.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Parser/Errors.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Runtime/Eval.hs
- docs/users_guide/using-warnings.rst
- libraries/containers
- + testsuite/tests/parser/should_compile/T18834a.hs
- + testsuite/tests/parser/should_compile/T18834a.stderr
- + testsuite/tests/parser/should_compile/T18834b.hs
- + testsuite/tests/parser/should_compile/T18834b.stderr
- testsuite/tests/parser/should_compile/all.T
- testsuite/tests/typecheck/should_compile/T16312.hs
Changes:
=====================================
compiler/GHC/Cmm/CallConv.hs
=====================================
@@ -207,14 +207,14 @@ nodeOnly = ([VanillaReg 1], [], [], [], [])
realArgRegsCover :: Platform -> [GlobalReg]
realArgRegsCover platform
| passFloatArgsInXmm platform
- = map ($VGcPtr) (realVanillaRegs platform) ++
+ = map ($ VGcPtr) (realVanillaRegs platform) ++
realLongRegs platform ++
realDoubleRegs platform -- we only need to save the low Double part of XMM registers.
-- Moreover, the NCG can't load/store full XMM
-- registers for now...
| otherwise
- = map ($VGcPtr) (realVanillaRegs platform) ++
+ = map ($ VGcPtr) (realVanillaRegs platform) ++
realFloatRegs platform ++
realDoubleRegs platform ++
realLongRegs platform
=====================================
compiler/GHC/CmmToLlvm/Regs.hs
=====================================
@@ -50,12 +50,12 @@ lmGlobalReg platform suf reg
VanillaReg 9 _ -> wordGlobal $ "R9" ++ suf
VanillaReg 10 _ -> wordGlobal $ "R10" ++ suf
SpLim -> wordGlobal $ "SpLim" ++ suf
- FloatReg 1 -> floatGlobal $"F1" ++ suf
- FloatReg 2 -> floatGlobal $"F2" ++ suf
- FloatReg 3 -> floatGlobal $"F3" ++ suf
- FloatReg 4 -> floatGlobal $"F4" ++ suf
- FloatReg 5 -> floatGlobal $"F5" ++ suf
- FloatReg 6 -> floatGlobal $"F6" ++ suf
+ FloatReg 1 -> floatGlobal $ "F1" ++ suf
+ FloatReg 2 -> floatGlobal $ "F2" ++ suf
+ FloatReg 3 -> floatGlobal $ "F3" ++ suf
+ FloatReg 4 -> floatGlobal $ "F4" ++ suf
+ FloatReg 5 -> floatGlobal $ "F5" ++ suf
+ FloatReg 6 -> floatGlobal $ "F6" ++ suf
DoubleReg 1 -> doubleGlobal $ "D1" ++ suf
DoubleReg 2 -> doubleGlobal $ "D2" ++ suf
DoubleReg 3 -> doubleGlobal $ "D3" ++ suf
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -499,6 +499,8 @@ data WarningFlag =
| Opt_WarnCompatUnqualifiedImports -- Since 8.10
| Opt_WarnDerivingDefaults
| Opt_WarnInvalidHaddock -- Since 8.12
+ | Opt_WarnOperatorWhitespaceExtConflict -- Since 9.2
+ | Opt_WarnOperatorWhitespace -- Since 9.2
deriving (Eq, Show, Enum)
-- | Used when outputting warnings: if a reason is given, it is
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3330,7 +3330,9 @@ wWarningFlagsDeps = [
Opt_WarnPrepositiveQualifiedModule,
flagSpec "unused-packages" Opt_WarnUnusedPackages,
flagSpec "compat-unqualified-imports" Opt_WarnCompatUnqualifiedImports,
- flagSpec "invalid-haddock" Opt_WarnInvalidHaddock
+ flagSpec "invalid-haddock" Opt_WarnInvalidHaddock,
+ flagSpec "operator-whitespace-ext-conflict" Opt_WarnOperatorWhitespaceExtConflict,
+ flagSpec "operator-whitespace" Opt_WarnOperatorWhitespace
]
-- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
@@ -4082,7 +4084,8 @@ standardWarnings -- see Note [Documenting warning flags]
Opt_WarnSimplifiableClassConstraints,
Opt_WarnStarBinder,
Opt_WarnInaccessibleCode,
- Opt_WarnSpaceAfterBang
+ Opt_WarnSpaceAfterBang,
+ Opt_WarnOperatorWhitespaceExtConflict
]
-- | Things you get with -W
=====================================
compiler/GHC/Parser/Errors.hs
=====================================
@@ -1,6 +1,8 @@
module GHC.Parser.Errors
( Warning(..)
, TransLayoutReason(..)
+ , OperatorWhitespaceSymbol(..)
+ , OperatorWhitespaceOccurrence(..)
, NumUnderscoreReason(..)
, Error(..)
, ErrorDesc(..)
@@ -57,6 +59,20 @@ data Warning
| WarnImportPreQualified !SrcSpan
-- ^ Pre qualified import with 'WarnPrepositiveQualifiedModule' enabled
+ | WarnOperatorWhitespaceExtConflict !SrcSpan !OperatorWhitespaceSymbol
+ | WarnOperatorWhitespace !SrcSpan !FastString !OperatorWhitespaceOccurrence
+
+-- | The operator symbol in the 'WarnOperatorWhitespaceExtConflict' warning.
+data OperatorWhitespaceSymbol
+ = OperatorWhitespaceSymbol_PrefixPercent
+ | OperatorWhitespaceSymbol_PrefixDollar
+ | OperatorWhitespaceSymbol_PrefixDollarDollar
+
+-- | The operator occurrence type in the 'WarnOperatorWhitespace' warning.
+data OperatorWhitespaceOccurrence
+ = OperatorWhitespaceOccurrence_Prefix
+ | OperatorWhitespaceOccurrence_Suffix
+ | OperatorWhitespaceOccurrence_TightInfix
data TransLayoutReason
= TransLayout_Where -- ^ "`where' clause at the same depth as implicit layout block"
=====================================
compiler/GHC/Parser/Errors/Ppr.hs
=====================================
@@ -102,6 +102,33 @@ pprWarning = \case
<+> text "after the module name instead."
$$ text "To allow this, enable language extension 'ImportQualifiedPost'"
+ WarnOperatorWhitespaceExtConflict loc sym
+ -> mkParserWarn Opt_WarnOperatorWhitespaceExtConflict loc $
+ let mk_prefix_msg operator_symbol extension_name syntax_meaning =
+ text "The prefix use of a" <+> quotes (text operator_symbol)
+ <+> text "would denote" <+> text syntax_meaning
+ $$ nest 2 (text "were the" <+> text extension_name <+> text "extension enabled.")
+ $$ text "Suggested fix: add whitespace after the"
+ <+> quotes (text operator_symbol) <> char '.'
+ in
+ case sym of
+ OperatorWhitespaceSymbol_PrefixPercent -> mk_prefix_msg "%" "LinearTypes" "a multiplicity annotation"
+ OperatorWhitespaceSymbol_PrefixDollar -> mk_prefix_msg "$" "TemplateHaskell" "an untyped splice"
+ OperatorWhitespaceSymbol_PrefixDollarDollar -> mk_prefix_msg "$$" "TemplateHaskell" "a typed splice"
+
+
+ WarnOperatorWhitespace loc sym occ_type
+ -> mkParserWarn Opt_WarnOperatorWhitespace loc $
+ let mk_msg occ_type_str =
+ text "The" <+> text occ_type_str <+> text "use of a" <+> quotes (ftext sym)
+ <+> text "might be repurposed as special syntax by a future language extension."
+ $$ text "Suggested fix: add whitespace around it."
+ in
+ case occ_type of
+ OperatorWhitespaceOccurrence_Prefix -> mk_msg "prefix"
+ OperatorWhitespaceOccurrence_Suffix -> mk_msg "suffix"
+ OperatorWhitespaceOccurrence_TightInfix -> mk_msg "tight infix"
+
pprError :: Error -> ErrMsg
pprError err = mkParserErr (errLoc err) $ vcat
(pp_err (errDesc err) : map pp_hint (errHints err))
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -1572,42 +1572,56 @@ qconsym buf len = ITqconsym $! splitQualName buf len False
-- See Note [Whitespace-sensitive operator parsing]
varsym_prefix :: Action
-varsym_prefix = sym $ \exts s ->
- if | s == fsLit "@" -- regardless of TypeApplications for better error messages
- -> return ITtypeApp
- | LinearTypesBit `xtest` exts, s == fsLit "%"
- -> return ITpercent
- | ThQuotesBit `xtest` exts, s == fsLit "$"
- -> return ITdollar
- | ThQuotesBit `xtest` exts, s == fsLit "$$"
- -> return ITdollardollar
- | s == fsLit "-" -- Only when LexicalNegation is on, otherwise we get ITminus and
- -- don't hit this code path. See Note [Minus tokens]
- -> return ITprefixminus
- | s == fsLit "!" -> return ITbang
- | s == fsLit "~" -> return ITtilde
- | otherwise -> return (ITvarsym s)
+varsym_prefix = sym $ \span exts s ->
+ let returnWhenExt tok ext errtok
+ | xtest ext exts = return tok
+ | otherwise = do
+ addWarning Opt_WarnOperatorWhitespaceExtConflict $
+ WarnOperatorWhitespaceExtConflict (mkSrcSpanPs span) errtok
+ return (ITvarsym s)
+ in
+ case unpackFS s of
+ "@" -> return ITtypeApp -- regardless of TypeApplications for better error messages
+ "%" -> returnWhenExt ITpercent LinearTypesBit OperatorWhitespaceSymbol_PrefixPercent
+ "$" -> returnWhenExt ITdollar ThQuotesBit OperatorWhitespaceSymbol_PrefixDollar
+ "$$" -> returnWhenExt ITdollardollar ThQuotesBit OperatorWhitespaceSymbol_PrefixDollarDollar
+ "-" -> return ITprefixminus -- Only when LexicalNegation is on, otherwise we get ITminus and
+ -- don't hit this code path. See Note [Minus tokens]
+ "!" -> return ITbang
+ "~" -> return ITtilde
+ _ -> do
+ addWarning Opt_WarnOperatorWhitespace $
+ WarnOperatorWhitespace (mkSrcSpanPs span) s OperatorWhitespaceOccurrence_Prefix
+ return (ITvarsym s)
-- See Note [Whitespace-sensitive operator parsing]
varsym_suffix :: Action
-varsym_suffix = sym $ \_ s ->
- if | s == fsLit "@" -> failMsgP (Error ErrSuffixAT [])
- | otherwise -> return (ITvarsym s)
+varsym_suffix = sym $ \span _ s ->
+ case unpackFS s of
+ "@" -> failMsgP (Error ErrSuffixAT [])
+ _ -> do
+ addWarning Opt_WarnOperatorWhitespace $
+ WarnOperatorWhitespace (mkSrcSpanPs span) s OperatorWhitespaceOccurrence_Suffix
+ return (ITvarsym s)
-- See Note [Whitespace-sensitive operator parsing]
varsym_tight_infix :: Action
-varsym_tight_infix = sym $ \_ s ->
- if | s == fsLit "@" -> return ITat
- | otherwise -> return (ITvarsym s)
+varsym_tight_infix = sym $ \span _ s ->
+ case unpackFS s of
+ "@" -> return ITat
+ _ -> do
+ addWarning Opt_WarnOperatorWhitespace $
+ WarnOperatorWhitespace (mkSrcSpanPs span) s OperatorWhitespaceOccurrence_TightInfix
+ return (ITvarsym s)
-- See Note [Whitespace-sensitive operator parsing]
varsym_loose_infix :: Action
-varsym_loose_infix = sym (\_ s -> return $ ITvarsym s)
+varsym_loose_infix = sym (\_ _ s -> return $ ITvarsym s)
consym :: Action
-consym = sym (\_exts s -> return $ ITconsym s)
+consym = sym (\_span _exts s -> return $ ITconsym s)
-sym :: (ExtsBitmap -> FastString -> P Token) -> Action
+sym :: (PsSpan -> ExtsBitmap -> FastString -> P Token) -> Action
sym con span buf len =
case lookupUFM reservedSymsFM fs of
Just (keyword, NormalSyntax, 0) ->
@@ -1616,20 +1630,20 @@ sym con span buf len =
exts <- getExts
if exts .&. i /= 0
then return $ L span keyword
- else L span <$!> con exts fs
+ else L span <$!> con span exts fs
Just (keyword, UnicodeSyntax, 0) -> do
exts <- getExts
if xtest UnicodeSyntaxBit exts
then return $ L span keyword
- else L span <$!> con exts fs
+ else L span <$!> con span exts fs
Just (keyword, UnicodeSyntax, i) -> do
exts <- getExts
if exts .&. i /= 0 && xtest UnicodeSyntaxBit exts
then return $ L span keyword
- else L span <$!> con exts fs
+ else L span <$!> con span exts fs
Nothing -> do
exts <- getExts
- L span <$!> con exts fs
+ L span <$!> con span exts fs
where
!fs = lexemeToFastString buf len
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -427,7 +427,7 @@ resumeExec canLogSpan step
hist' = case mb_brkpt of
Nothing -> prevHistoryLst
Just bi
- | not $canLogSpan span -> prevHistoryLst
+ | not $ canLogSpan span -> prevHistoryLst
| otherwise -> mkHistory hsc_env apStack bi `consBL`
fromListBL 50 hist
handleRunStatus step expr bindings final_ids status hist'
=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -51,6 +51,7 @@ To reverse ``-Werror``, which makes all warnings into errors, use ``-Wwarn``.
* :ghc-flag:`-Wunrecognised-warning-flags`
* :ghc-flag:`-Winaccessible-code`
* :ghc-flag:`-Wstar-binder`
+ * :ghc-flag:`-Woperator-whitespace-ext-conflict`
The following flags are simple ways to select standard "packages" of warnings:
@@ -1869,6 +1870,54 @@ of ``-W(no-)*``.
This warning informs you about discarded documentation comments.
It has no effect when :ghc-flag:`-haddock` is disabled.
+.. ghc-flag:: -Woperator-whitespace-ext-conflict
+ :shortdesc: warn on uses of infix operators that would be parsed differently
+ were a particular GHC extension enabled
+ :type: dynamic
+ :category:
+
+ :since: 9.2
+
+ When :extension:`TemplateHaskell` is enabled, ``f $x`` is parsed as ``f``
+ applied to an untyped splice. But when the extension is disabled, the
+ expression is parsed as a use of the ``$`` infix operator.
+
+ To make it easy to read ``f $x`` without checking the enabled extensions,
+ one could rewrite it as ``f $ x``, which is what this warning suggests.
+
+ Currently, it detects the following cases:
+
+ * ``$x`` could mean an untyped splice under :extension:`TemplateHaskell`
+ * ``$$x`` could mean a typed splice under :extension:`TemplateHaskell`
+ * ``%m`` could mean a multiplicity annotation under :extension:`LinearTypes`
+
+ It only covers extensions that currently exist. If you want to enforce a
+ stricter policy and always require whitespace around all infix operators,
+ use :ghc-flag:`-Woperator-whitespace`.
+
+.. ghc-flag:: -Woperator-whitespace
+ :shortdesc: warn on prefix, suffix, and tight infix uses of infix operators
+ :type: dynamic
+ :category:
+
+ :since: 9.2
+
+ There are four types of infix operator occurrences, as defined by
+ `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__::
+
+ a ! b -- a loose infix occurrence
+ a!b -- a tight infix occurrence
+ a !b -- a prefix occurrence
+ a! b -- a suffix occurrence
+
+ A loose infix occurrence of any operator is always parsed as an infix
+ operator, but other occurrence types may be assigned a special meaning.
+ For example, a prefix ``!`` denotes a bang pattern, and a prefix ``$``
+ denotes a :extension:`TemplateHaskell` splice.
+
+ This warning encourages the use of loose infix occurrences of all infix
+ operators, to prevent possible conflicts with future language extensions.
+
.. ghc-flag:: -Wauto-orphans
:shortdesc: *(deprecated)* Does nothing
:type: dynamic
=====================================
libraries/containers
=====================================
@@ -1 +1 @@
-Subproject commit 535384f5919eafb03856cf604b99cc94ce04e37a
+Subproject commit 5ae82d447dd5ac7ef3c41adb925db85f26c3a190
=====================================
testsuite/tests/parser/should_compile/T18834a.hs
=====================================
@@ -0,0 +1,8 @@
+module T18834a where
+
+(%) = ($)
+($$) = ($)
+
+x = even $0
+y = even $$0
+z = even %0
=====================================
testsuite/tests/parser/should_compile/T18834a.stderr
=====================================
@@ -0,0 +1,15 @@
+
+T18834a.hs:6:10: warning: [-Woperator-whitespace-ext-conflict (in -Wdefault)]
+ The prefix use of a ‘$’ would denote an untyped splice
+ were the TemplateHaskell extension enabled.
+ Suggested fix: add whitespace after the ‘$’.
+
+T18834a.hs:7:10: warning: [-Woperator-whitespace-ext-conflict (in -Wdefault)]
+ The prefix use of a ‘$$’ would denote a typed splice
+ were the TemplateHaskell extension enabled.
+ Suggested fix: add whitespace after the ‘$$’.
+
+T18834a.hs:8:10: warning: [-Woperator-whitespace-ext-conflict (in -Wdefault)]
+ The prefix use of a ‘%’ would denote a multiplicity annotation
+ were the LinearTypes extension enabled.
+ Suggested fix: add whitespace after the ‘%’.
=====================================
testsuite/tests/parser/should_compile/T18834b.hs
=====================================
@@ -0,0 +1,8 @@
+{-# OPTIONS -Woperator-whitespace #-}
+
+module T18834b where
+
+f a b = a+ b
+g a b = a +b
+h a b = a+b
+k a b = a + b -- this one is OK, no warning
=====================================
testsuite/tests/parser/should_compile/T18834b.stderr
=====================================
@@ -0,0 +1,12 @@
+
+T18834b.hs:5:10: warning: [-Woperator-whitespace]
+ The suffix use of a ‘+’ might be repurposed as special syntax by a future language extension.
+ Suggested fix: add whitespace around it.
+
+T18834b.hs:6:11: warning: [-Woperator-whitespace]
+ The prefix use of a ‘+’ might be repurposed as special syntax by a future language extension.
+ Suggested fix: add whitespace around it.
+
+T18834b.hs:7:10: warning: [-Woperator-whitespace]
+ The tight infix use of a ‘+’ might be repurposed as special syntax by a future language extension.
+ Suggested fix: add whitespace around it.
=====================================
testsuite/tests/parser/should_compile/all.T
=====================================
@@ -170,3 +170,5 @@ test('proposal-229f',
test('T15730a', normal, compile_and_run, [''])
test('T18130', normal, compile, [''])
+test('T18834a', normal, compile, [''])
+test('T18834b', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_compile/T16312.hs
=====================================
@@ -9,6 +9,6 @@ instance Functor g => Functor (Curried g h) where
fmap f (Curried g) = Curried (g . fmap (.f))
instance (Functor g, g ~ h) => Applicative (Curried g h) where
- pure a = Curried (fmap ($a))
+ pure a = Curried (fmap ($ a))
Curried mf <*> Curried ma = Curried (ma . mf . fmap (.))
{-# INLINE (<*>) #-}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce485f0650353944a3904a47e69695e3824ddfed
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce485f0650353944a3904a47e69695e3824ddfed
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/20201013/0ec00af9/attachment-0001.html>
More information about the ghc-commits
mailing list