[Git][ghc/ghc][wip/romes/no-this-unit-id-aggressive] 2 commits: Compile Builtin/Types/Prim
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Tue Mar 7 19:53:21 UTC 2023
Rodrigo Mesquita pushed to branch wip/romes/no-this-unit-id-aggressive at Glasgow Haskell Compiler / GHC
Commits:
8ea24a2e by romes at 2023-03-07T18:54:57+00:00
Compile Builtin/Types/Prim
- - - - -
9a6aa742 by romes at 2023-03-07T19:53:10+00:00
Continue WiringIn things
- - - - -
6 changed files:
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Builtin/Types.hs-boot
- compiler/GHC/Builtin/Types/Prim.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- utils/genprimopcode/Main.hs
Changes:
=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -488,7 +488,7 @@ anyTypeOfKind kind = mkTyConApp <$> anyTyCon <*> pure [kind]
-- | Make a fake, recovery 'TyCon' from an existing one.
-- Used when recovering from errors in type declarations
-makeRecoveryTyCon :: TyCon -> TyCon
+makeRecoveryTyCon :: TyCon -> WiredIn TyCon
makeRecoveryTyCon tc
= mkTcTyCon (tyConName tc)
bndrs res_kind
@@ -548,7 +548,7 @@ pcTyCon name cType tyvars cons
(VanillaAlgTyCon (mkPrelTyConRepName name))
False -- Not in GADT syntax
-pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> WiredIn DataCon
+pcDataCon :: WiredIn Name -> [TyVar] -> [Type] -> TyCon -> WiredIn DataCon
pcDataCon n univs tys
= pcDataConWithFixity False n univs
[] -- no ex_tvs
@@ -870,7 +870,7 @@ isBuiltInOcc_maybe occ =
--
-- Test case: th/T13776
--
-isPunOcc_maybe :: Module -> OccName -> Maybe Name
+isPunOcc_maybe :: Module -> OccName -> Maybe (WiredIn Name)
isPunOcc_maybe mod occ
| mod == gHC_TYPES, occ == occName listTyConName
= Just listTyConName
@@ -907,20 +907,23 @@ mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)"
commas :: Arity -> String
commas ar = replicate (ar-1) ','
-cTupleTyCon :: Arity -> TyCon
+cTupleTyCon :: Arity -> WiredIn TyCon
cTupleTyCon i
- | i > mAX_CTUPLE_SIZE = fstOf3 (mk_ctuple i) -- Build one specially
- | otherwise = fstOf3 (cTupleArr ! i)
+ | i > mAX_CTUPLE_SIZE = fstOf3 <$> (mk_ctuple i) -- Build one specially
+ | otherwise = fstOf3 <$> (cTupleArr ! i)
-cTupleTyConName :: Arity -> Name
+cTupleTyConName :: Arity -> WiredIn Name
cTupleTyConName a = tyConName (cTupleTyCon a)
-cTupleTyConNames :: [Name]
-cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])
+cTupleTyConNames :: WiredIn [Name]
+cTupleTyConNames = sequence $ map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])
-cTupleTyConKeys :: UniqSet Unique
-cTupleTyConKeys = mkUniqSet $ map getUnique cTupleTyConNames
+cTupleTyConKeys :: WiredIn (UniqSet Unique)
+cTupleTyConKeys = mkUniqSet . map getUnique <$> cTupleTyConNames
+-- ROMES:TODO: a lot of these functions might not need to be wired in if they
+-- don't depend on the unit-id bit of the wired-in name. In which case, we can
+-- simply "run the wired-in" to get a placeholder
isCTupleTyConName :: Name -> Bool
isCTupleTyConName n
= assertPpr (isExternalName n) (ppr n) $
@@ -944,8 +947,8 @@ cTupleDataCon i
cTupleDataConName :: Arity -> WiredIn Name
cTupleDataConName i = dataConName (cTupleDataCon i)
-cTupleDataConNames :: [Name]
-cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE])
+cTupleDataConNames :: WiredIn [Name]
+cTupleDataConNames = sequence $ map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE])
cTupleSelId :: ConTag -- Superclass position
-> Arity -- Arity
@@ -1014,7 +1017,7 @@ unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mA
-- | Cached type constructors, data constructors, and superclass selectors for
-- constraint tuples. The outer array is indexed by the arity of the constraint
-- tuple and the inner array is indexed by the superclass position.
-cTupleArr :: Array Int (TyCon, DataCon, Array Int Id)
+cTupleArr :: Array Int (WiredIn (TyCon, DataCon, Array Int Id))
cTupleArr = listArray (0,mAX_CTUPLE_SIZE) [mk_ctuple i | i <- [0..mAX_CTUPLE_SIZE]]
-- Although GHC does not make use of unary constraint tuples
-- (see Note [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType),
@@ -1125,31 +1128,31 @@ mk_ctuple arity = (tycon, tuple_con, sc_sel_ids_arr)
in sc_sel_id
-unitTyCon :: TyCon
+unitTyCon :: WiredIn TyCon
unitTyCon = tupleTyCon Boxed 0
-unitTyConKey :: Unique
-unitTyConKey = getUnique unitTyCon
+unitTyConKey :: WiredIn Unique
+unitTyConKey = getUnique <$> unitTyCon
-unitDataCon :: DataCon
-unitDataCon = head (tyConDataCons unitTyCon)
+unitDataCon :: WiredIn DataCon
+unitDataCon = head . tyConDataCons <$> unitTyCon
-unitDataConId :: Id
-unitDataConId = dataConWorkId unitDataCon
+unitDataConId :: WiredIn Id
+unitDataConId = dataConWorkId <$> unitDataCon
-soloTyCon :: TyCon
+soloTyCon :: WiredIn TyCon
soloTyCon = tupleTyCon Boxed 1
-pairTyCon :: TyCon
+pairTyCon :: WiredIn TyCon
pairTyCon = tupleTyCon Boxed 2
-unboxedUnitTy :: Type
-unboxedUnitTy = mkTyConTy unboxedUnitTyCon
+unboxedUnitTy :: WiredIn Type
+unboxedUnitTy = mkTyConTy <$> unboxedUnitTyCon
-unboxedUnitTyCon :: TyCon
+unboxedUnitTyCon :: WiredIn TyCon
unboxedUnitTyCon = tupleTyCon Unboxed 0
-unboxedUnitDataCon :: DataCon
+unboxedUnitDataCon :: WiredIn DataCon
unboxedUnitDataCon = tupleDataCon Unboxed 0
{- *********************************************************************
@@ -1189,7 +1192,7 @@ sumTyCon arity
-- | Data constructor for i-th alternative of a n-ary unboxed sum.
sumDataCon :: ConTag -- Alternative
-> Arity -- Arity
- -> DataCon
+ -> WiredIn DataCon
sumDataCon alt arity
| alt > arity
= panic ("sumDataCon: index out of bounds: alt: "
@@ -1212,11 +1215,11 @@ sumDataCon alt arity
-- | Cached type and data constructors for sums. The outer array is
-- indexed by the arity of the sum and the inner array is indexed by
-- the alternative.
-unboxedSumArr :: Array Int (TyCon, Array Int DataCon)
+unboxedSumArr :: Array Int (WiredIn (TyCon, Array Int DataCon))
unboxedSumArr = listArray (2,mAX_SUM_SIZE) [mk_sum i | i <- [2..mAX_SUM_SIZE]]
-- | Specialization of 'unboxedTupleSumKind' for sums
-unboxedSumKind :: [Type] -> Kind
+unboxedSumKind :: [Type] -> WiredIn Kind
unboxedSumKind = unboxedTupleSumKind sumRepDataConTyCon
-- | Create type constructor and data constructors for n-ary unboxed sum.
@@ -1268,10 +1271,10 @@ mk_sum arity = (tycon, sum_cons)
-- necessary because the functional-dependency coverage check looks
-- through superclasses, and (~#) is handled in that check.
-eqTyCon, heqTyCon, coercibleTyCon :: TyCon
-eqClass, heqClass, coercibleClass :: Class
-eqDataCon, heqDataCon, coercibleDataCon :: DataCon
-eqSCSelId, heqSCSelId, coercibleSCSelId :: Id
+eqTyCon, heqTyCon, coercibleTyCon :: WiredIn TyCon
+eqClass, heqClass, coercibleClass :: WiredIn Class
+eqDataCon, heqDataCon, coercibleDataCon :: WiredIn DataCon
+eqSCSelId, heqSCSelId, coercibleSCSelId :: WiredIn Id
(eqTyCon, eqClass, eqDataCon, eqSCSelId)
= (tycon, klass, datacon, sc_sel_id)
@@ -1365,23 +1368,23 @@ multiplicityTyCon :: WiredIn TyCon
multiplicityTyCon = pcTyCon multiplicityTyConName Nothing []
[oneDataCon, manyDataCon]
-oneDataCon, manyDataCon :: DataCon
+oneDataCon, manyDataCon :: WiredIn DataCon
oneDataCon = pcDataCon oneDataConName [] [] multiplicityTyCon
manyDataCon = pcDataCon manyDataConName [] [] multiplicityTyCon
-oneDataConTy, manyDataConTy :: Type
-oneDataConTy = mkTyConTy oneDataConTyCon
-manyDataConTy = mkTyConTy manyDataConTyCon
+oneDataConTy, manyDataConTy :: WiredIn Type
+oneDataConTy = mkTyConTy <$> oneDataConTyCon
+manyDataConTy = mkTyConTy <$> manyDataConTyCon
-oneDataConTyCon, manyDataConTyCon :: TyCon
-oneDataConTyCon = promoteDataCon oneDataCon
-manyDataConTyCon = promoteDataCon manyDataCon
+oneDataConTyCon, manyDataConTyCon :: WiredIn TyCon
+oneDataConTyCon = promoteDataCon <$> oneDataCon
+manyDataConTyCon = promoteDataCon <$> manyDataCon
multMulTyConName :: WiredIn Name
multMulTyConName =
mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "MultMul") multMulTyConKey multMulTyCon
-multMulTyCon :: TyCon
+multMulTyCon :: WiredIn TyCon
multMulTyCon = mkFamilyTyCon multMulTyConName binders multiplicityTy Nothing
(BuiltInSynFamTyCon trivialBuiltInFamily)
Nothing
@@ -1393,7 +1396,7 @@ multMulTyCon = mkFamilyTyCon multMulTyConName binders multiplicityTy Nothing
-- type (->) :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).
-- TYPE rep1 -> TYPE rep2 -> Type
-- type (->) = FUN 'Many
-unrestrictedFunTyCon :: TyCon
+unrestrictedFunTyCon :: WiredIn TyCon
unrestrictedFunTyCon
= buildSynTyCon unrestrictedFunTyConName [] arrowKind []
(TyCoRep.TyConApp fUNTyCon [manyDataConTy])
@@ -1477,7 +1480,7 @@ typeToTypeKind = liftA2 mkVisFunTyMany liftedTypeKind liftedTypeKind
----------------------
-- type UnliftedType = TYPE ('BoxedRep 'Unlifted)
-unliftedTypeKindTyCon :: TyCon
+unliftedTypeKindTyCon :: WiredIn TyCon
unliftedTypeKindTyCon
= buildSynTyCon unliftedTypeKindTyConName [] liftedTypeKind [] rhs
where
@@ -1487,8 +1490,8 @@ unliftedTypeKindTyConName :: WiredIn Name
unliftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnliftedType")
unliftedTypeKindTyConKey unliftedTypeKindTyCon
-unliftedTypeKind :: Type
-unliftedTypeKind = mkTyConTy unliftedTypeKindTyCon
+unliftedTypeKind :: WiredIn Type
+unliftedTypeKind = mkTyConTy <$> unliftedTypeKindTyCon
{- *********************************************************************
@@ -1508,23 +1511,23 @@ levityTyCon = pcTyCon levityTyConName Nothing [] [liftedDataCon,unliftedDataCon]
levityTy :: WiredIn Type
levityTy = mkTyConTy <$> levityTyCon
-liftedDataCon, unliftedDataCon :: DataCon
+liftedDataCon, unliftedDataCon :: WiredIn DataCon
liftedDataCon = pcSpecialDataCon liftedDataConName
[] levityTyCon (Levity Lifted)
unliftedDataCon = pcSpecialDataCon unliftedDataConName
[] levityTyCon (Levity Unlifted)
-liftedDataConTyCon :: TyCon
-liftedDataConTyCon = promoteDataCon liftedDataCon
+liftedDataConTyCon :: WiredIn TyCon
+liftedDataConTyCon = promoteDataCon <$> liftedDataCon
-unliftedDataConTyCon :: TyCon
-unliftedDataConTyCon = promoteDataCon unliftedDataCon
+unliftedDataConTyCon :: WiredIn TyCon
+unliftedDataConTyCon = promoteDataCon <$> unliftedDataCon
-liftedDataConTy :: Type
-liftedDataConTy = mkTyConTy liftedDataConTyCon
+liftedDataConTy :: WiredIn Type
+liftedDataConTy = mkTyConTy <$> liftedDataConTyCon
-unliftedDataConTy :: Type
-unliftedDataConTy = mkTyConTy unliftedDataConTyCon
+unliftedDataConTy :: WiredIn Type
+unliftedDataConTy = mkTyConTy <$> unliftedDataConTyCon
{- *********************************************************************
@@ -1572,7 +1575,7 @@ boxedRepDataConName = mk_runtime_rep_dc_name (fsLit "BoxedRep") boxedRepDataConK
mk_runtime_rep_dc_name :: FastString -> Unique -> DataCon -> WiredIn Name
mk_runtime_rep_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc
-boxedRepDataCon :: DataCon
+boxedRepDataCon :: WiredIn DataCon
boxedRepDataCon = pcSpecialDataCon boxedRepDataConName
[ levityTy ] runtimeRepTyCon (RuntimeRep prim_rep_fun)
where
@@ -1586,10 +1589,10 @@ boxedRepDataCon = pcSpecialDataCon boxedRepDataConName
= pprPanic "boxedRepDataCon" (ppr args)
-boxedRepDataConTyCon :: TyCon
-boxedRepDataConTyCon = promoteDataCon boxedRepDataCon
+boxedRepDataConTyCon :: WiredIn TyCon
+boxedRepDataConTyCon = promoteDataCon <$> boxedRepDataCon
-tupleRepDataCon :: DataCon
+tupleRepDataCon :: WiredIn DataCon
tupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ]
runtimeRepTyCon (RuntimeRep prim_rep_fun)
where
@@ -1602,10 +1605,10 @@ tupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ]
prim_rep_fun args
= pprPanic "tupleRepDataCon" (ppr args)
-tupleRepDataConTyCon :: TyCon
-tupleRepDataConTyCon = promoteDataCon tupleRepDataCon
+tupleRepDataConTyCon :: WiredIn TyCon
+tupleRepDataConTyCon = promoteDataCon <$> tupleRepDataCon
-sumRepDataCon :: DataCon
+sumRepDataCon :: WiredIn DataCon
sumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ]
runtimeRepTyCon (RuntimeRep prim_rep_fun)
where
@@ -1619,12 +1622,12 @@ sumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ]
prim_rep_fun args
= pprPanic "sumRepDataCon" (ppr args)
-sumRepDataConTyCon :: TyCon
-sumRepDataConTyCon = promoteDataCon sumRepDataCon
+sumRepDataConTyCon :: WiredIn TyCon
+sumRepDataConTyCon = promoteDataCon <$> sumRepDataCon
-- See Note [Wiring in RuntimeRep]
-- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType
-runtimeRepSimpleDataCons :: [DataCon]
+runtimeRepSimpleDataCons :: WiredIn [DataCon]
runtimeRepSimpleDataCons
= zipWith mk_runtime_rep_dc runtimeRepSimpleDataConKeys
[ (fsLit "IntRep", IntRep)
@@ -1641,7 +1644,7 @@ runtimeRepSimpleDataCons
, (fsLit "FloatRep", FloatRep)
, (fsLit "DoubleRep", DoubleRep) ]
where
- mk_runtime_rep_dc :: Unique -> (FastString, PrimRep) -> DataCon
+ mk_runtime_rep_dc :: Unique -> (FastString, PrimRep) -> WiredIn DataCon
mk_runtime_rep_dc uniq (fs, primrep)
= data_con
where
@@ -1654,7 +1657,7 @@ intRepDataConTy,
wordRepDataConTy,
word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,
addrRepDataConTy,
- floatRepDataConTy, doubleRepDataConTy :: RuntimeRepType
+ floatRepDataConTy, doubleRepDataConTy :: WiredIn RuntimeRepType
[intRepDataConTy,
int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,
wordRepDataConTy,
@@ -1666,7 +1669,7 @@ intRepDataConTy,
----------------------
-- | @type ZeroBitRep = 'Tuple '[]
-zeroBitRepTyCon :: TyCon
+zeroBitRepTyCon :: WiredIn TyCon
zeroBitRepTyCon
= buildSynTyCon zeroBitRepTyConName [] runtimeRepTy [] rhs
where
@@ -1676,12 +1679,12 @@ zeroBitRepTyConName :: WiredIn Name
zeroBitRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZeroBitRep")
zeroBitRepTyConKey zeroBitRepTyCon
-zeroBitRepTy :: RuntimeRepType
-zeroBitRepTy = mkTyConTy zeroBitRepTyCon
+zeroBitRepTy :: WiredIn RuntimeRepType
+zeroBitRepTy = mkTyConTy <$> zeroBitRepTyCon
----------------------
-- @type ZeroBitType = TYPE ZeroBitRep
-zeroBitTypeTyCon :: TyCon
+zeroBitTypeTyCon :: WiredIn TyCon
zeroBitTypeTyCon
= buildSynTyCon zeroBitTypeTyConName [] liftedTypeKind [] rhs
where
@@ -1691,12 +1694,12 @@ zeroBitTypeTyConName :: WiredIn Name
zeroBitTypeTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "ZeroBitType")
zeroBitTypeTyConKey zeroBitTypeTyCon
-zeroBitTypeKind :: Type
-zeroBitTypeKind = mkTyConTy zeroBitTypeTyCon
+zeroBitTypeKind :: WiredIn Type
+zeroBitTypeKind = mkTyConTy <$> zeroBitTypeTyCon
----------------------
-- | @type LiftedRep = 'BoxedRep 'Lifted@
-liftedRepTyCon :: TyCon
+liftedRepTyCon :: WiredIn TyCon
liftedRepTyCon
= buildSynTyCon liftedRepTyConName [] runtimeRepTy [] rhs
where
@@ -1706,12 +1709,12 @@ liftedRepTyConName :: WiredIn Name
liftedRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "LiftedRep")
liftedRepTyConKey liftedRepTyCon
-liftedRepTy :: RuntimeRepType
-liftedRepTy = mkTyConTy liftedRepTyCon
+liftedRepTy :: WiredIn RuntimeRepType
+liftedRepTy = mkTyConTy <$> liftedRepTyCon
----------------------
-- | @type UnliftedRep = 'BoxedRep 'Unlifted@
-unliftedRepTyCon :: TyCon
+unliftedRepTyCon :: WiredIn TyCon
unliftedRepTyCon
= buildSynTyCon unliftedRepTyConName [] runtimeRepTy [] rhs
where
@@ -1721,8 +1724,8 @@ unliftedRepTyConName :: WiredIn Name
unliftedRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "UnliftedRep")
unliftedRepTyConKey unliftedRepTyCon
-unliftedRepTy :: RuntimeRepType
-unliftedRepTy = mkTyConTy unliftedRepTyCon
+unliftedRepTy :: WiredIn RuntimeRepType
+unliftedRepTy = mkTyConTy <$> unliftedRepTyCon
{- *********************************************************************
@@ -1737,7 +1740,7 @@ vecCountTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecCount") v
vecElemTyConName :: WiredIn Name
vecElemTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecElem") vecElemTyConKey vecElemTyCon
-vecRepDataCon :: DataCon
+vecRepDataCon :: WiredIn DataCon
vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon
, mkTyConTy vecElemTyCon ]
runtimeRepTyCon
@@ -1751,14 +1754,14 @@ vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon
prim_rep_fun args
= pprPanic "vecRepDataCon" (ppr args)
-vecRepDataConTyCon :: TyCon
-vecRepDataConTyCon = promoteDataCon vecRepDataCon
+vecRepDataConTyCon :: WiredIn TyCon
+vecRepDataConTyCon = promoteDataCon <$> vecRepDataCon
vecCountTyCon :: WiredIn TyCon
vecCountTyCon = pcTyCon vecCountTyConName Nothing [] vecCountDataCons
-- See Note [Wiring in RuntimeRep]
-vecCountDataCons :: [DataCon]
+vecCountDataCons :: WiredIn [DataCon]
vecCountDataCons = zipWith mk_vec_count_dc [1..6] vecCountDataConKeys
where
mk_vec_count_dc logN key = con
@@ -1769,7 +1772,7 @@ vecCountDataCons = zipWith mk_vec_count_dc [1..6] vecCountDataConKeys
-- See Note [Wiring in RuntimeRep]
vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
- vec64DataConTy :: Type
+ vec64DataConTy :: WiredIn Type
[vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons
@@ -1777,7 +1780,8 @@ vecElemTyCon :: WiredIn TyCon
vecElemTyCon = pcTyCon vecElemTyConName Nothing [] vecElemDataCons
-- See Note [Wiring in RuntimeRep]
-vecElemDataCons :: [DataCon]
+-- ROMES:TODO: Better to just get rid of the lists bc of 'WiredIn'
+vecElemDataCons :: WiredIn [DataCon]
vecElemDataCons = zipWith3 mk_vec_elem_dc
[ fsLit "Int8ElemRep", fsLit "Int16ElemRep", fsLit "Int32ElemRep", fsLit "Int64ElemRep"
, fsLit "Word8ElemRep", fsLit "Word16ElemRep", fsLit "Word32ElemRep", fsLit "Word64ElemRep"
@@ -1796,7 +1800,7 @@ vecElemDataCons = zipWith3 mk_vec_elem_dc
int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
- doubleElemRepDataConTy :: Type
+ doubleElemRepDataConTy :: WiredIn Type
[int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
@@ -1817,13 +1821,13 @@ charTyCon = pcTyCon charTyConName
(Just (CType NoSourceText Nothing
(NoSourceText,fsLit "HsChar")))
[] [charDataCon]
-charDataCon :: DataCon
+charDataCon :: WiredIn DataCon
charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon
-stringTy :: Type
-stringTy = mkTyConTy stringTyCon
+stringTy :: WiredIn Type
+stringTy = mkTyConTy <$> stringTyCon
-stringTyCon :: TyCon
+stringTyCon :: WiredIn TyCon
-- We have this wired-in so that Haskell literal strings
-- get type String (in hsLitType), which in turn influences
-- inferred types and error messages
@@ -1838,7 +1842,7 @@ intTyCon :: WiredIn TyCon
intTyCon = pcTyCon intTyConName
(Just (CType NoSourceText Nothing (NoSourceText,fsLit "HsInt")))
[] [intDataCon]
-intDataCon :: DataCon
+intDataCon :: WiredIn DataCon
intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon
wordTy :: WiredIn Type
@@ -1848,7 +1852,7 @@ wordTyCon :: WiredIn TyCon
wordTyCon = pcTyCon wordTyConName
(Just (CType NoSourceText Nothing (NoSourceText, fsLit "HsWord")))
[] [wordDataCon]
-wordDataCon :: DataCon
+wordDataCon :: WiredIn DataCon
wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon
word8Ty :: WiredIn Type
@@ -1859,7 +1863,7 @@ word8TyCon = pcTyCon word8TyConName
(Just (CType NoSourceText Nothing
(NoSourceText, fsLit "HsWord8"))) []
[word8DataCon]
-word8DataCon :: DataCon
+word8DataCon :: WiredIn DataCon
word8DataCon = pcDataCon word8DataConName [] [word8PrimTy] word8TyCon
floatTy :: WiredIn Type
@@ -1870,8 +1874,8 @@ floatTyCon = pcTyCon floatTyConName
(Just (CType NoSourceText Nothing
(NoSourceText, fsLit "HsFloat"))) []
[floatDataCon]
-floatDataCon :: DataCon
-floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon
+floatDataCon :: WiredIn DataCon
+floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon
doubleTy :: WiredIn Type
doubleTy = mkTyConTy <$> doubleTyCon
@@ -1882,7 +1886,7 @@ doubleTyCon = pcTyCon doubleTyConName
(NoSourceText,fsLit "HsDouble"))) []
[doubleDataCon]
-doubleDataCon :: DataCon
+doubleDataCon :: WiredIn DataCon
doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon
{- *********************************************************************
=====================================
compiler/GHC/Builtin/Types.hs-boot
=====================================
@@ -67,7 +67,7 @@ multMulTyCon :: TyCon
tupleTyConName :: TupleSort -> Arity -> Name
tupleDataConName :: Boxity -> Arity -> Name
-integerTy, naturalTy :: Type
+integerTy, naturalTy :: WiredIn Type
promotedTupleDataCon :: Boxity -> Arity -> WiredIn TyCon
=====================================
compiler/GHC/Builtin/Types/Prim.hs
=====================================
@@ -462,40 +462,53 @@ mkTemplateAnonTyConBindersFrom n kinds
alphaTyVars :: WiredIn [TyVar]
alphaTyVars = mkTemplateTyVars <$> sequence (repeat liftedTypeKind)
-alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: TyVar
-(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
-
-alphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec, deltaTyVarSpec :: TyVarBinder
-(alphaTyVarSpec:betaTyVarSpec:gammaTyVarSpec:deltaTyVarSpec:_) = mkTyVarBinders Specified alphaTyVars
-
-alphaConstraintTyVars :: [TyVar]
-alphaConstraintTyVars = mkTemplateTyVars $ repeat constraintKind
-
-alphaConstraintTyVar :: TyVar
-(alphaConstraintTyVar:_) = alphaConstraintTyVars
-
-alphaConstraintTy :: Type
-alphaConstraintTy = mkTyVarTy alphaConstraintTyVar
-
-alphaTys :: [Type]
-alphaTys = mkTyVarTys alphaTyVars
-alphaTy, betaTy, gammaTy, deltaTy :: Type
-(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
-
-alphaTyVarsUnliftedRep :: [TyVar]
-alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat unliftedTypeKind
-
-alphaTyVarUnliftedRep :: TyVar
-(alphaTyVarUnliftedRep:_) = alphaTyVarsUnliftedRep
-
-alphaTysUnliftedRep :: [Type]
-alphaTysUnliftedRep = mkTyVarTys alphaTyVarsUnliftedRep
-alphaTyUnliftedRep :: Type
-(alphaTyUnliftedRep:_) = alphaTysUnliftedRep
+alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: WiredIn TyVar
+alphaTyVar = (\case (alphaTyVar:_betaTyVar:_gammaTyVar:_deltaTyVar:_) -> alphaTyVar) <$> alphaTyVars
+betaTyVar = (\case (_alphaTyVar:betaTyVar:_gammaTyVar:_deltaTyVar:_) -> betaTyVar) <$> alphaTyVars
+gammaTyVar = (\case (_alphaTyVar:_betaTyVar:gammaTyVar:_deltaTyVar:_) -> gammaTyVar) <$> alphaTyVars
+deltaTyVar = (\case (_alphaTyVar:_betaTyVar:_gammaTyVar:deltaTyVar:_) -> deltaTyVar) <$> alphaTyVars
+
+alphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec, deltaTyVarSpec :: WiredIn TyVarBinder
+alphaTyVarSpec = (\case (alphaTyVarSpec:_betaTyVarSpec:_gammaTyVarSpec:_deltaTyVarSpec:_) -> alphaTyVarSpec) . mkTyVarBinders Specified <$> alphaTyVars
+betaTyVarSpec = (\case (_alphaTyVarSpec:betaTyVarSpec:_gammaTyVarSpec:_deltaTyVarSpec:_) -> betaTyVarSpec) . mkTyVarBinders Specified <$> alphaTyVars
+gammaTyVarSpec = (\case (_alphaTyVarSpec:_betaTyVarSpec:gammaTyVarSpec:_deltaTyVarSpec:_) -> gammaTyVarSpec) . mkTyVarBinders Specified <$> alphaTyVars
+deltaTyVarSpec = (\case (_alphaTyVarSpec:_betaTyVarSpec:_gammaTyVarSpec:deltaTyVarSpec:_) -> deltaTyVarSpec) . mkTyVarBinders Specified <$> alphaTyVars
+
+alphaConstraintTyVars :: WiredIn [TyVar]
+alphaConstraintTyVars = mkTemplateTyVars <$> sequence (repeat constraintKind)
+
+alphaConstraintTyVar :: WiredIn TyVar
+alphaConstraintTyVar = (\case (alphaConstraintTyVar:_) -> alphaConstraintTyVar) <$> alphaConstraintTyVars
+
+alphaConstraintTy :: WiredIn Type
+alphaConstraintTy = mkTyVarTy <$> alphaConstraintTyVar
+
+alphaTys :: WiredIn [Type]
+alphaTys = mkTyVarTys <$> alphaTyVars
+alphaTy, betaTy, gammaTy, deltaTy :: WiredIn Type
+alphaTy = (\case (alphaTy:_betaTy:_gammaTy:_deltaTy:_) -> alphaTy) <$> alphaTys
+betaTy = (\case (_alphaTy:betaTy:_gammaTy:_deltaTy:_) -> betaTy) <$> alphaTys
+gammaTy = (\case (_alphaTy:_betaTy:gammaTy:_deltaTy:_) -> gammaTy) <$> alphaTys
+deltaTy = (\case (_alphaTy:_betaTy:_gammaTy:deltaTy:_) -> deltaTy) <$> alphaTys
+
+alphaTyVarsUnliftedRep :: WiredIn [TyVar]
+alphaTyVarsUnliftedRep = mkTemplateTyVars <$> sequence (repeat unliftedTypeKind)
+
+alphaTyVarUnliftedRep :: WiredIn TyVar
+alphaTyVarUnliftedRep = (\case (alphaTyVarUnliftedRep:_) -> alphaTyVarUnliftedRep) <$> alphaTyVarsUnliftedRep
+
+alphaTysUnliftedRep :: WiredIn [Type]
+alphaTysUnliftedRep = mkTyVarTys <$> alphaTyVarsUnliftedRep
+alphaTyUnliftedRep :: WiredIn Type
+alphaTyUnliftedRep = (\case (alphaTyUnliftedRep:_) -> alphaTyUnliftedRep) <$> alphaTysUnliftedRep
runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar :: WiredIn TyVar
-(runtimeRep1TyVar : runtimeRep2TyVar : runtimeRep3TyVar : _)
- = drop 16 . mkTemplateTyVars <$> sequence (repeat runtimeRepTy) -- selects 'q','r'
+runtimeRep1TyVar = (\case (runtimeRep1TyVar : _runtimeRep2TyVar : _runtimeRep3TyVar : _) -> runtimeRep1TyVar) <$> runtimeRepTyVars
+runtimeRep2TyVar = (\case (_runtimeRep1TyVar : runtimeRep2TyVar : _runtimeRep3TyVar : _) -> runtimeRep2TyVar) <$> runtimeRepTyVars
+runtimeRep3TyVar = (\case (_runtimeRep1TyVar : _runtimeRep2TyVar : runtimeRep3TyVar : _) -> runtimeRep3TyVar) <$> runtimeRepTyVars
+
+runtimeRepTyVars :: WiredIn [TyVar]
+runtimeRepTyVars = drop 16 . mkTemplateTyVars <$> sequence (repeat runtimeRepTy) -- selects 'q','r'
runtimeRep1TyVarInf, runtimeRep2TyVarInf :: WiredIn TyVarBinder
runtimeRep1TyVarInf = mkTyVarBinder Inferred <$> runtimeRep1TyVar
@@ -528,9 +541,12 @@ openAlphaTy = mkTyVarTy <$> openAlphaTyVar
openBetaTy = mkTyVarTy <$> openBetaTyVar
openGammaTy = mkTyVarTy <$> openGammaTyVar
+levityTyVars :: WiredIn [TyVar]
+levityTyVars = drop 10 . mkTemplateTyVars <$> sequence (repeat levityTy) -- selects 'k', 'l'
levity1TyVar, levity2TyVar :: WiredIn TyVar
-(levity2TyVar : levity1TyVar : _) -- NB: levity2TyVar before levity1TyVar
- = drop 10 . mkTemplateTyVars <$> sequence (repeat levityTy) -- selects 'k', 'l'
+-- NB: levity2TyVar before levity1TyVar
+levity2TyVar = (\case (levity2TyVar : _levity1TyVar : _) -> levity2TyVar) <$> levityTyVars
+levity1TyVar = (\case (_levity2TyVar : levity1TyVar : _) -> levity1TyVar) <$> levityTyVars
-- The ordering of levity2TyVar before levity1TyVar is chosen so that
-- the more common levity1TyVar uses the levity variable 'l'.
@@ -561,9 +577,12 @@ levPolyAlphaTy, levPolyBetaTy :: WiredIn Type
levPolyAlphaTy = mkTyVarTy <$> levPolyAlphaTyVar
levPolyBetaTy = mkTyVarTy <$> levPolyBetaTyVar
-multiplicityTyVar1, multiplicityTyVar2 :: WiredIn TyVar
-(multiplicityTyVar1 : multiplicityTyVar2 : _)
+multiplicityTyVars :: WiredIn [TyVar]
+multiplicityTyVars
= drop 13 . mkTemplateTyVars <$> sequence (repeat multiplicityTy) -- selects 'n', 'm'
+multiplicityTyVar1, multiplicityTyVar2 :: WiredIn TyVar
+multiplicityTyVar1 = (\case (multiplicityTyVar1 : _multiplicityTyVar2 : _) -> multiplicityTyVar1) <$> multiplicityTyVars
+multiplicityTyVar2 = (\case (_multiplicityTyVar1 : multiplicityTyVar2 : _) -> multiplicityTyVar2) <$> multiplicityTyVars
{-
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -1794,11 +1794,15 @@ mkAlgTyCon name binders res_kind roles cType stupid rhs parent gadt_syn
, algTcGadtSyntax = gadt_syn }
-- | Simpler specialization of 'mkAlgTyCon' for classes
+-- ROMES:TODO: Comment Core with "Why WiredIn".
+-- Even consider moving out of Core?
+-- Classes are wired in
mkClassTyCon :: Name -> [TyConBinder]
-> [Role] -> AlgTyConRhs -> Class
- -> Name -> TyCon
+ -> Name -> WiredIn TyCon
mkClassTyCon name binders roles rhs clas tc_rep_name
- = mkAlgTyCon name binders constraintKind roles Nothing [] rhs
+ = constraintKind >>= \wiredConstraintKind -> pure $
+ mkAlgTyCon name binders wiredConstraintKind roles Nothing [] rhs
(ClassTyCon clas tc_rep_name)
False
@@ -1873,13 +1877,14 @@ mkPrimTyCon :: WiredIn Name
-- change tcHasFixedRuntimeRep, marshalablePrimTyCon, reifyTyCon for PrimTyCons.)
-> [Role]
-> WiredIn TyCon
-mkPrimTyCon name' binders res_kind' roles
- = name' >>= \name ->
- res_kind' >>= \res_kind ->
- mkPrelTyConRepName name >>= \prelTyConRepName ->
- pure $
- mkTyCon name binders res_kind roles $
- PrimTyCon { primRepName = prelTyConRepName }
+mkPrimTyCon name' binders' res_kind' roles
+ = do name <- name'
+ binders <- binders'
+ res_kind <- res_kind'
+ prelTyConRepName <- mkPrelTyConRepName name
+ pure $
+ mkTyCon name binders res_kind roles $
+ PrimTyCon { primRepName = prelTyConRepName }
-- | Create a type synonym 'TyCon'
mkSynonymTyCon :: Name -> [TyConBinder] -> Kind -- ^ /result/ kind
@@ -2278,17 +2283,20 @@ isDataKindsPromotedDataCon (TyCon { tyConDetails = details })
-- | Is this tycon really meant for use at the kind level? That is,
-- should it be permitted without -XDataKinds?
-isKindTyCon :: TyCon -> Bool
-isKindTyCon tc = getUnique tc `elementOfUniqSet` kindTyConKeys
+isKindTyCon :: TyCon -> WiredIn Bool
+isKindTyCon tc = (getUnique tc `elementOfUniqSet`) <$> kindTyConKeys
-- | These TyCons should be allowed at the kind level, even without
-- -XDataKinds.
-kindTyConKeys :: UniqSet Unique
-kindTyConKeys = unionManyUniqSets
- ( mkUniqSet [ liftedTypeKindTyConKey, liftedRepTyConKey, constraintKindTyConKey, tYPETyConKey ]
- : map (mkUniqSet . tycon_with_datacons) [ runtimeRepTyCon, levityTyCon
- , multiplicityTyCon
- , vecCountTyCon, vecElemTyCon ] )
+-- ROMES:TODO: WiredIn UniqSet of WiredIn things
+kindTyConKeys :: WiredIn (UniqSet Unique)
+kindTyConKeys = do
+ tyCons <- sequence [ runtimeRepTyCon, levityTyCon
+ , multiplicityTyCon
+ , vecCountTyCon, vecElemTyCon ]
+ pure $ unionManyUniqSets
+ ( mkUniqSet [ liftedTypeKindTyConKey, liftedRepTyConKey, constraintKindTyConKey, tYPETyConKey ]
+ : map (mkUniqSet . tycon_with_datacons) tyCons )
where
tycon_with_datacons tc = getUnique tc : map getUnique (tyConDataCons tc)
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -3245,13 +3245,13 @@ coreView applied to (TyConApp LiftedRep [])
-}
-mkTYPEapp :: RuntimeRepType -> Type
+mkTYPEapp :: RuntimeRepType -> WiredIn Type
mkTYPEapp rr
= case mkTYPEapp_maybe rr of
Just ty -> ty
Nothing -> TyConApp tYPETyCon [rr]
-mkTYPEapp_maybe :: RuntimeRepType -> Maybe Type
+mkTYPEapp_maybe :: RuntimeRepType -> Maybe (WiredIn Type)
-- ^ Given a @RuntimeRep@, applies @TYPE@ to it.
-- On the fly it rewrites
-- TYPE LiftedRep --> liftedTypeKind (a synonym)
@@ -3273,14 +3273,14 @@ mkTYPEapp_maybe (TyConApp tc args)
mkTYPEapp_maybe _ = Nothing
------------------
-mkCONSTRAINTapp :: RuntimeRepType -> Type
+mkCONSTRAINTapp :: RuntimeRepType -> WiredIn Type
-- ^ Just like mkTYPEapp
mkCONSTRAINTapp rr
= case mkCONSTRAINTapp_maybe rr of
Just ty -> ty
Nothing -> TyConApp cONSTRAINTTyCon [rr]
-mkCONSTRAINTapp_maybe :: RuntimeRepType -> Maybe Type
+mkCONSTRAINTapp_maybe :: RuntimeRepType -> Maybe (WiredIn Type)
-- ^ Just like mkTYPEapp_maybe
{-# NOINLINE mkCONSTRAINTapp_maybe #-}
mkCONSTRAINTapp_maybe (TyConApp tc args)
@@ -3289,7 +3289,7 @@ mkCONSTRAINTapp_maybe (TyConApp tc args)
mkCONSTRAINTapp_maybe _ = Nothing
------------------
-mkBoxedRepApp_maybe :: LevityType -> Maybe Type
+mkBoxedRepApp_maybe :: LevityType -> Maybe (WiredIn Type)
-- ^ Given a `Levity`, apply `BoxedRep` to it
-- On the fly, rewrite
-- BoxedRep Lifted --> liftedRepTy (a synonym)
@@ -3317,6 +3317,6 @@ mkTupleRepApp_maybe (TyConApp tc args)
key = tyConUnique tc
mkTupleRepApp_maybe _ = Nothing
-typeOrConstraintKind :: TypeOrConstraint -> RuntimeRepType -> Kind
+typeOrConstraintKind :: TypeOrConstraint -> RuntimeRepType -> WiredIn Kind
typeOrConstraintKind TypeLike rep = mkTYPEapp rep
typeOrConstraintKind ConstraintLike rep = mkCONSTRAINTapp rep
=====================================
utils/genprimopcode/Main.hs
=====================================
@@ -537,8 +537,8 @@ gen_primop_vector_tys (Info _ entries)
, ty_id ++ " :: WiredIn Type"
, ty_id ++ " = mkTyConTy <$> " ++ tycon_id
, tycon_id ++ " :: WiredIn TyCon"
- , tycon_id ++ " = flip pcPrimTyCon0 " ++
- " (TyConApp vecRepDataConTyCon [vec" ++ show (veclen i) ++ "DataConTy, " ++ elemrep i ++ "]) =<< " ++ name_id
+ , tycon_id ++ " = pcPrimTyCon0 " ++ name_id ++
+ " (TyConApp <$> vecRepDataConTyCon <*> sequence [vec" ++ show (veclen i) ++ "DataConTy, " ++ elemrep i ++ "])"
]
where
key_id = prefix i ++ "PrimTyConKey"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d7a0725af1ff8edd3ed2b82d076a14bccb13222...9a6aa7422e3685652a3643c96bec255b7b19ba24
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d7a0725af1ff8edd3ed2b82d076a14bccb13222...9a6aa7422e3685652a3643c96bec255b7b19ba24
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/20230307/bcce9be4/attachment-0001.html>
More information about the ghc-commits
mailing list