summaryrefslogtreecommitdiff
path: root/compiler/prelude/TysWiredIn.hs
diff options
context:
space:
mode:
authorBartosz Nitka <niteria@gmail.com>2017-12-26 12:54:27 +0000
committerBartosz Nitka <niteria@gmail.com>2018-01-04 14:03:54 +0000
commit6c34824434a67baa34e4ee2ddb753708eb61c5bc (patch)
treeca8c84cae978b3cc61ff096f74016d7aebfd1707 /compiler/prelude/TysWiredIn.hs
parent649e777211fe08432900093002547d7358f92d82 (diff)
downloadhaskell-6c34824434a67baa34e4ee2ddb753708eb61c5bc.tar.gz
Cache the number of data cons in DataTyCon and SumTyCon
This is a follow-up after faf60e85 - Make tagForCon non-linear. On the mailing list @simonpj suggested to solve the linear behavior by caching the sizes. Test Plan: ./validate Reviewers: simonpj, simonmar, bgamari, austin Reviewed By: simonpj Subscribers: carter, goldfire, rwbarton, thomie, simonpj Differential Revision: https://phabricator.haskell.org/D4131
Diffstat (limited to 'compiler/prelude/TysWiredIn.hs')
-rw-r--r--compiler/prelude/TysWiredIn.hs65
1 files changed, 30 insertions, 35 deletions
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 2ee7e147a6..fda6b221f3 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -471,21 +471,17 @@ parrTyCon_RDR = nameRdrName parrTyConName
************************************************************************
-}
-pcNonEnumTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
--- Not an enumeration
-pcNonEnumTyCon = pcTyCon False
-
-- This function assumes that the types it creates have all parameters at
-- Representational role, and that there is no kind polymorphism.
-pcTyCon :: Bool -> Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
-pcTyCon is_enum name cType tyvars cons
+pcTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
+pcTyCon name cType tyvars cons
= mkAlgTyCon name
(mkAnonTyConBinders tyvars)
liftedTypeKind
(map (const Representational) tyvars)
cType
[] -- No stupid theta
- (DataTyCon cons is_enum)
+ (mkDataTyConRhs cons)
(VanillaAlgTyCon (mkPrelTyConRepName name))
False -- Not in GADT syntax
@@ -569,16 +565,15 @@ pcSpecialDataCon dc_name arg_tys tycon rri
typeNatKindCon, typeSymbolKindCon :: TyCon
-- data Nat
-- data Symbol
-typeNatKindCon = pcTyCon False typeNatKindConName Nothing [] []
-typeSymbolKindCon = pcTyCon False typeSymbolKindConName Nothing [] []
+typeNatKindCon = pcTyCon typeNatKindConName Nothing [] []
+typeSymbolKindCon = pcTyCon typeSymbolKindConName Nothing [] []
typeNatKind, typeSymbolKind :: Kind
typeNatKind = mkTyConTy typeNatKindCon
typeSymbolKind = mkTyConTy typeSymbolKindCon
constraintKindTyCon :: TyCon
-constraintKindTyCon = pcTyCon False constraintKindTyConName
- Nothing [] []
+constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] []
liftedTypeKind, constraintKind :: Kind
liftedTypeKind = tYPE liftedRepTy
@@ -1032,7 +1027,7 @@ heqSCSelId, coercibleSCSelId :: Id
-- Kind: forall k1 k2. k1 -> k2 -> Constraint
binders = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] (\ks -> ks)
roles = [Nominal, Nominal, Nominal, Nominal]
- rhs = DataTyCon { data_cons = [datacon], is_enum = False }
+ rhs = mkDataTyConRhs [datacon]
tvs = binderVars binders
sc_pred = mkTyConApp eqPrimTyCon (mkTyVarTys tvs)
@@ -1050,7 +1045,7 @@ heqSCSelId, coercibleSCSelId :: Id
-- Kind: forall k. k -> k -> Constraint
binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
roles = [Nominal, Representational, Representational]
- rhs = DataTyCon { data_cons = [datacon], is_enum = False }
+ rhs = mkDataTyConRhs [datacon]
tvs@[k,a,b] = binderVars binders
sc_pred = mkTyConApp eqReprPrimTyCon (mkTyVarTys [k, k, a, b])
@@ -1092,7 +1087,7 @@ unicodeStarKindTyCon = buildSynTyCon unicodeStarKindTyConName
(tYPE liftedRepTy)
runtimeRepTyCon :: TyCon
-runtimeRepTyCon = pcNonEnumTyCon runtimeRepTyConName Nothing []
+runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing []
(vecRepDataCon : tupleRepDataCon :
sumRepDataCon : runtimeRepSimpleDataCons)
@@ -1165,8 +1160,7 @@ liftedRepDataConTy, unliftedRepDataConTy,
= map (mkTyConTy . promoteDataCon) runtimeRepSimpleDataCons
vecCountTyCon :: TyCon
-vecCountTyCon = pcTyCon True vecCountTyConName Nothing []
- vecCountDataCons
+vecCountTyCon = pcTyCon vecCountTyConName Nothing [] vecCountDataCons
-- See Note [Wiring in RuntimeRep]
vecCountDataCons :: [DataCon]
@@ -1184,7 +1178,7 @@ vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons
vecElemTyCon :: TyCon
-vecElemTyCon = pcTyCon True vecElemTyConName Nothing [] vecElemDataCons
+vecElemTyCon = pcTyCon vecElemTyConName Nothing [] vecElemDataCons
-- See Note [Wiring in RuntimeRep]
vecElemDataCons :: [DataCon]
@@ -1249,7 +1243,7 @@ charTy :: Type
charTy = mkTyConTy charTyCon
charTyCon :: TyCon
-charTyCon = pcNonEnumTyCon charTyConName
+charTyCon = pcTyCon charTyConName
(Just (CType NoSourceText Nothing
(NoSourceText,fsLit "HsChar")))
[] [charDataCon]
@@ -1263,7 +1257,7 @@ intTy :: Type
intTy = mkTyConTy intTyCon
intTyCon :: TyCon
-intTyCon = pcNonEnumTyCon intTyConName
+intTyCon = pcTyCon intTyConName
(Just (CType NoSourceText Nothing (NoSourceText,fsLit "HsInt")))
[] [intDataCon]
intDataCon :: DataCon
@@ -1273,7 +1267,7 @@ wordTy :: Type
wordTy = mkTyConTy wordTyCon
wordTyCon :: TyCon
-wordTyCon = pcNonEnumTyCon wordTyConName
+wordTyCon = pcTyCon wordTyConName
(Just (CType NoSourceText Nothing (NoSourceText, fsLit "HsWord")))
[] [wordDataCon]
wordDataCon :: DataCon
@@ -1283,10 +1277,10 @@ word8Ty :: Type
word8Ty = mkTyConTy word8TyCon
word8TyCon :: TyCon
-word8TyCon = pcNonEnumTyCon word8TyConName
- (Just (CType NoSourceText Nothing
- (NoSourceText, fsLit "HsWord8"))) []
- [word8DataCon]
+word8TyCon = pcTyCon word8TyConName
+ (Just (CType NoSourceText Nothing
+ (NoSourceText, fsLit "HsWord8"))) []
+ [word8DataCon]
word8DataCon :: DataCon
word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon
@@ -1294,7 +1288,7 @@ floatTy :: Type
floatTy = mkTyConTy floatTyCon
floatTyCon :: TyCon
-floatTyCon = pcNonEnumTyCon floatTyConName
+floatTyCon = pcTyCon floatTyConName
(Just (CType NoSourceText Nothing
(NoSourceText, fsLit "HsFloat"))) []
[floatDataCon]
@@ -1305,7 +1299,7 @@ doubleTy :: Type
doubleTy = mkTyConTy doubleTyCon
doubleTyCon :: TyCon
-doubleTyCon = pcNonEnumTyCon doubleTyConName
+doubleTyCon = pcTyCon doubleTyConName
(Just (CType NoSourceText Nothing
(NoSourceText,fsLit "HsDouble"))) []
[doubleDataCon]
@@ -1367,7 +1361,7 @@ boolTy :: Type
boolTy = mkTyConTy boolTyCon
boolTyCon :: TyCon
-boolTyCon = pcTyCon True boolTyConName
+boolTyCon = pcTyCon boolTyConName
(Just (CType NoSourceText Nothing
(NoSourceText, fsLit "HsBool")))
[] [falseDataCon, trueDataCon]
@@ -1381,7 +1375,7 @@ falseDataConId = dataConWorkId falseDataCon
trueDataConId = dataConWorkId trueDataCon
orderingTyCon :: TyCon
-orderingTyCon = pcTyCon True orderingTyConName Nothing
+orderingTyCon = pcTyCon orderingTyConName Nothing
[] [ltDataCon, eqDataCon, gtDataCon]
ltDataCon, eqDataCon, gtDataCon :: DataCon
@@ -1410,11 +1404,12 @@ mkListTy :: Type -> Type
mkListTy ty = mkTyConApp listTyCon [ty]
listTyCon :: TyCon
-listTyCon = buildAlgTyCon listTyConName alpha_tyvar [Representational]
- Nothing []
- (DataTyCon [nilDataCon, consDataCon] False )
- False
- (VanillaAlgTyCon $ mkPrelTyConRepName listTyConName)
+listTyCon =
+ buildAlgTyCon listTyConName alpha_tyvar [Representational]
+ Nothing []
+ (mkDataTyConRhs [nilDataCon, consDataCon])
+ False
+ (VanillaAlgTyCon $ mkPrelTyConRepName listTyConName)
nilDataCon :: DataCon
nilDataCon = pcDataCon nilDataConName alpha_tyvar [] listTyCon
@@ -1431,7 +1426,7 @@ consDataCon = pcDataConWithFixity True {- Declared infix -}
-- Wired-in type Maybe
maybeTyCon :: TyCon
-maybeTyCon = pcTyCon False maybeTyConName Nothing alpha_tyvar
+maybeTyCon = pcTyCon maybeTyConName Nothing alpha_tyvar
[nothingDataCon, justDataCon]
nothingDataCon :: DataCon
@@ -1537,7 +1532,7 @@ mkPArrTy ty = mkTyConApp parrTyCon [ty]
-- @PrelPArr@.
--
parrTyCon :: TyCon
-parrTyCon = pcNonEnumTyCon parrTyConName Nothing alpha_tyvar [parrDataCon]
+parrTyCon = pcTyCon parrTyConName Nothing alpha_tyvar [parrDataCon]
parrDataCon :: DataCon
parrDataCon = pcDataCon