Commit b5b3e34e authored by Vladislav Zavialov's avatar Vladislav Zavialov Committed by Marge Bot

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.
parent d858a3ae
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -3328,7 +3328,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\>@
......@@ -4085,7 +4087,8 @@ standardWarnings -- see Note [Documenting warning flags]
Opt_WarnInaccessibleCode,
Opt_WarnSpaceAfterBang,
Opt_WarnNonCanonicalMonadInstances,
Opt_WarnNonCanonicalMonoidInstances
Opt_WarnNonCanonicalMonoidInstances,
Opt_WarnOperatorWhitespaceExtConflict
]
-- | Things you get with -W
......
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"
......
......@@ -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))
......
......@@ -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
......
......@@ -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'
......
......@@ -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
......
......@@ -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
......
Subproject commit 535384f5919eafb03856cf604b99cc94ce04e37a
Subproject commit 648fdb95cb4cf406ed7364533de6314069e3ffa5
module T18834a where
(%) = ($)
($$) = ($)
x = even $0
y = even $$0
z = even %0
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 ‘%’.
{-# 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
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.
......@@ -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, [''])
......@@ -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 (<*>) #-}
Subproject commit f7d9e0bb987ca31c3b15cbe63198dafbeee3a395
Subproject commit 77261e89c31b41eb5d7f1d16bb1de5b14b4296f4
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment