[Git][ghc/ghc][wip/sand-witch/infix-type-data] Namespace specifiers for fixity signatures
Andrei Borzenkov (@sand-witch)
gitlab at gitlab.haskell.org
Fri Feb 2 12:52:29 UTC 2024
Andrei Borzenkov pushed to branch wip/sand-witch/infix-type-data at Glasgow Haskell Compiler / GHC
Commits:
51485248 by Andrei Borzenkov at 2024-02-02T16:52:01+04:00
Namespace specifiers for fixity signatures
Updates haddock submodule.
- - - - -
15 changed files:
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/ThToHs.hs
- libraries/ghci/GHCi/TH/Binary.hs
- libraries/template-haskell/Language/Haskell/TH.hs
- libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
- libraries/template-haskell/Language/Haskell/TH/Ppr.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/th/T11345.hs
- utils/haddock
Changes:
=====================================
compiler/GHC/Builtin/Names/TH.hs
=====================================
@@ -80,7 +80,7 @@ templateHaskellNames = [
defaultSigDName, defaultDName,
dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName,
dataInstDName, newtypeInstDName, tySynInstDName,
- infixLDName, infixRDName, infixNDName,
+ infixLWithSpecDName, infixRWithSpecDName, infixNWithSpecDName,
roleAnnotDName, patSynDName, patSynSigDName,
implicitParamBindDName,
-- Cxt
@@ -141,6 +141,9 @@ templateHaskellNames = [
-- Overlap
overlappableDataConName, overlappingDataConName, overlapsDataConName,
incoherentDataConName,
+ -- NamespaceSpecifier
+ noNamespaceSpecifierDataConName, typeNamespaceSpecifierDataConName,
+ dataNamespaceSpecifierDataConName,
-- DerivStrategy
stockStrategyName, anyclassStrategyName,
newtypeStrategyName, viaStrategyName,
@@ -378,9 +381,9 @@ funDName, valDName, dataDName, newtypeDName, typeDataDName, tySynDName, classDNa
pragAnnDName, pragSCCFunDName, pragSCCFunNamedDName,
standaloneDerivWithStrategyDName, defaultSigDName, defaultDName,
dataInstDName, newtypeInstDName, tySynInstDName, dataFamilyDName,
- openTypeFamilyDName, closedTypeFamilyDName, infixLDName, infixRDName,
- infixNDName, roleAnnotDName, patSynDName, patSynSigDName,
- pragCompleteDName, implicitParamBindDName, pragOpaqueDName :: Name
+ openTypeFamilyDName, closedTypeFamilyDName, infixLWithSpecDName,
+ infixRWithSpecDName, infixNWithSpecDName, roleAnnotDName, patSynDName,
+ patSynSigDName, pragCompleteDName, implicitParamBindDName, pragOpaqueDName :: Name
funDName = libFun (fsLit "funD") funDIdKey
valDName = libFun (fsLit "valD") valDIdKey
dataDName = libFun (fsLit "dataD") dataDIdKey
@@ -411,9 +414,9 @@ tySynInstDName = libFun (fsLit "tySynInstD")
openTypeFamilyDName = libFun (fsLit "openTypeFamilyD") openTypeFamilyDIdKey
closedTypeFamilyDName = libFun (fsLit "closedTypeFamilyD") closedTypeFamilyDIdKey
dataFamilyDName = libFun (fsLit "dataFamilyD") dataFamilyDIdKey
-infixLDName = libFun (fsLit "infixLD") infixLDIdKey
-infixRDName = libFun (fsLit "infixRD") infixRDIdKey
-infixNDName = libFun (fsLit "infixND") infixNDIdKey
+infixLWithSpecDName = libFun (fsLit "infixLWithSpecD") infixLWithSpecDIdKey
+infixRWithSpecDName = libFun (fsLit "infixRWithSpecD") infixRWithSpecDIdKey
+infixNWithSpecDName = libFun (fsLit "infixNWithSpecD") infixNWithSpecDIdKey
roleAnnotDName = libFun (fsLit "roleAnnotD") roleAnnotDIdKey
patSynDName = libFun (fsLit "patSynD") patSynDIdKey
patSynSigDName = libFun (fsLit "patSynSigD") patSynSigDIdKey
@@ -655,6 +658,17 @@ overlappingDataConName = thCon (fsLit "Overlapping") overlappingDataConKey
overlapsDataConName = thCon (fsLit "Overlaps") overlapsDataConKey
incoherentDataConName = thCon (fsLit "Incoherent") incoherentDataConKey
+-- data NamespaceSpecifier = ...
+noNamespaceSpecifierDataConName,
+ typeNamespaceSpecifierDataConName,
+ dataNamespaceSpecifierDataConName :: Name
+noNamespaceSpecifierDataConName =
+ thCon (fsLit "NoNamespaceSpecifier") noNamespaceSpecifierDataConKey
+typeNamespaceSpecifierDataConName =
+ thCon (fsLit "TypeNamespaceSpecifier") typeNamespaceSpecifierDataConKey
+dataNamespaceSpecifierDataConName =
+ thCon (fsLit "DataNamespaceSpecifier") dataNamespaceSpecifierDataConKey
+
{- *********************************************************************
* *
Class keys
@@ -762,6 +776,13 @@ overlappingDataConKey = mkPreludeDataConUnique 210
overlapsDataConKey = mkPreludeDataConUnique 211
incoherentDataConKey = mkPreludeDataConUnique 212
+-- | data NamespaceSpecifier = ...
+noNamespaceSpecifierDataConKey,
+ typeNamespaceSpecifierDataConKey,
+ dataNamespaceSpecifierDataConKey :: Unique
+noNamespaceSpecifierDataConKey = mkPreludeDataConUnique 213
+typeNamespaceSpecifierDataConKey = mkPreludeDataConUnique 214
+dataNamespaceSpecifierDataConKey = mkPreludeDataConUnique 215
{- *********************************************************************
* *
Id keys
@@ -923,10 +944,10 @@ funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey,
pragRuleDIdKey, pragAnnDIdKey, defaultSigDIdKey, dataFamilyDIdKey,
openTypeFamilyDIdKey, closedTypeFamilyDIdKey, dataInstDIdKey,
newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivWithStrategyDIdKey,
- infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey, patSynDIdKey,
- patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey,
- kiSigDIdKey, defaultDIdKey, pragOpaqueDIdKey, typeDataDIdKey,
- pragSCCFunDKey, pragSCCFunNamedDKey :: Unique
+ infixLWithSpecDIdKey, infixRWithSpecDIdKey, infixNWithSpecDIdKey,
+ roleAnnotDIdKey, patSynDIdKey, patSynSigDIdKey, pragCompleteDIdKey,
+ implicitParamBindDIdKey, kiSigDIdKey, defaultDIdKey, pragOpaqueDIdKey,
+ typeDataDIdKey, pragSCCFunDKey, pragSCCFunNamedDKey :: Unique
funDIdKey = mkPreludeMiscIdUnique 320
valDIdKey = mkPreludeMiscIdUnique 321
dataDIdKey = mkPreludeMiscIdUnique 322
@@ -949,9 +970,9 @@ dataInstDIdKey = mkPreludeMiscIdUnique 338
newtypeInstDIdKey = mkPreludeMiscIdUnique 339
tySynInstDIdKey = mkPreludeMiscIdUnique 340
closedTypeFamilyDIdKey = mkPreludeMiscIdUnique 341
-infixLDIdKey = mkPreludeMiscIdUnique 342
-infixRDIdKey = mkPreludeMiscIdUnique 343
-infixNDIdKey = mkPreludeMiscIdUnique 344
+infixLWithSpecDIdKey = mkPreludeMiscIdUnique 342
+infixRWithSpecDIdKey = mkPreludeMiscIdUnique 343
+infixNWithSpecDIdKey = mkPreludeMiscIdUnique 344
roleAnnotDIdKey = mkPreludeMiscIdUnique 345
standaloneDerivWithStrategyDIdKey = mkPreludeMiscIdUnique 346
defaultSigDIdKey = mkPreludeMiscIdUnique 347
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -54,6 +54,7 @@ import GHC.Types.Name
import GHC.Utils.Outputable
import GHC.Utils.Panic
+import GHC.Utils.Misc ((<||>))
import Data.Function
import Data.List (sortBy)
@@ -719,9 +720,31 @@ type instance XXSig GhcPs = DataConCantHappen
type instance XXSig GhcRn = IdSig
type instance XXSig GhcTc = IdSig
-type instance XFixitySig (GhcPass p) = NoExtField
+type instance XFixitySig (GhcPass p) = NamespaceSpecifier
type instance XXFixitySig (GhcPass p) = 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"
+
-- | A type signature in generated code, notably the code
-- generated for record selectors. We simply record the desired Id
-- itself, replete with its name, type and IdDetails. Otherwise it's
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -81,9 +81,8 @@ module GHC.Hs.Decls (
-- ** Document comments
DocDecl(..), LDocDecl, docDeclDoc,
-- ** Deprecations
- WarnDecl(..), NamespaceSpecifier(..), LWarnDecl,
+ WarnDecl(..), LWarnDecl,
WarnDecls(..), LWarnDecls,
- overlappingNamespaceSpecifiers, coveredByNamespaceSpecifier,
-- ** Annotations
AnnDecl(..), LAnnDecl,
AnnProvenance(..), annProvenanceName_maybe,
@@ -121,7 +120,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
@@ -1284,28 +1283,6 @@ type instance XXWarnDecls (GhcPass _) = DataConCantHappen
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
ppr (Warnings ext decls)
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -781,15 +781,16 @@ repLFixD :: LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
repLFixD (L loc fix_sig) = rep_fix_d (locA loc) fix_sig
rep_fix_d :: SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
-rep_fix_d loc (FixitySig _ names (Fixity _ prec dir))
+rep_fix_d loc (FixitySig ns_spec names (Fixity _ prec dir))
= do { MkC prec' <- coreIntLit prec
; let rep_fn = case dir of
- InfixL -> infixLDName
- InfixR -> infixRDName
- InfixN -> infixNDName
+ InfixL -> infixLWithSpecDName
+ InfixR -> infixRWithSpecDName
+ InfixN -> infixNWithSpecDName
; let do_one name
= do { MkC name' <- lookupLOcc name
- ; dec <- rep2 rep_fn [prec', name']
+ ; MkC ns_spec' <- repNamespaceSpecifier ns_spec
+ ; dec <- rep2 rep_fn [prec', ns_spec', name']
; return (loc,dec) }
; mapM do_one names }
@@ -2657,6 +2658,12 @@ repOverlap mb =
just = coreJust overlapTyConName
+repNamespaceSpecifier :: NamespaceSpecifier -> MetaM (Core (TH.NamespaceSpecifier))
+repNamespaceSpecifier ns_spec = case ns_spec of
+ NoNamespaceSpecifier{} -> dataCon noNamespaceSpecifierDataConName
+ TypeNamespaceSpecifier{} -> dataCon typeNamespaceSpecifierDataConName
+ DataNamespaceSpecifier{} -> dataCon dataNamespaceSpecifierDataConName
+
repClass :: Core (M TH.Cxt) -> Core TH.Name -> Core [(M (TH.TyVarBndr TH.BndrVis))]
-> Core [TH.FunDep] -> Core [(M TH.Dec)]
-> MetaM (Core (M TH.Dec))
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2620,8 +2620,8 @@ sigdecl :: { LHsDecl GhcPs }
(mkHsWildCardBndrs $5)
; acsA (\cs -> sLL $1 $> $ SigD noExtField (sig cs) ) }}
- | infix prec ops
- {% do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 $3
+ | infix prec namespace_spec ops
+ {% do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 $4
; pure (mj AnnVal l2) })
$2
; let (fixText, fixPrec) = case $2 of
@@ -2630,7 +2630,7 @@ sigdecl :: { LHsDecl GhcPs }
Nothing -> (NoSourceText, maxPrecedence)
Just l2 -> (fst $ unLoc l2, snd $ unLoc l2)
; acsA (\cs -> sLL $1 $> $ SigD noExtField
- (FixSig (EpAnn (glEE $1 $>) (mj AnnInfix $1 : maybeToList mbPrecAnn) cs) (FixitySig noExtField (fromOL $ unLoc $3)
+ (FixSig (EpAnn (glEE $1 $>) (mj AnnInfix $1 : maybeToList mbPrecAnn) cs) (FixitySig (unLoc $3) (fromOL $ unLoc $4)
(Fixity fixText fixPrec (unLoc $1)))))
}}
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -1379,16 +1379,16 @@ rnSrcFixityDecl sig_ctxt = rn_decl
-- for con-like things; hence returning a list
-- If neither are in scope, report an error; otherwise
-- return a fixity sig for each (slightly odd)
- rn_decl (FixitySig _ fnames fixity)
- = do names <- concatMapM lookup_one fnames
- return (FixitySig noExtField names fixity)
+ rn_decl (FixitySig ns_spec fnames fixity)
+ = do names <- concatMapM (lookup_one ns_spec) fnames
+ return (FixitySig ns_spec names fixity)
- lookup_one :: LocatedN RdrName -> RnM [LocatedN Name]
- lookup_one (L name_loc rdr_name)
+ lookup_one :: NamespaceSpecifier -> LocatedN RdrName -> RnM [LocatedN Name]
+ lookup_one ns_spec (L name_loc rdr_name)
= 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 NoNamespaceSpecifier rdr_name
+ do names <- lookupLocalTcNames sig_ctxt what ns_spec rdr_name
return [ L name_loc name | (_, name) <- names ]
what = text "fixity signature"
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -243,14 +243,19 @@ cvtDec (TH.KiSigD nm ki)
; let sig' = StandaloneKindSig noAnn nm' ki'
; returnJustLA $ Hs.KindSigD noExtField sig' }
-cvtDec (TH.InfixD fx nm)
+cvtDec (TH.InfixD fx th_ns_spec nm)
-- Fixity signatures are allowed for variables, constructors, and types
-- the renamer automatically looks for types during renaming, even when
-- the RdrName says it's a variable or a constructor. So, just assume
-- it's a variable or constructor and proceed.
= do { nm' <- vcNameN nm
; returnJustLA (Hs.SigD noExtField (FixSig noAnn
- (FixitySig noExtField [nm'] (cvtFixity fx)))) }
+ (FixitySig ns_spec [nm'] (cvtFixity fx)))) }
+ where
+ ns_spec = case th_ns_spec of
+ TH.NoNamespaceSpecifier -> Hs.NoNamespaceSpecifier
+ TH.TypeNamespaceSpecifier -> Hs.TypeNamespaceSpecifier noAnn
+ TH.DataNamespaceSpecifier -> Hs.DataNamespaceSpecifier noAnn
cvtDec (TH.DefaultD tys)
= do { tys' <- traverse cvtType tys
=====================================
libraries/ghci/GHCi/TH/Binary.hs
=====================================
@@ -36,6 +36,7 @@ instance Binary TH.Stmt
instance Binary TH.Pat
instance Binary TH.Exp
instance Binary TH.Dec
+instance Binary TH.NamespaceSpecifier
instance Binary TH.Overlap
instance Binary TH.DerivClause
instance Binary TH.DerivStrategy
=====================================
libraries/template-haskell/Language/Haskell/TH.hs
=====================================
@@ -80,7 +80,8 @@ module Language.Haskell.TH(
Bang(..), Strict, Foreign(..), Callconv(..), Safety(..), Pragma(..),
Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..),
FunDep(..), TySynEqn(..), TypeFamilyHead(..),
- Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
+ Fixity(..), FixityDirection(..), NamespaceSpecifier(..), defaultFixity,
+ maxPrecedence,
PatSynDir(..), PatSynArgs(..),
-- ** Expressions
Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..),
=====================================
libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
=====================================
@@ -495,13 +495,22 @@ forImpD cc s str n ty
pure $ ForeignD (ImportF cc s str n ty')
infixLD :: Quote m => Int -> Name -> m Dec
-infixLD prec nm = pure (InfixD (Fixity prec InfixL) nm)
+infixLD prec = infixLWithSpecD prec NoNamespaceSpecifier
infixRD :: Quote m => Int -> Name -> m Dec
-infixRD prec nm = pure (InfixD (Fixity prec InfixR) nm)
+infixRD prec = infixRWithSpecD prec NoNamespaceSpecifier
infixND :: Quote m => Int -> Name -> m Dec
-infixND prec nm = pure (InfixD (Fixity prec InfixN) nm)
+infixND prec = infixNWithSpecD prec NoNamespaceSpecifier
+
+infixLWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
+infixLWithSpecD prec ns_spec nm = pure (InfixD (Fixity prec InfixL) ns_spec nm)
+
+infixRWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
+infixRWithSpecD prec ns_spec nm = pure (InfixD (Fixity prec InfixR) ns_spec nm)
+
+infixNWithSpecD :: Quote m => Int -> NamespaceSpecifier -> Name -> m Dec
+infixNWithSpecD prec ns_spec nm = pure (InfixD (Fixity prec InfixN) ns_spec nm)
defaultD :: Quote m => [m Type] -> m Dec
defaultD tys = DefaultD <$> sequenceA tys
@@ -1078,7 +1087,7 @@ withDecDoc doc dec = do
doc_loc (SigD n _) = Just $ DeclDoc n
doc_loc (ForeignD (ImportF _ _ _ n _)) = Just $ DeclDoc n
doc_loc (ForeignD (ExportF _ _ n _)) = Just $ DeclDoc n
- doc_loc (InfixD _ n) = Just $ DeclDoc n
+ doc_loc (InfixD _ _ n) = Just $ DeclDoc n
doc_loc (DataFamilyD n _ _) = Just $ DeclDoc n
doc_loc (OpenTypeFamilyD (TypeFamilyHead n _ _ _)) = Just $ DeclDoc n
doc_loc (ClosedTypeFamilyD (TypeFamilyHead n _ _ _) _) = Just $ DeclDoc n
=====================================
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
=====================================
@@ -77,13 +77,19 @@ instance Ppr Info where
ppr_sig :: Name -> Type -> Doc
ppr_sig v ty = pprName' Applied v <+> dcolon <+> ppr ty
-pprFixity :: Name -> Fixity -> Doc
-pprFixity _ f | f == defaultFixity = empty
-pprFixity v (Fixity i d) = ppr_fix d <+> int i <+> pprName' Infix v
+pprFixity :: Name -> Fixity -> NamespaceSpecifier -> Doc
+pprFixity _ f _ | f == defaultFixity = empty
+pprFixity v (Fixity i d) ns_spec
+ = ppr_fix d <+> int i <+> pprNamespaceSpecifier ns_spec <+> pprName' Infix v
where ppr_fix InfixR = text "infixr"
ppr_fix InfixL = text "infixl"
ppr_fix InfixN = text "infix"
+pprNamespaceSpecifier :: NamespaceSpecifier -> Doc
+pprNamespaceSpecifier NoNamespaceSpecifier = empty
+pprNamespaceSpecifier TypeNamespaceSpecifier = text "type"
+pprNamespaceSpecifier DataNamespaceSpecifier = text "data"
+
-- | Pretty prints a pattern synonym type signature
pprPatSynSig :: Name -> PatSynType -> Doc
pprPatSynSig nm ty
@@ -418,7 +424,7 @@ ppr_dec _ (InstanceD o ctxt i ds) =
ppr_dec _ (SigD f t) = pprPrefixOcc f <+> dcolon <+> ppr t
ppr_dec _ (KiSigD f k) = text "type" <+> pprPrefixOcc f <+> dcolon <+> ppr k
ppr_dec _ (ForeignD f) = ppr f
-ppr_dec _ (InfixD fx n) = pprFixity n fx
+ppr_dec _ (InfixD fx ns_spec n) = pprFixity n fx ns_spec
ppr_dec _ (DefaultD tys) =
text "default" <+> parens (sep $ punctuate comma $ map ppr tys)
ppr_dec _ (PragmaD p) = ppr p
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -2452,7 +2452,8 @@ data Dec
| ForeignD Foreign -- ^ @{ foreign import ... }
--{ foreign export ... }@
- | InfixD Fixity Name -- ^ @{ infix 3 foo }@
+ | InfixD Fixity NamespaceSpecifier Name
+ -- ^ @{ infix 3 data foo }@
| DefaultD [Type] -- ^ @{ default (Integer, Double) }@
-- | pragmas
@@ -2509,6 +2510,18 @@ data Dec
-- and where clauses which consist entirely of implicit bindings.
deriving( Show, Eq, Ord, Data, Generic )
+-- | A way to specify a namespace to look in when GHC needs to find
+-- a name's source
+data NamespaceSpecifier
+ = NoNamespaceSpecifier -- ^ Name may be everything; If there are two
+ -- names in different namespaces, then consider both
+ | TypeNamespaceSpecifier -- ^ Name should be a type-level entity, such as a
+ -- data type, type alias, type family, type class,
+ -- or type variable
+ | DataNamespaceSpecifier -- ^ Name should be a term-level entity, such as a
+ -- function, data constructor, or pattern synonym
+ deriving( Show, Eq, Ord, Data, Generic )
+
-- | Varieties of allowed instance overlap.
data Overlap = Overlappable -- ^ May be overlapped by more specific instances
| Overlapping -- ^ May overlap a more general instance
=====================================
testsuite/tests/parser/should_compile/T20846.stderr
=====================================
@@ -49,7 +49,7 @@
(EpaComments
[]))
(FixitySig
- (NoExtField)
+ (NoNamespaceSpecifier)
[(L
(EpAnn
(EpaSpan { T20846.hs:3:8-11 })
=====================================
testsuite/tests/th/T11345.hs
=====================================
@@ -25,7 +25,7 @@ $(do gadtName <- newName "GADT2"
, (Bang NoSourceUnpackedness NoSourceStrictness,ConT ''Int)
] (AppT (ConT gadtName) (ConT ''Int))
] []
- , InfixD (Fixity 7 InfixR) infixName
+ , InfixD (Fixity 7 InfixR) NoNamespaceSpecifier infixName
])
$(return [])
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit b0b0e0366457c9aefebcc94df74e5de4d00e17b7
+Subproject commit 4847b2247132c2de873b1ebac00a573f5f59394c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5148524896905d21bfaf39f13349dd83af4f99fa
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5148524896905d21bfaf39f13349dd83af4f99fa
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/20240202/81eda5d5/attachment-0001.html>
More information about the ghc-commits
mailing list