[Git][ghc/ghc][wip/warn-operator-whitespace] Implement -Woperator-whitespace (#18834)
Vladislav Zavialov
gitlab at gitlab.haskell.org
Fri Oct 16 11:28:26 UTC 2020
Vladislav Zavialov pushed to branch wip/warn-operator-whitespace at Glasgow Haskell Compiler / GHC
Commits:
e91aec18 by Vladislav Zavialov at 2020-10-16T14:27:47+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 submodules: haddock, containers.
- - - - -
18 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
- ghc/GHCi/UI/Tags.hs
- 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
- utils/haddock
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
=====================================
@@ -501,6 +501,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\>@
@@ -4087,7 +4089,8 @@ standardWarnings -- see Note [Documenting warning flags]
Opt_WarnInaccessibleCode,
Opt_WarnSpaceAfterBang,
Opt_WarnNonCanonicalMonadInstances,
- Opt_WarnNonCanonicalMonoidInstances
+ Opt_WarnNonCanonicalMonoidInstances,
+ 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,34 @@ 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"
+ $$ nest 2 (text "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,65 @@ 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
+varsym_prefix = sym $ \span exts s ->
+ let warnExtConflict errtok =
+ do { addWarning Opt_WarnOperatorWhitespaceExtConflict $
+ WarnOperatorWhitespaceExtConflict (mkSrcSpanPs span) errtok
+ ; return (ITvarsym s) }
+ in
+ if | s == fsLit "@" ->
+ return ITtypeApp -- regardless of TypeApplications for better error messages
+ | s == fsLit "%" ->
+ if xtest LinearTypesBit exts
+ then return ITpercent
+ else warnExtConflict OperatorWhitespaceSymbol_PrefixPercent
+ | s == fsLit "$" ->
+ if xtest ThQuotesBit exts
+ then return ITdollar
+ else warnExtConflict OperatorWhitespaceSymbol_PrefixDollar
+ | s == fsLit "$$" ->
+ if xtest ThQuotesBit exts
+ then return ITdollardollar
+ else warnExtConflict OperatorWhitespaceSymbol_PrefixDollarDollar
+ | s == fsLit "-" ->
+ return ITprefixminus -- Only when LexicalNegation is on, otherwise we get ITminus
+ -- and don't hit this code path. See Note [Minus tokens]
| s == fsLit "!" -> return ITbang
| s == fsLit "~" -> return ITtilde
- | otherwise -> return (ITvarsym s)
+ | otherwise ->
+ 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 ->
+varsym_suffix = sym $ \span _ s ->
if | s == fsLit "@" -> failMsgP (Error ErrSuffixAT [])
- | otherwise -> return (ITvarsym s)
+ | otherwise ->
+ 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 ->
+varsym_tight_infix = sym $ \span _ s ->
if | s == fsLit "@" -> return ITat
- | otherwise -> return (ITvarsym s)
+ | otherwise ->
+ 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 +1639,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:
@@ -1853,6 +1854,7 @@ of ``-W(no-)*``.
.. ghc-flag:: -Winvalid-haddock
:shortdesc: warn when a Haddock comment occurs in an invalid position
:type: dynamic
+ :reverse: -Wno-invalid-haddock
:category:
:since: 9.0
@@ -1869,6 +1871,56 @@ 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
+ :reverse: -Wno-operator-whitespace-ext-conflict
+ :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
+ :reverse: -Wno-operator-whitespace
+ :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
=====================================
ghc/GHCi/UI/Tags.hs
=====================================
@@ -95,7 +95,7 @@ listModuleTags m = do
dflags <- getDynFlags
mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo
let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual
- let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo
+ let names = fromMaybe [] $ GHC.modInfoTopLevelScope mInfo
let localNames = filter ((m==) . nameModule) names
mbTyThings <- mapM GHC.lookupName localNames
return $! [ tagInfo dflags unqual exported kind name realLoc
@@ -153,11 +153,11 @@ collateAndWriteTags CTagsWithLineNumbers file tagInfos = do
-- ctags style with the Ex expression being a regex searching the line, Vim et al
collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al
tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos
- let tags = unlines $ sort $ map showCTag $concat tagInfoGroups
+ let tags = unlines $ sort $ map showCTag $ concat tagInfoGroups
tryIO (writeTagsSafely file tags)
collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
- tagInfoGroups <- makeTagGroupsWithSrcInfo $filter tagExported tagInfos
+ tagInfoGroups <- makeTagGroupsWithSrcInfo $ filter tagExported tagInfos
let tagGroups = map processGroup tagInfoGroups
tryIO (writeTagsSafely file $ concat tagGroups)
@@ -176,7 +176,7 @@ makeTagGroupsWithSrcInfo tagInfos = do
where
addTagSrcInfo [] = throwGhcException (CmdLineError "empty tag file group??")
addTagSrcInfo group@(tagInfo:_) = do
- file <- readFile $tagFile tagInfo
+ file <- readFile $ tagFile tagInfo
let sortedGroup = sortBy (comparing tagLine) group
return $ perFile sortedGroup 1 0 $ lines file
@@ -197,7 +197,7 @@ showCTag ti =
where
tagCmd =
case tagSrcInfo ti of
- Nothing -> show $tagLine ti
+ Nothing -> show $ tagLine ti
Just (srcLine,_) -> "/^"++ foldr escapeSlashes [] srcLine ++"$/"
where
=====================================
libraries/containers
=====================================
@@ -1 +1 @@
-Subproject commit 535384f5919eafb03856cf604b99cc94ce04e37a
+Subproject commit 648fdb95cb4cf406ed7364533de6314069e3ffa5
=====================================
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,15 @@
+
+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 (<*>) #-}
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit f7d9e0bb987ca31c3b15cbe63198dafbeee3a395
+Subproject commit 77261e89c31b41eb5d7f1d16bb1de5b14b4296f4
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e91aec18c2b658dd747fa61f5fd398f13a31e484
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e91aec18c2b658dd747fa61f5fd398f13a31e484
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/20201016/26d2b3fe/attachment-0001.html>
More information about the ghc-commits
mailing list