[Git][ghc/ghc][master] Namespacing for WARNING/DEPRECATED pragmas (#24396)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Feb 1 17:23:36 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
151dda4e by Andrei Borzenkov at 2024-02-01T12:22:43-05:00
Namespacing for WARNING/DEPRECATED pragmas (#24396)
New syntax for WARNING and DEPRECATED pragmas was added,
namely namespace specifierss:
namespace_spec ::= 'type' | 'data' | {- empty -}
warning ::= warning_category namespace_spec namelist strings
deprecation ::= namespace_spec namelist strings
A new data type was introduced to represent these namespace specifiers:
data NamespaceSpecifier =
NoSpecifier |
TypeNamespaceSpecifier (EpToken "type") |
DataNamespaceSpecifier (EpToken "data")
Extension field XWarning now contains this NamespaceSpecifier.
lookupBindGroupOcc function was changed: it now takes NamespaceSpecifier
and checks that the namespace of the found names matches the passed flag.
With this change {-# WARNING data D "..." #-} pragma will only affect value
namespace and {-# WARNING type D "..." #-} will only affect type
namespace. The same logic is applicable to DEPRECATED pragmas.
Finding duplicated warnings inside rnSrcWarnDecls now takes into
consideration NamespaceSpecifier flag to allow warnings with the
same names that refer to different namespaces.
- - - - -
13 changed files:
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Module.hs
- docs/users_guide/9.10.1-notes.rst
- docs/users_guide/exts/pragmas.rst
- libraries/ghc-prim/GHC/Tuple.hs
- + testsuite/tests/warnings/should_compile/T24396.stderr
- + testsuite/tests/warnings/should_compile/T24396a.hs
- + testsuite/tests/warnings/should_compile/T24396b.hs
- testsuite/tests/warnings/should_compile/all.T
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -81,8 +81,9 @@ module GHC.Hs.Decls (
-- ** Document comments
DocDecl(..), LDocDecl, docDeclDoc,
-- ** Deprecations
- WarnDecl(..), LWarnDecl,
+ WarnDecl(..), NamespaceSpecifier(..), LWarnDecl,
WarnDecls(..), LWarnDecls,
+ overlappingNamespaceSpecifiers, coveredByNamespaceSpecifier,
-- ** Annotations
AnnDecl(..), LAnnDecl,
AnnProvenance(..), annProvenanceName_maybe,
@@ -120,7 +121,7 @@ import GHC.Types.Name.Set
import GHC.Types.Fixity
-- others:
-import GHC.Utils.Misc (count)
+import GHC.Utils.Misc (count, (<||>))
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.SrcLoc
@@ -1280,9 +1281,30 @@ type instance XWarnings GhcTc = SourceText
type instance XXWarnDecls (GhcPass _) = DataConCantHappen
-type instance XWarning (GhcPass _) = EpAnn [AddEpAnn]
+type instance XWarning (GhcPass _) = (NamespaceSpecifier, EpAnn [AddEpAnn])
type instance XXWarnDecl (GhcPass _) = DataConCantHappen
+data NamespaceSpecifier
+ = NoNamespaceSpecifier
+ | TypeNamespaceSpecifier (EpToken "type")
+ | DataNamespaceSpecifier (EpToken "data")
+ deriving (Data)
+
+overlappingNamespaceSpecifiers :: NamespaceSpecifier -> NamespaceSpecifier -> Bool
+overlappingNamespaceSpecifiers NoNamespaceSpecifier _ = True
+overlappingNamespaceSpecifiers _ NoNamespaceSpecifier = True
+overlappingNamespaceSpecifiers TypeNamespaceSpecifier{} TypeNamespaceSpecifier{} = True
+overlappingNamespaceSpecifiers DataNamespaceSpecifier{} DataNamespaceSpecifier{} = True
+overlappingNamespaceSpecifiers _ _ = False
+
+coveredByNamespaceSpecifier :: NamespaceSpecifier -> NameSpace -> Bool
+coveredByNamespaceSpecifier NoNamespaceSpecifier = const True
+coveredByNamespaceSpecifier TypeNamespaceSpecifier{} = isTcClsNameSpace <||> isTvNameSpace
+coveredByNamespaceSpecifier DataNamespaceSpecifier{} = isValNameSpace
+instance Outputable NamespaceSpecifier where
+ ppr NoNamespaceSpecifier = empty
+ ppr TypeNamespaceSpecifier{} = text "type"
+ ppr DataNamespaceSpecifier{} = text "data"
instance OutputableBndrId p
=> Outputable (WarnDecls (GhcPass p)) where
@@ -1296,8 +1318,9 @@ instance OutputableBndrId p
instance OutputableBndrId p
=> Outputable (WarnDecl (GhcPass p)) where
- ppr (Warning _ thing txt)
+ ppr (Warning (ns_spec, _) thing txt)
= ppr_category
+ <+> ppr ns_spec
<+> hsep (punctuate comma (map ppr thing))
<+> ppr txt
where
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1985,10 +1985,15 @@ warnings :: { OrdList (LWarnDecl GhcPs) }
-- SUP: TEMPORARY HACK, not checking for `module Foo'
warning :: { OrdList (LWarnDecl GhcPs) }
- : warning_category namelist strings
- {% fmap unitOL $ acsA (\cs -> L (comb3 $1 $2 $3)
- (Warning (EpAnn (glMR $1 $2) (fst $ unLoc $3) cs) (unLoc $2)
- (WarningTxt $1 NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $3))) }
+ : warning_category namespace_spec namelist strings
+ {% fmap unitOL $ acsA (\cs -> L (comb4 $1 $2 $3 $4)
+ (Warning (unLoc $2, EpAnn (glMR $1 $3) (fst $ unLoc $4) cs) (unLoc $3)
+ (WarningTxt $1 NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $4))) }
+
+namespace_spec :: { Located NamespaceSpecifier }
+ : 'type' { sL1 $1 $ TypeNamespaceSpecifier (epTok $1) }
+ | 'data' { sL1 $1 $ DataNamespaceSpecifier (epTok $1) }
+ | {- empty -} { sL0 $ NoNamespaceSpecifier }
deprecations :: { OrdList (LWarnDecl GhcPs) }
: deprecations ';' deprecation
@@ -2009,9 +2014,9 @@ deprecations :: { OrdList (LWarnDecl GhcPs) }
-- SUP: TEMPORARY HACK, not checking for `module Foo'
deprecation :: { OrdList (LWarnDecl GhcPs) }
- : namelist strings
- {% fmap unitOL $ acsA (\cs -> sLL $1 $> $ (Warning (EpAnn (glEE $1 $>) (fst $ unLoc $2) cs) (unLoc $1)
- (DeprecatedTxt NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $2))) }
+ : namespace_spec namelist strings
+ {% fmap unitOL $ acsA (\cs -> sL (comb3 $1 $2 $>) $ (Warning (unLoc $1, EpAnn (glEE $2 $>) (fst $ unLoc $3) cs) (unLoc $2)
+ (DeprecatedTxt NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $3))) }
strings :: { Located ([AddEpAnn],[Located StringLiteral]) }
: STRING { sL1 $1 ([],[L (gl $1) (getStringLiteral $1)]) }
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -1388,7 +1388,7 @@ rnSrcFixityDecl sig_ctxt = rn_decl
= setSrcSpanA name_loc $
-- This lookup will fail if the name is not defined in the
-- same binding group as this fixity declaration.
- do names <- lookupLocalTcNames sig_ctxt what rdr_name
+ do names <- lookupLocalTcNames sig_ctxt what NoNamespaceSpecifier rdr_name
return [ L name_loc name | (_, name) <- names ]
what = text "fixity signature"
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -2068,7 +2068,7 @@ lookupSigCtxtOccRn :: HsSigCtxt
lookupSigCtxtOccRn ctxt what
= wrapLocMA $ \ rdr_name ->
do { let also_try_tycons = False
- ; mb_names <- lookupBindGroupOcc ctxt what rdr_name also_try_tycons
+ ; mb_names <- lookupBindGroupOcc ctxt what rdr_name also_try_tycons NoNamespaceSpecifier
; case mb_names of
Right name NE.:| rest ->
do { massertPpr (null rest) $
@@ -2085,12 +2085,13 @@ lookupBindGroupOcc :: HsSigCtxt
-> Bool -- ^ if the 'RdrName' we are looking up is in
-- a value 'NameSpace', should we also look up
-- in the type constructor 'NameSpace'?
+ -> NamespaceSpecifier
-> RnM (NE.NonEmpty (Either NotInScopeError Name))
-- ^ Looks up the 'RdrName', expecting it to resolve to one of the
-- bound names currently in scope. If not, return an appropriate error message.
--
-- See Note [Looking up signature names].
-lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns
+lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns ns_spec
| Just n <- isExact_maybe rdr_name
= do { mb_gre <- lookupExactOcc_either n
; return $ case mb_gre of
@@ -2105,24 +2106,27 @@ lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns
| otherwise
= case ctxt of
- HsBootCtxt ns -> lookup_top (`elemNameSet` ns)
- TopSigCtxt ns -> lookup_top (`elemNameSet` ns)
- RoleAnnotCtxt ns -> lookup_top (`elemNameSet` ns)
+ HsBootCtxt ns -> lookup_top (elem_name_set_with_namespace ns)
+ TopSigCtxt ns -> lookup_top (elem_name_set_with_namespace ns)
+ RoleAnnotCtxt ns -> lookup_top (elem_name_set_with_namespace ns)
LocalBindCtxt ns -> lookup_group ns
ClsDeclCtxt cls -> lookup_cls_op cls
InstDeclCtxt ns -> if uniqSetAny isUnboundName ns -- #16610
then return $ NE.singleton $ Right $ mkUnboundNameRdr rdr_name
- else lookup_top (`elemNameSet` ns)
+ else lookup_top (elem_name_set_with_namespace ns)
where
+ elem_name_set_with_namespace ns n = check_namespace n && (n `elemNameSet` ns)
- ns = occNameSpace occ
+ check_namespace = coveredByNamespaceSpecifier ns_spec . nameNameSpace
+
+ namespace = occNameSpace occ
occ = rdrNameOcc rdr_name
relevant_gres =
RelevantGREs
{ includeFieldSelectors = WantBoth
, lookupVariablesForFields = True
, lookupTyConsAsWell = also_try_tycon_ns }
- ok_gre = greIsRelevant relevant_gres ns
+ ok_gre = greIsRelevant relevant_gres namespace
finish err gre
| ok_gre gre
@@ -2180,16 +2184,16 @@ lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns
---------------
-lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
+lookupLocalTcNames :: HsSigCtxt -> SDoc -> NamespaceSpecifier -> RdrName -> RnM [(RdrName, Name)]
-- GHC extension: look up both the tycon and data con or variable.
-- Used for top-level fixity signatures and deprecations.
-- Complain if neither is in scope.
-- See Note [Fixity signature lookup]
-lookupLocalTcNames ctxt what rdr
+lookupLocalTcNames ctxt what ns_spec rdr
= do { this_mod <- getModule
; let also_try_tycon_ns = True
; nms_eithers <- fmap (guard_builtin_syntax this_mod rdr) <$>
- lookupBindGroupOcc ctxt what rdr also_try_tycon_ns
+ lookupBindGroupOcc ctxt what rdr also_try_tycon_ns ns_spec
; let (errs, names) = partitionEithers (NE.toList nms_eithers)
; when (null names) $
addErr (head errs) -- Bleat about one only
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -273,7 +273,7 @@ rnSrcWarnDecls _ []
rnSrcWarnDecls bndr_set decls'
= do { -- check for duplicates
- ; mapM_ (\ dups -> let ((L loc rdr) :| (lrdr':_)) = dups
+ ; mapM_ (\ dups -> let ((L loc rdr) :| (lrdr':_)) = fmap snd dups
in addErrAt (locA loc) (TcRnDuplicateWarningDecls lrdr' rdr))
warn_rdr_dups
; pairs_s <- mapM (addLocM rn_deprec) decls
@@ -283,9 +283,9 @@ rnSrcWarnDecls bndr_set decls'
sig_ctxt = TopSigCtxt bndr_set
- rn_deprec (Warning _ rdr_names txt)
+ rn_deprec (Warning (ns_spec, _) rdr_names txt)
-- ensures that the names are defined locally
- = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc)
+ = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what ns_spec . unLoc)
rdr_names
; txt' <- rnWarningTxt txt
; return [(nameOccName nm, txt') | (_, nm) <- names] }
@@ -295,8 +295,13 @@ rnSrcWarnDecls bndr_set decls'
what = text "deprecation"
- warn_rdr_dups = findDupRdrNames
- $ concatMap (\(L _ (Warning _ ns _)) -> ns) decls
+ warn_rdr_dups = find_dup_warning_names
+ $ concatMap (\(L _ (Warning (ns_spec, _) ns _)) -> (ns_spec,) <$> ns) decls
+
+ find_dup_warning_names :: [(NamespaceSpecifier, LocatedN RdrName)] -> [NonEmpty (NamespaceSpecifier, LocatedN RdrName)]
+ find_dup_warning_names = findDupsEq (\ (spec1, x) -> \ (spec2, y) ->
+ overlappingNamespaceSpecifiers spec1 spec2 &&
+ rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
rnWarningTxt :: WarningTxt GhcPs -> RnM (WarningTxt GhcRn)
rnWarningTxt (WarningTxt mb_cat st wst) = do
@@ -312,9 +317,6 @@ rnWarningTxt (DeprecatedTxt st wst) = do
rnLWarningTxt :: LWarningTxt GhcPs -> RnM (LWarningTxt GhcRn)
rnLWarningTxt (L loc warn) = L loc <$> rnWarningTxt warn
-findDupRdrNames :: [LocatedN RdrName] -> [NonEmpty (LocatedN RdrName)]
-findDupRdrNames = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
-
-- look for duplicates among the OccNames;
-- we check that the names are defined above
-- invt: the lists returned by findDupsEq always have at least two elements
=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -73,6 +73,18 @@ Language
Library authors are advised to use a different name for their functions,
such as ``forAll``, ``for_all``, or ``forall_``.
+- GHC Proposal `#65 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0065-type-infix.rst>`_
+ "Require namespacing fixity declarations for type names and WARNING/DEPRECATED pragmas" has been partially implemented.
+ Now you can specify namespace of a name that you want to warn about or deprecate: ::
+
+ {-# DEPRACATED type D "Use `()` instead" #-} -- this will deprecate type D, but will not touch pattern synonym
+ data D = MkD
+
+ {-# DEPRECATED data D "Use `MkD` instead" #-} -- this will deprecate pattern synonym only
+ pattern D = MkD
+
+ Ditto for ``{-# WARNING ... #-}`` pragmas.
+
Compiler
~~~~~~~~
=====================================
docs/users_guide/exts/pragmas.rst
=====================================
@@ -241,6 +241,24 @@ Alternatively, warnings from all ``WARNING`` and ``DEPRECATED`` pragmas
regardless of category can be suppressed with
:ghc-flag:`-Wno-extended-warnings <-Wextended-warnings>`.
+When a deprecated name appears in both value and type namespaces (i.e. punning occurs)
+``WARNING`` and ``DEPRECATED`` pragmas will affect both: ::
+
+ {-# LANGUAGE PatternSynonyms #-}
+
+ data D = MkD
+ pattern D = MkD
+ {-# DEPRECATED D "This will deprecate both the type D and the pattern synonym D" #-}
+
+It is possible to specify the namespace of the name to be warned about
+or deprecated using ``type`` and ``data`` specifiers: ::
+
+ {-# LANGUAGE PatternSynonyms #-}
+
+ data D = MkD
+ pattern D = MkD
+ {-# DEPRECATED data D "This will deprecate only the pattern synonym D" #-}
+ {-# DEPRECATED type D "This will deprecate only the type D" #-}
.. _minimal-pragma:
@@ -1119,5 +1137,3 @@ are written immediately after the ``instance`` keyword, like this:
::
instance {-# OVERLAPPING #-} C t where ...
-
-
=====================================
libraries/ghc-prim/GHC/Tuple.hs
=====================================
@@ -28,7 +28,7 @@ import GHC.Tuple.Prim
default () -- Double and Integer aren't available yet
-{-# DEPRECATED Solo "The Solo constructor has been renamed to MkSolo to avoid punning." #-}
+{-# DEPRECATED data Solo "The Solo constructor has been renamed to MkSolo to avoid punning." #-}
pattern Solo :: a -> Solo a
pattern Solo x = MkSolo x
{-# COMPLETE Solo #-}
=====================================
testsuite/tests/warnings/should_compile/T24396.stderr
=====================================
@@ -0,0 +1,68 @@
+[1 of 2] Compiling T24396a ( T24396a.hs, T24396a.o )
+[2 of 2] Compiling T24396b ( T24396b.hs, T24396b.o )
+
+T24396b.hs:8:7: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of type constructor or class ‘C1’
+ (imported from T24396a):
+ Deprecated: "Type deprecation"
+
+T24396b.hs:9:6: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of data constructor ‘C1’ (imported from T24396a):
+ Deprecated: "Data deprecation"
+
+T24396b.hs:11:7: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of type constructor or class ‘D2’
+ (imported from T24396a):
+ Deprecated: "Type deprecation"
+
+T24396b.hs:12:6: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of data constructor ‘D2’ (imported from T24396a):
+ Deprecated: "Data deprecation"
+
+T24396b.hs:14:7: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of type constructor or class ‘D3’
+ (imported from T24396a):
+ Deprecated: "Both namespace deprecation"
+
+T24396b.hs:15:6: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of data constructor ‘D3’ (imported from T24396a):
+ Deprecated: "Both namespace deprecation"
+
+T24396b.hs:17:7: warning: [GHC-63394] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of type constructor or class ‘C2’
+ (imported from T24396a):
+ "Type warning"
+
+T24396b.hs:18:6: warning: [GHC-63394] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of data constructor ‘C2’ (imported from T24396a):
+ "Data warning"
+
+T24396b.hs:20:7: warning: [GHC-63394] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of type constructor or class ‘D5’
+ (imported from T24396a):
+ "Type warning"
+
+T24396b.hs:21:6: warning: [GHC-63394] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of data constructor ‘D5’ (imported from T24396a):
+ "Data warning"
+
+T24396b.hs:23:7: warning: [GHC-63394] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of type constructor or class ‘D6’
+ (imported from T24396a):
+ "Both namespace warning"
+
+T24396b.hs:24:6: warning: [GHC-63394] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of data constructor ‘D6’ (imported from T24396a):
+ "Both namespace warning"
+
+T24396b.hs:26:14: warning: [GHC-63394] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of type constructor or class ‘$’
+ (imported from T24396a):
+ "Type operator warning"
+
+T24396b.hs:27:8: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of data constructor ‘Solo’ (imported from GHC.Tuple):
+ Deprecated: "The Solo constructor has been renamed to MkSolo to avoid punning."
+
+T24396b.hs:27:13: warning: [GHC-63394] [-Wdeprecations (in -Wextended-warnings)]
+ In the use of ‘$’ (imported from T24396a): "Value operator warning"
=====================================
testsuite/tests/warnings/should_compile/T24396a.hs
=====================================
@@ -0,0 +1,31 @@
+module T24396a where
+
+class C1
+data D1 = C1
+
+data D2 = D2
+
+{-# DEPRECATED data C1, D2 "Data deprecation" #-}
+{-# DEPRECATED type C1, D2 "Type deprecation" #-}
+
+data D3 = D3
+{-# DEPRECATED D3 "Both namespace deprecation" #-}
+
+class C2
+data D4 = C2
+
+data D5 = D5
+
+{-# WARNING data C2, D5 "Data warning" #-}
+{-# WARNING type C2, D5 "Type warning" #-}
+
+data D6 = D6
+{-# WARNING D6 "Both namespace warning" #-}
+
+($) :: (a -> b) -> a -> b
+f $ x = f x
+
+type f $ x = f x
+
+{-# WARNING data ($) "Value operator warning" #-}
+{-# WARNING type ($) "Type operator warning" #-}
=====================================
testsuite/tests/warnings/should_compile/T24396b.hs
=====================================
@@ -0,0 +1,27 @@
+module T24396b where
+
+import GHC.Tuple
+import Prelude hiding (($))
+
+import T24396a
+
+d1 :: C1 => D1
+d1 = C1
+
+d2 :: D2
+d2 = D2
+
+d3 :: D3
+d3 = D3
+
+d4 :: C2 => D4
+d4 = C2
+
+d5 :: D5
+d5 = D5
+
+d6 :: D6
+d6 = D6
+
+solo :: Solo $ ()
+solo = Solo $ ()
=====================================
testsuite/tests/warnings/should_compile/all.T
=====================================
@@ -69,3 +69,4 @@ test('T22826', normal, compile, [''])
test('T23573', [extra_files(["T23573.hs", "T23573A.hs", "T23573B.hs"])], multimod_compile, ['T23573', '-v0'])
test('T23465', normal, compile, ['-ddump-parsed'])
test('WarnNoncanonical', normal, compile, [''])
+test('T24396', [extra_files(["T24396a.hs", "T24396b.hs"])], multimod_compile, ['T24396b', ''])
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -1964,23 +1964,35 @@ instance ExactPrint (WarnDecls GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (WarnDecl GhcPs) where
- getAnnotationEntry (Warning an _ _) = fromAnn an
- setAnnotationAnchor (Warning an a b) anc ts cs = Warning (setAnchorEpa an anc ts cs) a b
+ getAnnotationEntry (Warning (_, an) _ _) = fromAnn an
+ setAnnotationAnchor (Warning (ns_spec, an) a b) anc ts cs
+ = Warning (ns_spec, setAnchorEpa an anc ts cs) a b
- exact (Warning an lns (WarningTxt mb_cat src ls )) = do
+ exact (Warning (ns_spec, an) lns (WarningTxt mb_cat src ls )) = do
mb_cat' <- markAnnotated mb_cat
+ ns_spec' <- exactNsSpec ns_spec
lns' <- markAnnotated lns
an0 <- markEpAnnL an lidl AnnOpenS -- "["
ls' <- markAnnotated ls
an1 <- markEpAnnL an0 lidl AnnCloseS -- "]"
- return (Warning an1 lns' (WarningTxt mb_cat' src ls'))
+ return (Warning (ns_spec', an1) lns' (WarningTxt mb_cat' src ls'))
- exact (Warning an lns (DeprecatedTxt src ls)) = do
+ exact (Warning (ns_spec, an) lns (DeprecatedTxt src ls)) = do
+ ns_spec' <- exactNsSpec ns_spec
lns' <- markAnnotated lns
an0 <- markEpAnnL an lidl AnnOpenS -- "["
ls' <- markAnnotated ls
an1 <- markEpAnnL an0 lidl AnnCloseS -- "]"
- return (Warning an1 lns' (DeprecatedTxt src ls'))
+ return (Warning (ns_spec', an1) lns' (DeprecatedTxt src ls'))
+
+exactNsSpec :: (Monad m, Monoid w) => NamespaceSpecifier -> EP w m NamespaceSpecifier
+exactNsSpec NoNamespaceSpecifier = pure NoNamespaceSpecifier
+exactNsSpec (TypeNamespaceSpecifier type_) = do
+ type_' <- markEpToken type_
+ pure (TypeNamespaceSpecifier type_')
+exactNsSpec (DataNamespaceSpecifier data_) = do
+ data_' <- markEpToken data_
+ pure (DataNamespaceSpecifier data_')
-- ---------------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/151dda4efcbfafd58c8d44e9f991ec241a49d515
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/151dda4efcbfafd58c8d44e9f991ec241a49d515
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/20240201/30abe571/attachment-0001.html>
More information about the ghc-commits
mailing list