summaryrefslogtreecommitdiff
path: root/compiler/GHC/Hs
diff options
context:
space:
mode:
authorGert-Jan Bottu <gertjan.bottu@kuleuven.be>2020-03-23 09:36:28 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-05-21 12:11:31 -0400
commita9311cd53d33439e8fe79967ba5fb85bcd114fec (patch)
tree2254ef735a24f9de8d192203a3c6f4871a8b6ae9 /compiler/GHC/Hs
parent55f0e783d234af103cf4e1d51cd31c99961c5abe (diff)
downloadhaskell-a9311cd53d33439e8fe79967ba5fb85bcd114fec.tar.gz
Explicit Specificity
Implementation for Ticket #16393. Explicit specificity allows users to manually create inferred type variables, by marking them with braces. This way, the user determines which variables can be instantiated through visible type application. The additional syntax is included in the parser, allowing users to write braces in type variable binders (type signatures, data constructors etc). This information is passed along through the renamer and verified in the type checker. The AST for type variable binders, data constructors, pattern synonyms, partial signatures and Template Haskell has been updated to include the specificity of type variables. Minor notes: - Bumps haddock submodule - Disables pattern match checking in GHC.Iface.Type with GHC 8.8
Diffstat (limited to 'compiler/GHC/Hs')
-rw-r--r--compiler/GHC/Hs/Decls.hs38
-rw-r--r--compiler/GHC/Hs/Instances.hs6
-rw-r--r--compiler/GHC/Hs/Types.hs140
-rw-r--r--compiler/GHC/Hs/Utils.hs19
4 files changed, 121 insertions, 82 deletions
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 8044b37cc4..6dfe75005e 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -108,6 +108,7 @@ import GHC.Types.Basic
import GHC.Core.Coercion
import GHC.Types.ForeignCall
import GHC.Hs.Extension
+import GHC.Types.Name
import GHC.Types.Name.Set
-- others:
@@ -560,7 +561,7 @@ data TyClDecl pass
, tcdTyVars :: LHsQTyVars pass -- ^ Type variables; for an
-- associated type these
-- include outer binders
- , tcdFixity :: LexicalFixity -- ^ Fixity used in the declaration
+ , tcdFixity :: LexicalFixity -- ^ Fixity used in the declaration
, tcdRhs :: LHsType pass } -- ^ RHS of type declaration
| -- | @data@ declaration
@@ -579,10 +580,10 @@ data TyClDecl pass
, tcdFixity :: LexicalFixity -- ^ Fixity used in the declaration
, tcdDataDefn :: HsDataDefn pass }
- | ClassDecl { tcdCExt :: XClassDecl pass, -- ^ Post renamer, FVs
- tcdCtxt :: LHsContext pass, -- ^ Context...
- tcdLName :: Located (IdP pass), -- ^ Name of the class
- tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables
+ | ClassDecl { tcdCExt :: XClassDecl pass, -- ^ Post renamer, FVs
+ tcdCtxt :: LHsContext pass, -- ^ Context...
+ tcdLName :: Located (IdP pass), -- ^ Name of the class
+ tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables
tcdFixity :: LexicalFixity, -- ^ Fixity used in the declaration
tcdFDs :: [LHsFunDep pass], -- ^ Functional deps
tcdSigs :: [LSig pass], -- ^ Methods' signatures
@@ -1056,7 +1057,7 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig]
-- For details on above see note [Api annotations] in GHC.Parser.Annotation
- | TyVarSig (XTyVarSig pass) (LHsTyVarBndr pass)
+ | TyVarSig (XTyVarSig pass) (LHsTyVarBndr () pass)
-- ^ - 'ApiAnnotation.AnnKeywordId' :
-- 'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
-- 'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'
@@ -1138,8 +1139,8 @@ famResultKindSignature (NoSig _) = Nothing
famResultKindSignature (KindSig _ ki) = Just ki
famResultKindSignature (TyVarSig _ bndr) =
case unLoc bndr of
- UserTyVar _ _ -> Nothing
- KindedTyVar _ _ ki -> Just ki
+ UserTyVar _ _ _ -> Nothing
+ KindedTyVar _ _ _ ki -> Just ki
-- | Maybe return name of the result type variable
resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a))
@@ -1386,7 +1387,7 @@ data ConDecl pass
-- AnnForall and AnnDot.
, con_forall :: Located Bool -- ^ True <=> explicit forall
-- False => hsq_explicit is empty
- , con_qvars :: LHsQTyVars pass
+ , con_qvars :: [LHsTyVarBndr Specificity pass]
-- Whether or not there is an /explicit/ forall, we still
-- need to capture the implicitly-bound type/kind variables
@@ -1407,16 +1408,19 @@ data ConDecl pass
-- e.g. data T a = forall b. MkT b (b->a)
-- con_ex_tvs = {b}
-- False => con_ex_tvs is empty
- , con_ex_tvs :: [LHsTyVarBndr pass] -- ^ Existentials only
- , con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any)
- , con_args :: HsConDeclDetails pass -- ^ Arguments; can be InfixCon
+ , con_ex_tvs :: [LHsTyVarBndr Specificity pass] -- ^ Existentials only
+ , con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any)
+ , con_args :: HsConDeclDetails pass -- ^ Arguments; can be InfixCon
, con_doc :: Maybe LHsDocString
-- ^ A possible Haddock comment.
}
| XConDecl !(XXConDecl pass)
-type instance XConDeclGADT (GhcPass _) = NoExtField
+type instance XConDeclGADT GhcPs = NoExtField
+type instance XConDeclGADT GhcRn = [Name] -- Implicitly bound type variables
+type instance XConDeclGADT GhcTc = NoExtField
+
type instance XConDeclH98 (GhcPass _) = NoExtField
type instance XXConDecl (GhcPass _) = NoExtCon
@@ -1542,7 +1546,7 @@ pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars
, con_mb_cxt = mcxt, con_args = args
, con_res_ty = res_ty, con_doc = doc })
= ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon
- <+> (sep [pprHsForAll ForallInvis (hsq_explicit qvars) cxt,
+ <+> (sep [pprHsForAll ForallInvis qvars cxt,
ppr_arrow_chain (get_args args ++ [ppr res_ty]) ])
where
get_args (PrefixCon args) = map ppr args
@@ -1691,7 +1695,7 @@ data FamEqn pass rhs
= FamEqn
{ feqn_ext :: XCFamEqn pass rhs
, feqn_tycon :: Located (IdP pass)
- , feqn_bndrs :: Maybe [LHsTyVarBndr pass] -- ^ Optional quantified type vars
+ , feqn_bndrs :: Maybe [LHsTyVarBndr () pass] -- ^ Optional quantified type vars
, feqn_pats :: HsTyPats pass
, feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration
, feqn_rhs :: rhs
@@ -1812,7 +1816,7 @@ pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
pprHsFamInstLHS :: (OutputableBndrId p)
=> IdP (GhcPass p)
- -> Maybe [LHsTyVarBndr (GhcPass p)]
+ -> Maybe [LHsTyVarBndr () (GhcPass p)]
-> HsTyPats (GhcPass p)
-> LexicalFixity
-> LHsContext (GhcPass p)
@@ -2209,7 +2213,7 @@ data RuleDecl pass
, rd_name :: Located (SourceText,RuleName)
-- ^ Note [Pragma source text] in GHC.Types.Basic
, rd_act :: Activation
- , rd_tyvs :: Maybe [LHsTyVarBndr (NoGhcTc pass)]
+ , rd_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc pass)]
-- ^ Forall'd type vars
, rd_tmvs :: [LRuleBndr pass]
-- ^ Forall'd term vars, before typechecking; after typechecking
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index f30e07a50e..a003a6b885 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -392,9 +392,9 @@ deriving instance Data (HsPatSigType GhcRn)
deriving instance Data (HsPatSigType GhcTc)
-- deriving instance (DataIdLR p p) => Data (HsTyVarBndr p)
-deriving instance Data (HsTyVarBndr GhcPs)
-deriving instance Data (HsTyVarBndr GhcRn)
-deriving instance Data (HsTyVarBndr GhcTc)
+deriving instance (Data flag) => Data (HsTyVarBndr flag GhcPs)
+deriving instance (Data flag) => Data (HsTyVarBndr flag GhcRn)
+deriving instance (Data flag) => Data (HsTyVarBndr flag GhcTc)
-- deriving instance (DataIdLR p p) => Data (HsType p)
deriving instance Data (HsType GhcPs)
diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs
index f7a595d0f0..2bb4d11240 100644
--- a/compiler/GHC/Hs/Types.hs
+++ b/compiler/GHC/Hs/Types.hs
@@ -31,6 +31,7 @@ module GHC.Hs.Types (
HsIPName(..), hsIPNameFS,
HsArg(..), numVisibleArgs,
LHsTypeArg,
+ OutputableBndrFlag,
LBangType, BangType,
HsSrcBang(..), HsImplBang(..),
@@ -50,7 +51,7 @@ module GHC.Hs.Types (
mkHsImplicitBndrs, mkHsWildCardBndrs, mkHsPatSigType, hsImplicitBody,
mkEmptyImplicitBndrs, mkEmptyWildCardBndrs,
- mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, isEmptyLHsQTvs,
+ mkHsQTvs, hsQTvExplicit, emptyLHsQTvs,
isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy,
hsScopedTvs, hsWcScopedTvs, dropWildCards,
hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames,
@@ -61,9 +62,9 @@ module GHC.Hs.Types (
splitHsFunType, hsTyGetAppHead_maybe,
mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy,
ignoreParens, hsSigType, hsSigWcType, hsPatSigType,
- hsLTyVarBndrToType, hsLTyVarBndrsToTypes,
hsTyKindSig,
hsConDetailsArgs,
+ setHsTyVarBndrFlag, hsTyVarBndrFlag,
-- Printing
pprHsType, pprHsForAll, pprHsForAllExtra, pprHsExplicitForAll,
@@ -328,14 +329,14 @@ type LHsKind pass = Located (HsKind pass)
-- The explicitly-quantified binders in a data/type declaration
-- | Located Haskell Type Variable Binder
-type LHsTyVarBndr pass = Located (HsTyVarBndr pass)
+type LHsTyVarBndr flag pass = Located (HsTyVarBndr flag pass)
-- See Note [HsType binders]
-- | Located Haskell Quantified Type Variables
data LHsQTyVars pass -- See Note [HsType binders]
= HsQTvs { hsq_ext :: XHsQTvs pass
- , hsq_explicit :: [LHsTyVarBndr pass]
+ , hsq_explicit :: [LHsTyVarBndr () pass]
-- Explicit variables, written by the user
}
| XLHsQTyVars !(XXLHsQTyVars pass)
@@ -350,19 +351,15 @@ type instance XHsQTvs GhcTc = HsQTvsRn
type instance XXLHsQTyVars (GhcPass _) = NoExtCon
-mkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs
+mkHsQTvs :: [LHsTyVarBndr () GhcPs] -> LHsQTyVars GhcPs
mkHsQTvs tvs = HsQTvs { hsq_ext = noExtField, hsq_explicit = tvs }
-hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr pass]
+hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsQTvExplicit = hsq_explicit
emptyLHsQTvs :: LHsQTyVars GhcRn
emptyLHsQTvs = HsQTvs { hsq_ext = [], hsq_explicit = [] }
-isEmptyLHsQTvs :: LHsQTyVars GhcRn -> Bool
-isEmptyLHsQTvs (HsQTvs { hsq_ext = imp, hsq_explicit = exp })
- = null imp && null exp
-
------------------------------------------------
-- HsImplicitBndrs
-- Used to quantify the implicit binders of a type
@@ -591,13 +588,18 @@ instance OutputableBndr HsIPName where
--------------------------------------------------
-- | Haskell Type Variable Binder
-data HsTyVarBndr pass
+-- The flag annotates the binder. It is 'Specificity' in places where
+-- explicit specificity is allowed (e.g. x :: forall {a} b. ...) or
+-- '()' in other places.
+data HsTyVarBndr flag pass
= UserTyVar -- no explicit kinding
(XUserTyVar pass)
+ flag
(Located (IdP pass))
-- See Note [Located RdrNames] in GHC.Hs.Expr
| KindedTyVar
(XKindedTyVar pass)
+ flag
(Located (IdP pass))
(LHsKind pass) -- The user-supplied kind signature
-- ^
@@ -614,8 +616,19 @@ type instance XKindedTyVar (GhcPass _) = NoExtField
type instance XXTyVarBndr (GhcPass _) = NoExtCon
+-- | Return the attached flag
+hsTyVarBndrFlag :: HsTyVarBndr flag (GhcPass pass) -> flag
+hsTyVarBndrFlag (UserTyVar _ fl _) = fl
+hsTyVarBndrFlag (KindedTyVar _ fl _ _) = fl
+
+-- | Set the attached flag
+setHsTyVarBndrFlag :: flag -> HsTyVarBndr flag' (GhcPass pass)
+ -> HsTyVarBndr flag (GhcPass pass)
+setHsTyVarBndrFlag f (UserTyVar x _ l) = UserTyVar x f l
+setHsTyVarBndrFlag f (KindedTyVar x _ l k) = KindedTyVar x f l k
+
-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?
-isHsKindedTyVar :: HsTyVarBndr pass -> Bool
+isHsKindedTyVar :: HsTyVarBndr flag pass -> Bool
isHsKindedTyVar (UserTyVar {}) = False
isHsKindedTyVar (KindedTyVar {}) = True
isHsKindedTyVar (XTyVarBndr {}) = False
@@ -624,9 +637,24 @@ isHsKindedTyVar (XTyVarBndr {}) = False
hsTvbAllKinded :: LHsQTyVars pass -> Bool
hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit
-instance NamedThing (HsTyVarBndr GhcRn) where
- getName (UserTyVar _ v) = unLoc v
- getName (KindedTyVar _ v _) = unLoc v
+instance NamedThing (HsTyVarBndr flag GhcRn) where
+ getName (UserTyVar _ _ v) = unLoc v
+ getName (KindedTyVar _ _ v _) = unLoc v
+
+{- Note [Specificity in HsForAllTy]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+All type variables in a `HsForAllTy` type are annotated with their
+`Specificity`. The meaning of this `Specificity` depends on the visibility of
+the binder `hst_fvf`:
+
+* In an invisible forall type, the `Specificity` denotes whether type variables
+ are `Specified` (`forall a. ...`) or `Inferred` (`forall {a}. ...`). For more
+ information, see Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]
+ in GHC.Core.TyCo.Rep.
+
+* In a visible forall type, the `Specificity` has no particular meaning. We
+ uphold the convention that all visible forall types use `Specified` binders.
+-}
-- | Haskell Type
data HsType pass
@@ -634,9 +662,10 @@ data HsType pass
{ hst_xforall :: XForAllTy pass
, hst_fvf :: ForallVisFlag -- Is this `forall a -> {...}` or
-- `forall a. {...}`?
- , hst_bndrs :: [LHsTyVarBndr pass]
- -- Explicit, user-supplied 'forall a b c'
- , hst_body :: LHsType pass -- body type
+ , hst_bndrs :: [LHsTyVarBndr Specificity pass]
+ -- Explicit, user-supplied 'forall a {b} c'
+ -- see Note [Specificity in HsForAllTy]
+ , hst_body :: LHsType pass -- body type
}
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForall',
-- 'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
@@ -1123,14 +1152,14 @@ Bottom line: nip problems in the bud by matching on ForallInvis from the start.
-}
---------------------
-hsTyVarName :: HsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
-hsTyVarName (UserTyVar _ (L _ n)) = n
-hsTyVarName (KindedTyVar _ (L _ n) _) = n
+hsTyVarName :: HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
+hsTyVarName (UserTyVar _ _ (L _ n)) = n
+hsTyVarName (KindedTyVar _ _ (L _ n) _) = n
-hsLTyVarName :: LHsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
+hsLTyVarName :: LHsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName = hsTyVarName . unLoc
-hsLTyVarNames :: [LHsTyVarBndr (GhcPass p)] -> [IdP (GhcPass p)]
+hsLTyVarNames :: [LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames = map hsLTyVarName
hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)]
@@ -1143,26 +1172,12 @@ hsAllLTyVarNames (HsQTvs { hsq_ext = kvs
, hsq_explicit = tvs })
= kvs ++ hsLTyVarNames tvs
-hsLTyVarLocName :: LHsTyVarBndr (GhcPass p) -> Located (IdP (GhcPass p))
+hsLTyVarLocName :: LHsTyVarBndr flag (GhcPass p) -> Located (IdP (GhcPass p))
hsLTyVarLocName = mapLoc hsTyVarName
hsLTyVarLocNames :: LHsQTyVars (GhcPass p) -> [Located (IdP (GhcPass p))]
hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)
--- | Convert a LHsTyVarBndr to an equivalent LHsType.
-hsLTyVarBndrToType :: LHsTyVarBndr (GhcPass p) -> LHsType (GhcPass p)
-hsLTyVarBndrToType = mapLoc cvt
- where cvt :: HsTyVarBndr (GhcPass p) -> HsType (GhcPass p)
- cvt (UserTyVar _ n) = HsTyVar noExtField NotPromoted n
- cvt (KindedTyVar _ (L name_loc n) kind)
- = HsKindSig noExtField
- (L name_loc (HsTyVar noExtField NotPromoted (L name_loc n))) kind
-
--- | Convert a LHsTyVarBndrs to a list of types.
--- Works on *type* variable only, no kind vars.
-hsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)]
-hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs
-
-- | Get the kind signature of a type, ignoring parentheses:
--
-- hsTyKindSig `Maybe ` = Nothing
@@ -1299,9 +1314,9 @@ The SrcSpan is the span of the original HsPar
-- generally possible to take the returned types and reconstruct the original
-- type (parentheses and all) from them.
splitLHsPatSynTy :: LHsType pass
- -> ( [LHsTyVarBndr pass] -- universals
+ -> ( [LHsTyVarBndr Specificity pass] -- universals
, LHsContext pass -- required constraints
- , [LHsTyVarBndr pass] -- existentials
+ , [LHsTyVarBndr Specificity pass] -- existentials
, LHsContext pass -- provided constraints
, LHsType pass) -- body type
splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)
@@ -1312,9 +1327,9 @@ splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)
(provs, ty4) = splitLHsQualTy ty3
-- | Decompose a sigma type (of the form @forall <tvs>. context => body@)
--- into its constituent parts. Note that only /invisible/ @forall@s
--- (i.e., @forall a.@, with a dot) are split apart; /visible/ @forall@s
--- (i.e., @forall a ->@, with an arrow) are left untouched.
+-- into its constituent parts.
+-- Only splits type variable binders that were
+-- quantified invisibly (e.g., @forall a.@, with a dot).
--
-- This function is used to split apart certain types, such as instance
-- declaration types, which disallow visible @forall@s. For instance, if GHC
@@ -1326,16 +1341,15 @@ splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)
-- generally possible to take the returned types and reconstruct the original
-- type (parentheses and all) from them.
splitLHsSigmaTyInvis :: LHsType pass
- -> ([LHsTyVarBndr pass], LHsContext pass, LHsType pass)
+ -> ([LHsTyVarBndr Specificity pass], LHsContext pass, LHsType pass)
splitLHsSigmaTyInvis ty
| (tvs, ty1) <- splitLHsForAllTyInvis ty
, (ctxt, ty2) <- splitLHsQualTy ty1
= (tvs, ctxt, ty2)
-- | Decompose a type of the form @forall <tvs>. body@ into its constituent
--- parts. Note that only /invisible/ @forall@s
--- (i.e., @forall a.@, with a dot) are split apart; /visible/ @forall@s
--- (i.e., @forall a ->@, with an arrow) are left untouched.
+-- parts. Only splits type variable binders that
+-- were quantified invisibly (e.g., @forall a.@, with a dot).
--
-- This function is used to split apart certain types, such as instance
-- declaration types, which disallow visible @forall@s. For instance, if GHC
@@ -1346,7 +1360,7 @@ splitLHsSigmaTyInvis ty
-- such as @(forall a. <...>)@. The downside to this is that it is not
-- generally possible to take the returned types and reconstruct the original
-- type (parentheses and all) from them.
-splitLHsForAllTyInvis :: LHsType pass -> ([LHsTyVarBndr pass], LHsType pass)
+splitLHsForAllTyInvis :: LHsType pass -> ([LHsTyVarBndr Specificity pass], LHsType pass)
splitLHsForAllTyInvis lty@(L _ ty) =
case ty of
HsParTy _ ty' -> splitLHsForAllTyInvis ty'
@@ -1494,6 +1508,19 @@ ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr
************************************************************************
-}
+class OutputableBndrFlag flag where
+ pprTyVarBndr :: OutputableBndrId p => HsTyVarBndr flag (GhcPass p) -> SDoc
+
+instance OutputableBndrFlag () where
+ pprTyVarBndr (UserTyVar _ _ n) = ppr n
+ pprTyVarBndr (KindedTyVar _ _ n k) = parens $ hsep [ppr n, dcolon, ppr k]
+
+instance OutputableBndrFlag Specificity where
+ pprTyVarBndr (UserTyVar _ SpecifiedSpec n) = ppr n
+ pprTyVarBndr (UserTyVar _ InferredSpec n) = braces $ ppr n
+ pprTyVarBndr (KindedTyVar _ SpecifiedSpec n k) = parens $ hsep [ppr n, dcolon, ppr k]
+ pprTyVarBndr (KindedTyVar _ InferredSpec n k) = braces $ hsep [ppr n, dcolon, ppr k]
+
instance OutputableBndrId p => Outputable (HsType (GhcPass p)) where
ppr ty = pprHsType ty
@@ -1504,10 +1531,9 @@ instance OutputableBndrId p
=> Outputable (LHsQTyVars (GhcPass p)) where
ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs
-instance OutputableBndrId p
- => Outputable (HsTyVarBndr (GhcPass p)) where
- ppr (UserTyVar _ n) = ppr n
- ppr (KindedTyVar _ n k) = parens $ hsep [ppr n, dcolon, ppr k]
+instance (OutputableBndrId p, OutputableBndrFlag flag)
+ => Outputable (HsTyVarBndr flag (GhcPass p)) where
+ ppr = pprTyVarBndr
instance Outputable thing
=> Outputable (HsImplicitBndrs (GhcPass p) thing) where
@@ -1526,8 +1552,8 @@ pprAnonWildCard = char '_'
-- | Prints a forall; When passed an empty list, prints @forall .@/@forall ->@
-- only when @-dppr-debug@ is enabled.
-pprHsForAll :: (OutputableBndrId p)
- => ForallVisFlag -> [LHsTyVarBndr (GhcPass p)]
+pprHsForAll :: (OutputableBndrId p, OutputableBndrFlag flag)
+ => ForallVisFlag -> [LHsTyVarBndr flag (GhcPass p)]
-> LHsContext (GhcPass p) -> SDoc
pprHsForAll = pprHsForAllExtra Nothing
@@ -1538,9 +1564,9 @@ pprHsForAll = pprHsForAllExtra Nothing
-- function for this is needed, as the extra-constraints wildcard is removed
-- from the actual context and type, and stored in a separate field, thus just
-- printing the type will not print the extra-constraints wildcard.
-pprHsForAllExtra :: (OutputableBndrId p)
+pprHsForAllExtra :: (OutputableBndrId p, OutputableBndrFlag flag)
=> Maybe SrcSpan -> ForallVisFlag
- -> [LHsTyVarBndr (GhcPass p)]
+ -> [LHsTyVarBndr flag (GhcPass p)]
-> LHsContext (GhcPass p) -> SDoc
pprHsForAllExtra extra fvf qtvs cxt
= pp_forall <+> pprLHsContextExtra (isJust extra) cxt
@@ -1554,7 +1580,7 @@ pprHsForAllExtra extra fvf qtvs cxt
-- @forall.@ when passed @Just []@. Prints nothing if passed 'Nothing'
pprHsExplicitForAll :: (OutputableBndrId p)
=> ForallVisFlag
- -> Maybe [LHsTyVarBndr (GhcPass p)] -> SDoc
+ -> Maybe [LHsTyVarBndr () (GhcPass p)] -> SDoc
pprHsExplicitForAll fvf (Just qtvs) = forAllLit <+> interppSP qtvs
<> ppr_forall_separator fvf
pprHsExplicitForAll _ Nothing = empty
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 6e89b6844a..6301927b26 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -736,14 +736,23 @@ typeToLHsType ty
foldl' (\f (arg, flag) ->
let arg' = go arg in
case flag of
- Inferred -> f
- Specified -> f `nlHsAppKindTy` arg'
+ -- See Note [Explicit Case Statement for Specificity]
+ Invisible spec -> case spec of
+ InferredSpec -> f
+ SpecifiedSpec -> f `nlHsAppKindTy` arg'
Required -> f `nlHsAppTy` arg')
head (zip args arg_flags)
- go_tv :: TyVar -> LHsTyVarBndr GhcPs
- go_tv tv = noLoc $ KindedTyVar noExtField (noLoc (getRdrName tv))
- (go (tyVarKind tv))
+ argf_to_spec :: ArgFlag -> Specificity
+ argf_to_spec Required = SpecifiedSpec
+ -- see Note [Specificity in HsForAllTy] in GHC.Hs.Types
+ argf_to_spec (Invisible s) = s
+
+ go_tv :: TyVarBinder -> LHsTyVarBndr Specificity GhcPs
+ go_tv (Bndr tv argf) = noLoc $ KindedTyVar noExtField
+ (argf_to_spec argf)
+ (noLoc (getRdrName tv))
+ (go (tyVarKind tv))
{-
Note [Kind signatures in typeToLHsType]