diff options
| -rw-r--r-- | compiler/GHC/CoreToIface.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Iface/Syntax.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Iface/Type.hs | 19 |
3 files changed, 18 insertions, 9 deletions
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs index 1437208925..d48686b615 100644 --- a/compiler/GHC/CoreToIface.hs +++ b/compiler/GHC/CoreToIface.hs @@ -194,7 +194,7 @@ toIfaceTypeX fr (TyConApp tc tys) | tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ] , (k1:k2:_) <- tys - = let info = IfaceTyConInfo NotPromoted sort + = let info = mkIfaceTyConInfo NotPromoted sort sort | k1 `eqType` k2 = IfaceEqualityTyCon | otherwise = IfaceNormalTyCon in IfaceTyConApp (IfaceTyCon (tyConName tc) info) (toIfaceTcArgsX fr tc tys) @@ -224,7 +224,7 @@ toIfaceTyCon tc = IfaceTyCon tc_name info where tc_name = tyConName tc - info = IfaceTyConInfo promoted sort + info = mkIfaceTyConInfo promoted sort promoted | isPromotedDataCon tc = IsPromoted | otherwise = NotPromoted @@ -252,7 +252,7 @@ toIfaceTyCon tc toIfaceTyCon_name :: Name -> IfaceTyCon toIfaceTyCon_name n = IfaceTyCon n info - where info = IfaceTyConInfo NotPromoted IfaceNormalTyCon + where info = mkIfaceTyConInfo NotPromoted IfaceNormalTyCon -- Used for the "rough-match" tycon stuff, -- where pretty-printing is not an issue diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs index 21b4274cc7..908d105de0 100644 --- a/compiler/GHC/Iface/Syntax.hs +++ b/compiler/GHC/Iface/Syntax.hs @@ -802,7 +802,7 @@ pprClassStandaloneKindSig ss clas = constraintIfaceKind :: IfaceKind constraintIfaceKind = - IfaceTyConApp (IfaceTyCon constraintKindTyConName (IfaceTyConInfo NotPromoted IfaceNormalTyCon)) IA_Nil + IfaceTyConApp (IfaceTyCon constraintKindTyConName (mkIfaceTyConInfo NotPromoted IfaceNormalTyCon)) IA_Nil pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc -- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs index ae0d592959..b90676f062 100644 --- a/compiler/GHC/Iface/Type.hs +++ b/compiler/GHC/Iface/Type.hs @@ -21,7 +21,9 @@ module GHC.Iface.Type ( IfaceMCoercion(..), IfaceUnivCoProv(..), IfaceMult, - IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..), + IfaceTyCon(..), + IfaceTyConInfo(..), mkIfaceTyConInfo, + IfaceTyConSort(..), IfaceTyLit(..), IfaceAppArgs(..), IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr, IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder, @@ -355,6 +357,13 @@ data IfaceTyConInfo -- Used to guide pretty-printing , ifaceTyConSort :: IfaceTyConSort } deriving (Eq) +-- This smart constructor allows sharing of the two most common +-- cases. See #19194 +mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo +mkIfaceTyConInfo IsPromoted IfaceNormalTyCon = IfaceTyConInfo IsPromoted IfaceNormalTyCon +mkIfaceTyConInfo NotPromoted IfaceNormalTyCon = IfaceTyConInfo NotPromoted IfaceNormalTyCon +mkIfaceTyConInfo prom sort = IfaceTyConInfo prom sort + data IfaceMCoercion = IfaceMRefl | IfaceMCo IfaceCoercion @@ -1102,12 +1111,12 @@ liftedRep_ty = IfaceTyConApp liftedRep IA_Nil where liftedRep :: IfaceTyCon - liftedRep = IfaceTyCon tc_name (IfaceTyConInfo NotPromoted IfaceNormalTyCon) + liftedRep = IfaceTyCon tc_name (mkIfaceTyConInfo NotPromoted IfaceNormalTyCon) where tc_name = getName liftedRepTyCon many_ty :: IfaceType many_ty = - IfaceTyConApp (IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)) + IfaceTyConApp (IfaceTyCon dc_name (mkIfaceTyConInfo IsPromoted IfaceNormalTyCon)) IA_Nil where dc_name = getName manyDataConTyCon @@ -1629,7 +1638,7 @@ pprTuple ctxt_prec sort promoted args = -- `Solo x`, not `(x)` | [_] <- args_wo_runtime_reps , BoxedTuple <- sort - = let unit_tc_info = IfaceTyConInfo promoted IfaceNormalTyCon + = let unit_tc_info = mkIfaceTyConInfo promoted IfaceNormalTyCon unit_tc = IfaceTyCon (tupleTyConName sort 1) unit_tc_info in pprPrecIfaceType ctxt_prec $ IfaceTyConApp unit_tc args | otherwise @@ -1780,7 +1789,7 @@ instance Binary IfaceTyConSort where instance Binary IfaceTyConInfo where put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s - get bh = IfaceTyConInfo <$> get bh <*> get bh + get bh = mkIfaceTyConInfo <$> get bh <*> get bh instance Outputable IfaceTyLit where ppr = pprIfaceTyLit |