summaryrefslogtreecommitdiff
path: root/compiler/prelude
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/prelude')
-rw-r--r--compiler/prelude/PrelNames.hs38
-rw-r--r--compiler/prelude/PrimOp.hs2
-rw-r--r--compiler/prelude/TysPrim.hs192
-rw-r--r--compiler/prelude/TysWiredIn.hs267
-rw-r--r--compiler/prelude/TysWiredIn.hs-boot22
5 files changed, 379 insertions, 142 deletions
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 5c2984be2a..068f276d05 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -1617,15 +1617,18 @@ eitherTyConKey = mkPreludeTyConUnique 84
-- Kind constructors
liftedTypeKindTyConKey, tYPETyConKey,
- unliftedTypeKindTyConKey, constraintKindTyConKey, levityTyConKey,
- starKindTyConKey, unicodeStarKindTyConKey :: Unique
+ unliftedTypeKindTyConKey, constraintKindTyConKey,
+ starKindTyConKey, unicodeStarKindTyConKey, runtimeRepTyConKey,
+ vecCountTyConKey, vecElemTyConKey :: Unique
liftedTypeKindTyConKey = mkPreludeTyConUnique 87
tYPETyConKey = mkPreludeTyConUnique 88
unliftedTypeKindTyConKey = mkPreludeTyConUnique 89
-levityTyConKey = mkPreludeTyConUnique 90
constraintKindTyConKey = mkPreludeTyConUnique 92
starKindTyConKey = mkPreludeTyConUnique 93
unicodeStarKindTyConKey = mkPreludeTyConUnique 94
+runtimeRepTyConKey = mkPreludeTyConUnique 95
+vecCountTyConKey = mkPreludeTyConUnique 96
+vecElemTyConKey = mkPreludeTyConUnique 97
pluginTyConKey, frontendPluginTyConKey :: Unique
pluginTyConKey = mkPreludeTyConUnique 102
@@ -1808,11 +1811,6 @@ fingerprintDataConKey = mkPreludeDataConUnique 35
srcLocDataConKey :: Unique
srcLocDataConKey = mkPreludeDataConUnique 37
--- Levity
-liftedDataConKey, unliftedDataConKey :: Unique
-liftedDataConKey = mkPreludeDataConUnique 39
-unliftedDataConKey = mkPreludeDataConUnique 40
-
trTyConTyConKey, trTyConDataConKey,
trModuleTyConKey, trModuleDataConKey,
trNameTyConKey, trNameSDataConKey, trNameDDataConKey,
@@ -1861,6 +1859,26 @@ metaDataDataConKey = mkPreludeDataConUnique 68
metaConsDataConKey = mkPreludeDataConUnique 69
metaSelDataConKey = mkPreludeDataConUnique 70
+vecRepDataConKey :: Unique
+vecRepDataConKey = mkPreludeDataConUnique 71
+
+-- See Note [Wiring in RuntimeRep] in TysWiredIn
+runtimeRepSimpleDataConKeys :: [Unique]
+ptrRepLiftedDataConKey, ptrRepUnliftedDataConKey :: Unique
+runtimeRepSimpleDataConKeys@(
+ ptrRepLiftedDataConKey : ptrRepUnliftedDataConKey : _)
+ = map mkPreludeDataConUnique [72..82]
+
+-- See Note [Wiring in RuntimeRep] in TysWiredIn
+-- VecCount
+vecCountDataConKeys :: [Unique]
+vecCountDataConKeys = map mkPreludeDataConUnique [83..88]
+
+-- See Note [Wiring in RuntimeRep] in TysWiredIn
+-- VecElem
+vecElemDataConKeys :: [Unique]
+vecElemDataConKeys = map mkPreludeDataConUnique [89..98]
+
---------------- Template Haskell -------------------
-- THNames.hs: USES DataUniques 100-150
-----------------------------------------------------
@@ -2232,5 +2250,5 @@ pretendNameIsInScope :: Name -> Bool
pretendNameIsInScope n
= any (n `hasKey`)
[ starKindTyConKey, liftedTypeKindTyConKey, tYPETyConKey
- , unliftedTypeKindTyConKey, levityTyConKey, liftedDataConKey
- , unliftedDataConKey ]
+ , unliftedTypeKindTyConKey
+ , runtimeRepTyConKey, ptrRepLiftedDataConKey, ptrRepUnliftedDataConKey ]
diff --git a/compiler/prelude/PrimOp.hs b/compiler/prelude/PrimOp.hs
index 66172acd24..7b37062aa4 100644
--- a/compiler/prelude/PrimOp.hs
+++ b/compiler/prelude/PrimOp.hs
@@ -30,7 +30,7 @@ import TysWiredIn
import CmmType
import Demand
import OccName ( OccName, pprOccName, mkVarOccFS )
-import TyCon ( TyCon, isPrimTyCon, tyConPrimRep, PrimRep(..) )
+import TyCon ( TyCon, isPrimTyCon, PrimRep(..) )
import Type
import BasicTypes ( Arity, Fixity(..), FixityDirection(..), Boxity(..) )
import ForeignCall ( CLabelString )
diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs
index d1e42d5a10..ce25c308a1 100644
--- a/compiler/prelude/TysPrim.hs
+++ b/compiler/prelude/TysPrim.hs
@@ -15,13 +15,11 @@ module TysPrim(
mkTemplateTyVars,
alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
alphaTys, alphaTy, betaTy, gammaTy, deltaTy,
- levity1TyVar, levity2TyVar, levity1Ty, levity2Ty,
+ runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep1Ty, runtimeRep2Ty,
openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar,
kKiVar,
-- Kind constructors...
- tYPETyCon, unliftedTypeKindTyCon, unliftedTypeKind,
-
tYPETyConName, unliftedTypeKindTyConName,
-- Kinds
@@ -80,7 +78,18 @@ module TysPrim(
#include "HsVersions.h"
-import {-# SOURCE #-} TysWiredIn ( levityTy, unliftedDataConTy, liftedTypeKind )
+import {-# SOURCE #-} TysWiredIn
+ ( runtimeRepTy, liftedTypeKind
+ , vecRepDataConTyCon, ptrRepUnliftedDataConTyCon
+ , voidRepDataConTy, intRepDataConTy
+ , wordRepDataConTy, int64RepDataConTy, word64RepDataConTy, addrRepDataConTy
+ , floatRepDataConTy, doubleRepDataConTy
+ , vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy
+ , vec64DataConTy
+ , int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy
+ , int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy
+ , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy
+ , doubleElemRepDataConTy )
import Var ( TyVar, KindVar, mkTyVar )
import Name
@@ -89,6 +98,7 @@ import SrcLoc
import Unique
import PrelNames
import FastString
+import Outputable
import TyCoRep -- doesn't need special access, but this is easier to avoid
-- import loops
@@ -228,17 +238,17 @@ alphaTys = mkTyVarTys alphaTyVars
alphaTy, betaTy, gammaTy, deltaTy :: Type
(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
-levity1TyVar, levity2TyVar :: TyVar
-(levity1TyVar : levity2TyVar : _)
- = drop 21 (mkTemplateTyVars (repeat levityTy)) -- selects 'v','w'
+runtimeRep1TyVar, runtimeRep2TyVar :: TyVar
+(runtimeRep1TyVar : runtimeRep2TyVar : _)
+ = drop 16 (mkTemplateTyVars (repeat runtimeRepTy)) -- selects 'q','r'
-levity1Ty, levity2Ty :: Type
-levity1Ty = mkTyVarTy levity1TyVar
-levity2Ty = mkTyVarTy levity2TyVar
+runtimeRep1Ty, runtimeRep2Ty :: Type
+runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar
+runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar
openAlphaTyVar, openBetaTyVar :: TyVar
[openAlphaTyVar,openBetaTyVar]
- = mkTemplateTyVars [tYPE levity1Ty, tYPE levity2Ty]
+ = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty]
openAlphaTy, openBetaTy :: Type
openAlphaTy = mkTyVarTy openAlphaTyVar
@@ -260,9 +270,9 @@ funTyConName :: Name
funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon
funTyCon :: TyCon
-funTyCon = mkFunTyCon funTyConName kind tc_rep_nm
+funTyCon = mkFunTyCon funTyConName (map Anon [liftedTypeKind, liftedTypeKind])
+ tc_rep_nm
where
- kind = mkFunTys [liftedTypeKind, liftedTypeKind] liftedTypeKind
-- You might think that (->) should have type (?? -> ? -> *), and you'd be right
-- But if we do that we get kind errors when saying
-- instance Control.Arrow (->)
@@ -274,20 +284,6 @@ funTyCon = mkFunTyCon funTyConName kind tc_rep_nm
tc_rep_nm = mkPrelTyConRepName funTyConName
--- One step to remove subkinding.
--- (->) :: * -> * -> *
--- but we should have (and want) the following typing rule for fully applied arrows
--- Gamma |- tau :: k1 k1 in {*, #}
--- Gamma |- sigma :: k2 k2 in {*, #, (#)}
--- -----------------------------------------
--- Gamma |- tau -> sigma :: *
--- Currently we have the following rule which achieves more or less the same effect
--- Gamma |- tau :: ??
--- Gamma |- sigma :: ?
--- --------------------------
--- Gamma |- tau -> sigma :: *
--- In the end we don't want subkinding at all.
-
{-
************************************************************************
* *
@@ -299,35 +295,48 @@ Note [TYPE]
~~~~~~~~~~~
There are a few places where we wish to be able to deal interchangeably
with kind * and kind #. unsafeCoerce#, error, and (->) are some of these
-places. The way we do this is to use levity polymorphism.
+places. The way we do this is to use runtime-representation polymorphism.
-We have (levityTyCon, liftedDataCon, unliftedDataCon)
+We have
- data Levity = Lifted | Unlifted
+ data RuntimeRep = PtrRepLifted | PtrRepUnlifted | ...
and a magical constant (tYPETyCon)
- TYPE :: Levity -> TYPE Lifted
+ TYPE :: RuntimeRep -> TYPE PtrRepLifted
We then have synonyms (liftedTypeKindTyCon, unliftedTypeKindTyCon)
- type Type = TYPE Lifted
- type # = TYPE Unlifted
+ type * = TYPE PtrRepLifted
+ type # = TYPE PtrRepUnlifted
+
+The (...) in the definition for RuntimeRep includes possibilities for
+the unboxed, unlifted representations, isomorphic to the PrimRep type
+in TyCon. RuntimeRep is itself declared in GHC.Types.
+
+An alternative design would be to have
+
+ data RuntimeRep = PtrRep Levity | ...
+ data Levity = Lifted | Unlifted
-So, for example, we get
+but this slowed down GHC because every time we looked at *, we had to
+follow a bunch of pointers. When we have unpackable sums, we should
+go back to the stratified representation. This would allow, for example:
- unsafeCoerce# :: forall (v1 :: Levity) (v2 :: Levity)
+ unsafeCoerce# :: forall (r1 :: RuntimeRep) (v2 :: Levity)
(a :: TYPE v1) (b :: TYPE v2). a -> b
-This replaces the old sub-kinding machinery. We call variables `a` and `b`
-above "levity polymorphic".
+TYPE replaces the old sub-kinding machinery. We call variables `a` and `b`
+above "runtime-representation polymorphic".
+
-}
tYPETyCon, unliftedTypeKindTyCon :: TyCon
tYPETyConName, unliftedTypeKindTyConName :: Name
tYPETyCon = mkKindTyCon tYPETyConName
- (ForAllTy (Anon levityTy) liftedTypeKind)
+ [Anon runtimeRepTy]
+ liftedTypeKind
[Nominal]
(mkPrelTyConRepName tYPETyConName)
@@ -335,9 +344,9 @@ tYPETyCon = mkKindTyCon tYPETyConName
-- NB: unlifted is wired in because there is no way to parse it in
-- Haskell. That's the only reason for wiring it in.
unliftedTypeKindTyCon = mkSynonymTyCon unliftedTypeKindTyConName
- liftedTypeKind
- [] []
- (tYPE unliftedDataConTy)
+ [] liftedTypeKind
+ [] []
+ (tYPE (TyConApp ptrRepUnliftedDataConTyCon []))
--------------------------
-- ... and now their names
@@ -347,9 +356,6 @@ unliftedTypeKindTyCon = mkSynonymTyCon unliftedTypeKindTyConName
tYPETyConName = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon
unliftedTypeKindTyConName = mkPrimTyConName (fsLit "#") unliftedTypeKindTyConKey unliftedTypeKindTyCon
-unliftedTypeKind :: Kind
-unliftedTypeKind = tYPE unliftedDataConTy
-
mkPrimTyConName :: FastString -> Unique -> TyCon -> Name
mkPrimTyConName = mkPrimTcName BuiltInSyntax
-- All of the super kinds and kinds are defined in Prim,
@@ -360,9 +366,9 @@ mkPrimTcName built_in_syntax occ key tycon
= mkWiredInName gHC_PRIM (mkTcOccFS occ) key (ATyCon tycon) built_in_syntax
-----------------------------
--- | Given a Levity, applies TYPE to it. See Note [TYPE].
+-- | Given a RuntimeRep, applies TYPE to it. See Note [TYPE].
tYPE :: Type -> Type
-tYPE lev = TyConApp tYPETyCon [lev]
+tYPE rr = TyConApp tYPETyCon [rr]
{-
************************************************************************
@@ -375,16 +381,48 @@ tYPE lev = TyConApp tYPETyCon [lev]
-- only used herein
pcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon
pcPrimTyCon name roles rep
- = mkPrimTyCon name kind roles rep
+ = mkPrimTyCon name binders result_kind roles
where
- kind = mkFunTys (map (const liftedTypeKind) roles) result_kind
- result_kind = unliftedTypeKind
+ binders = map (const (Anon liftedTypeKind)) roles
+ result_kind = tYPE rr
+
+ rr = case rep of
+ VoidRep -> voidRepDataConTy
+ PtrRep -> TyConApp ptrRepUnliftedDataConTyCon []
+ IntRep -> intRepDataConTy
+ WordRep -> wordRepDataConTy
+ Int64Rep -> int64RepDataConTy
+ Word64Rep -> word64RepDataConTy
+ AddrRep -> addrRepDataConTy
+ FloatRep -> floatRepDataConTy
+ DoubleRep -> doubleRepDataConTy
+ VecRep n elem -> TyConApp vecRepDataConTyCon [n', elem']
+ where
+ n' = case n of
+ 2 -> vec2DataConTy
+ 4 -> vec4DataConTy
+ 8 -> vec8DataConTy
+ 16 -> vec16DataConTy
+ 32 -> vec32DataConTy
+ 64 -> vec64DataConTy
+ _ -> pprPanic "Disallowed VecCount" (ppr n)
+
+ elem' = case elem of
+ Int8ElemRep -> int8ElemRepDataConTy
+ Int16ElemRep -> int16ElemRepDataConTy
+ Int32ElemRep -> int32ElemRepDataConTy
+ Int64ElemRep -> int64ElemRepDataConTy
+ Word8ElemRep -> word8ElemRepDataConTy
+ Word16ElemRep -> word16ElemRepDataConTy
+ Word32ElemRep -> word32ElemRepDataConTy
+ Word64ElemRep -> word64ElemRepDataConTy
+ FloatElemRep -> floatElemRepDataConTy
+ DoubleElemRep -> doubleElemRepDataConTy
+
pcPrimTyCon0 :: Name -> PrimRep -> TyCon
pcPrimTyCon0 name rep
- = mkPrimTyCon name result_kind [] rep
- where
- result_kind = unliftedTypeKind
+ = pcPrimTyCon name [] rep
charPrimTy :: Type
charPrimTy = mkTyConTy charPrimTyCon
@@ -627,7 +665,7 @@ RealWorld; it's only used in the type system, to parameterise State#.
-}
realWorldTyCon :: TyCon
-realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind [] PtrRep
+realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName [] liftedTypeKind []
realWorldTy :: Type
realWorldTy = mkTyConTy realWorldTyCon
realWorldStatePrimTy :: Type
@@ -647,11 +685,12 @@ mkProxyPrimTy :: Type -> Type -> Type
mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]
proxyPrimTyCon :: TyCon
-proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName kind [Nominal,Nominal] VoidRep
- where kind = ForAllTy (Named kv Specified) $
- mkFunTy k unliftedTypeKind
- kv = kKiVar
- k = mkTyVarTy kv
+proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Nominal]
+ where binders = [ Named kv Specified
+ , Anon k ]
+ res_kind = tYPE voidRepDataConTy
+ kv = kKiVar
+ k = mkTyVarTy kv
{- *********************************************************************
@@ -663,10 +702,12 @@ proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName kind [Nominal,Nominal] VoidRep
eqPrimTyCon :: TyCon -- The representation type for equality predicates
-- See Note [The equality types story]
-eqPrimTyCon = mkPrimTyCon eqPrimTyConName kind roles VoidRep
- where kind = ForAllTy (Named kv1 Specified) $
- ForAllTy (Named kv2 Specified) $
- mkFunTys [k1, k2] unliftedTypeKind
+eqPrimTyCon = mkPrimTyCon eqPrimTyConName binders res_kind roles
+ where binders = [ Named kv1 Specified
+ , Named kv2 Specified
+ , Anon k1
+ , Anon k2 ]
+ res_kind = tYPE voidRepDataConTy
[kv1, kv2] = mkTemplateTyVars [liftedTypeKind, liftedTypeKind]
k1 = mkTyVarTy kv1
k2 = mkTyVarTy kv2
@@ -676,11 +717,12 @@ eqPrimTyCon = mkPrimTyCon eqPrimTyConName kind roles VoidRep
-- this should only ever appear as the type of a covar. Its role is
-- interpreted in coercionRole
eqReprPrimTyCon :: TyCon -- See Note [The equality types story]
-eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName kind
- roles VoidRep
- where kind = ForAllTy (Named kv1 Specified) $
- ForAllTy (Named kv2 Specified) $
- mkFunTys [k1, k2] unliftedTypeKind
+eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles
+ where binders = [ Named kv1 Specified
+ , Named kv2 Specified
+ , Anon k1
+ , Anon k2 ]
+ res_kind = tYPE voidRepDataConTy
[kv1, kv2] = mkTemplateTyVars [liftedTypeKind, liftedTypeKind]
k1 = mkTyVarTy kv1
k2 = mkTyVarTy kv2
@@ -690,12 +732,13 @@ eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName kind
-- This is only used to make higher-order equalities. Nothing
-- should ever actually have this type!
eqPhantPrimTyCon :: TyCon
-eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName kind
+eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind
[Nominal, Nominal, Phantom, Phantom]
- VoidRep
- where kind = ForAllTy (Named kv1 Specified) $
- ForAllTy (Named kv2 Specified) $
- mkFunTys [k1, k2] unliftedTypeKind
+ where binders = [ Named kv1 Specified
+ , Named kv2 Specified
+ , Anon k1
+ , Anon k2 ]
+ res_kind = tYPE voidRepDataConTy
[kv1, kv2] = mkTemplateTyVars [liftedTypeKind, liftedTypeKind]
k1 = mkTyVarTy kv1
k2 = mkTyVarTy kv2
@@ -920,12 +963,13 @@ anyTy :: Type
anyTy = mkTyConTy anyTyCon
anyTyCon :: TyCon
-anyTyCon = mkFamilyTyCon anyTyConName kind [kKiVar] Nothing
+anyTyCon = mkFamilyTyCon anyTyConName binders res_kind [kKiVar] Nothing
(ClosedSynFamilyTyCon Nothing)
Nothing
NotInjective
where
- kind = ForAllTy (Named kKiVar Specified) (mkTyVarTy kKiVar)
+ binders = [Named kKiVar Specified]
+ res_kind = mkTyVarTy kKiVar
anyTypeOfKind :: Kind -> Type
anyTypeOfKind kind = TyConApp anyTyCon [kind]
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index b7bd186e86..6f0fc569f2 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -88,11 +88,25 @@ module TysWiredIn (
mkWiredInIdName, -- used in MkId
- -- * Levity
- levityTy, levityTyCon, liftedDataCon, unliftedDataCon,
- liftedPromDataCon, unliftedPromDataCon,
- liftedDataConTy, unliftedDataConTy,
- liftedDataConName, unliftedDataConName,
+ -- * RuntimeRep and friends
+ runtimeRepTyCon, vecCountTyCon, vecElemTyCon,
+
+ runtimeRepTy, ptrRepLiftedTy,
+
+ vecRepDataConTyCon, ptrRepUnliftedDataConTyCon,
+
+ voidRepDataConTy, intRepDataConTy,
+ wordRepDataConTy, int64RepDataConTy, word64RepDataConTy, addrRepDataConTy,
+ floatRepDataConTy, doubleRepDataConTy, unboxedTupleRepDataConTy,
+
+ vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
+ vec64DataConTy,
+
+ int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
+ int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
+ word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
+ doubleElemRepDataConTy
+
) where
#include "HsVersions.h"
@@ -135,6 +149,15 @@ alpha_ty :: [Type]
alpha_ty = [alphaTy]
{-
+Note [Wiring in RuntimeRep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The RuntimeRep type (and friends) in GHC.Types has a bunch of constructors,
+making it a pain to wire in. To ease the pain somewhat, we use lists of
+the different bits, like Uniques, Names, DataCons. These lists must be
+kept in sync with each other. The rule is this: use the order as declared
+in GHC.Types. All places where such lists exist should contain a reference
+to this Note, so a search for this Note's name should find all the lists.
+
************************************************************************
* *
\subsection{Wired in type constructors}
@@ -178,7 +201,9 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because
, coercibleTyCon
, typeNatKindCon
, typeSymbolKindCon
- , levityTyCon
+ , runtimeRepTyCon
+ , vecCountTyCon
+ , vecElemTyCon
, constraintKindTyCon
, liftedTypeKindTyCon
, starKindTyCon
@@ -264,10 +289,48 @@ liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type")
starKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "*") starKindTyConKey starKindTyCon
unicodeStarKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "★") unicodeStarKindTyConKey unicodeStarKindTyCon
-levityTyConName, liftedDataConName, unliftedDataConName :: Name
-levityTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Levity") levityTyConKey levityTyCon
-liftedDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Lifted") liftedDataConKey liftedDataCon
-unliftedDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Unlifted") unliftedDataConKey unliftedDataCon
+runtimeRepTyConName, vecRepDataConName :: Name
+runtimeRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "RuntimeRep") runtimeRepTyConKey runtimeRepTyCon
+vecRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "VecRep") vecRepDataConKey vecRepDataCon
+
+-- See Note [Wiring in RuntimeRep]
+runtimeRepSimpleDataConNames :: [Name]
+runtimeRepSimpleDataConNames
+ = zipWith3Lazy mk_special_dc_name
+ [ fsLit "PtrRepLifted", fsLit "PtrRepUnlifted"
+ , fsLit "VoidRep", fsLit "IntRep"
+ , fsLit "WordRep", fsLit "Int64Rep", fsLit "Word64Rep"
+ , fsLit "AddrRep", fsLit "FloatRep", fsLit "DoubleRep"
+ , fsLit "UnboxedTupleRep" ]
+ runtimeRepSimpleDataConKeys
+ runtimeRepSimpleDataCons
+
+vecCountTyConName :: Name
+vecCountTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecCount") vecCountTyConKey vecCountTyCon
+
+-- See Note [Wiring in RuntimeRep]
+vecCountDataConNames :: [Name]
+vecCountDataConNames = zipWith3Lazy mk_special_dc_name
+ [ fsLit "Vec2", fsLit "Vec4", fsLit "Vec8"
+ , fsLit "Vec16", fsLit "Vec32", fsLit "Vec64" ]
+ vecCountDataConKeys
+ vecCountDataCons
+
+vecElemTyConName :: Name
+vecElemTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecElem") vecElemTyConKey vecElemTyCon
+
+-- See Note [Wiring in RuntimeRep]
+vecElemDataConNames :: [Name]
+vecElemDataConNames = zipWith3Lazy mk_special_dc_name
+ [ fsLit "Int8ElemRep", fsLit "Int16ElemRep", fsLit "Int32ElemRep"
+ , fsLit "Int64ElemRep", fsLit "Word8ElemRep", fsLit "Word16elemRep"
+ , fsLit "Word32ElemRep", fsLit "Word64ElemRep"
+ , fsLit "FloatElemRep", fsLit "DoubleElemRep" ]
+ vecElemDataConKeys
+ vecElemDataCons
+
+mk_special_dc_name :: FastString -> Unique -> DataCon -> Name
+mk_special_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc
parrTyConName, parrDataConName :: Name
parrTyConName = mkWiredInTyConName BuiltInSyntax
@@ -304,7 +367,8 @@ pcNonRecDataTyCon = pcTyCon False NonRecursive
pcTyCon :: Bool -> RecFlag -> Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon is_enum is_rec name cType tyvars cons
= mkAlgTyCon name
- (mkFunTys (map tyVarKind tyvars) liftedTypeKind)
+ (map (mkAnonBinder . tyVarKind) tyvars)
+ liftedTypeKind
tyvars
(map (const Representational) tyvars)
cType
@@ -325,6 +389,7 @@ pcDataConWithFixity :: Bool -- ^ declared infix?
-> TyCon
-> DataCon
pcDataConWithFixity infx n = pcDataConWithFixity' infx n (incrUnique (nameUnique n))
+ NoRRI
-- The Name's unique is the first of two free uniques;
-- the first is used for the datacon itself,
-- the second is used for the "worker name"
@@ -332,12 +397,13 @@ pcDataConWithFixity infx n = pcDataConWithFixity' infx n (incrUnique (nameUnique
-- To support this the mkPreludeDataConUnique function "allocates"
-- one DataCon unique per pair of Ints.
-pcDataConWithFixity' :: Bool -> Name -> Unique -> [TyVar] -> [TyVar]
+pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo
+ -> [TyVar] -> [TyVar]
-> [Type] -> TyCon -> DataCon
-- The Name should be in the DataName name space; it's the name
-- of the DataCon itself.
-pcDataConWithFixity' declared_infix dc_name wrk_key tyvars ex_tyvars arg_tys tycon
+pcDataConWithFixity' declared_infix dc_name wrk_key rri tyvars ex_tyvars arg_tys tycon
= data_con
where
data_con = mkDataCon dc_name declared_infix prom_info
@@ -348,6 +414,7 @@ pcDataConWithFixity' declared_infix dc_name wrk_key tyvars ex_tyvars arg_tys tyc
[] -- No equality spec
[] -- No theta
arg_tys (mkTyConApp tycon (mkTyVarTys tyvars))
+ rri
tycon
[] -- No stupid theta
(mkDataConWorkId wrk_name data_con)
@@ -364,6 +431,12 @@ pcDataConWithFixity' declared_infix dc_name wrk_key tyvars ex_tyvars arg_tys tyc
prom_info = mkPrelTyConRepName dc_name
+-- used for RuntimeRep and friends
+pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon
+pcSpecialDataCon dc_name arg_tys tycon rri
+ = pcDataConWithFixity' False dc_name (incrUnique (nameUnique dc_name)) rri
+ [] [] arg_tys tycon
+
{-
************************************************************************
* *
@@ -387,7 +460,7 @@ constraintKindTyCon = pcTyCon False NonRecursive constraintKindTyConName
Nothing [] []
liftedTypeKind, constraintKind :: Kind
-liftedTypeKind = tYPE liftedDataConTy
+liftedTypeKind = tYPE ptrRepLiftedTy
constraintKind = mkTyConApp constraintKindTyCon []
@@ -536,34 +609,38 @@ unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mA
mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
mk_tuple boxity arity = (tycon, tuple_con)
where
- tycon = mkTupleTyCon tc_name tc_kind tc_arity tyvars tuple_con
+ tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tyvars tuple_con
tup_sort flavour
- (tup_sort, modu, tc_kind, tc_arity, tyvars, tyvar_tys, flavour)
+ (tup_sort, modu, tc_binders, tc_res_kind, tc_arity, tyvars, tyvar_tys, flavour)
= case boxity of
Boxed ->
let boxed_tyvars = take arity alphaTyVars in
( BoxedTuple
, gHC_TUPLE
- , mkFunTys (nOfThem arity liftedTypeKind) liftedTypeKind
+ , nOfThem arity (mkAnonBinder liftedTypeKind)
+ , liftedTypeKind
, arity
, boxed_tyvars
, mkTyVarTys boxed_tyvars
, VanillaAlgTyCon (mkPrelTyConRepName tc_name)
)
- -- See Note [Unboxed tuple levity vars] in TyCon
+ -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
Unboxed ->
- let all_tvs = mkTemplateTyVars (replicate arity levityTy ++
+ let all_tvs = mkTemplateTyVars (replicate arity runtimeRepTy ++
map (tYPE . mkTyVarTy) (take arity all_tvs))
-- NB: This must be one call to mkTemplateTyVars, to make
-- sure that all the uniques are different
- (lev_tvs, open_tvs) = splitAt arity all_tvs
+ (rr_tvs, open_tvs) = splitAt arity all_tvs
+ res_rep | arity == 0 = voidRepDataConTy
+ -- See Note [Nullary unboxed tuple] in Type
+ | otherwise = unboxedTupleRepDataConTy
in
( UnboxedTuple
, gHC_PRIM
- , mkSpecForAllTys lev_tvs $
- mkFunTys (map tyVarKind open_tvs) $
- unliftedTypeKind
+ , map (mkNamedBinder Specified) rr_tvs ++
+ map (mkAnonBinder . tyVarKind) open_tvs
+ , tYPE res_rep
, arity * 2
, all_tvs
, mkTyVarTys open_tvs
@@ -616,13 +693,16 @@ heqSCSelId, coercibleSCSelId :: Id
(heqTyCon, heqClass, heqDataCon, heqSCSelId)
= (tycon, klass, datacon, sc_sel_id)
where
- tycon = mkClassTyCon heqTyConName kind tvs roles
+ tycon = mkClassTyCon heqTyConName binders tvs roles
rhs klass NonRecursive
(mkPrelTyConRepName heqTyConName)
klass = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
datacon = pcDataCon heqDataConName tvs [sc_pred] tycon
- kind = mkSpecForAllTys [kv1, kv2] $ mkFunTys [k1, k2] constraintKind
+ binders = [ mkNamedBinder Specified kv1
+ , mkNamedBinder Specified kv2
+ , mkAnonBinder k1
+ , mkAnonBinder k2 ]
kv1:kv2:_ = drop 9 alphaTyVars -- gets "j" and "k"
k1 = mkTyVarTy kv1
k2 = mkTyVarTy kv2
@@ -637,13 +717,15 @@ heqSCSelId, coercibleSCSelId :: Id
(coercibleTyCon, coercibleClass, coercibleDataCon, coercibleSCSelId)
= (tycon, klass, datacon, sc_sel_id)
where
- tycon = mkClassTyCon coercibleTyConName kind tvs roles
+ tycon = mkClassTyCon coercibleTyConName binders tvs roles
rhs klass NonRecursive
(mkPrelTyConRepName coercibleTyConName)
klass = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
datacon = pcDataCon coercibleDataConName tvs [sc_pred] tycon
- kind = mkSpecForAllTys [kKiVar] $ mkFunTys [k, k] constraintKind
+ binders = [ mkNamedBinder Specified kKiVar
+ , mkAnonBinder k
+ , mkAnonBinder k ]
k = mkTyVarTy kKiVar
[av,bv] = mkTemplateTyVars [k, k]
tvs = [kKiVar, av, bv]
@@ -656,48 +738,125 @@ heqSCSelId, coercibleSCSelId :: Id
{- *********************************************************************
* *
- Kinds and levity
+ Kinds and RuntimeRep
* *
********************************************************************* -}
-- For information about the usage of the following type, see Note [TYPE]
-- in module TysPrim
-levityTy :: Type
-levityTy = mkTyConTy levityTyCon
-
-levityTyCon :: TyCon
-levityTyCon = pcTyCon True NonRecursive levityTyConName
- Nothing [] [liftedDataCon, unliftedDataCon]
-
-liftedDataCon, unliftedDataCon :: DataCon
-liftedDataCon = pcDataCon liftedDataConName [] [] levityTyCon
-unliftedDataCon = pcDataCon unliftedDataConName [] [] levityTyCon
-
-liftedPromDataCon, unliftedPromDataCon :: TyCon
-liftedPromDataCon = promoteDataCon liftedDataCon
-unliftedPromDataCon = promoteDataCon unliftedDataCon
-
-liftedDataConTy, unliftedDataConTy :: Type
-liftedDataConTy = mkTyConTy liftedPromDataCon
-unliftedDataConTy = mkTyConTy unliftedPromDataCon
+runtimeRepTy :: Type
+runtimeRepTy = mkTyConTy runtimeRepTyCon
liftedTypeKindTyCon, starKindTyCon, unicodeStarKindTyCon :: TyCon
-- See Note [TYPE] in TysPrim
liftedTypeKindTyCon = mkSynonymTyCon liftedTypeKindTyConName
- liftedTypeKind
+ [] liftedTypeKind
[] []
- (tYPE liftedDataConTy)
+ (tYPE ptrRepLiftedTy)
starKindTyCon = mkSynonymTyCon starKindTyConName
- liftedTypeKind
+ [] liftedTypeKind
[] []
- (tYPE liftedDataConTy)
+ (tYPE ptrRepLiftedTy)
unicodeStarKindTyCon = mkSynonymTyCon unicodeStarKindTyConName
- liftedTypeKind
+ [] liftedTypeKind
[] []
- (tYPE liftedDataConTy)
+ (tYPE ptrRepLiftedTy)
+
+runtimeRepTyCon :: TyCon
+runtimeRepTyCon = pcNonRecDataTyCon runtimeRepTyConName Nothing []
+ (vecRepDataCon : runtimeRepSimpleDataCons)
+
+vecRepDataCon :: DataCon
+vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon
+ , mkTyConTy vecElemTyCon ]
+ runtimeRepTyCon
+ (RuntimeRep prim_rep_fun)
+ where
+ prim_rep_fun [count, elem]
+ | VecCount n <- tyConRuntimeRepInfo (tyConAppTyCon count)
+ , VecElem e <- tyConRuntimeRepInfo (tyConAppTyCon elem)
+ = VecRep n e
+ prim_rep_fun args
+ = pprPanic "vecRepDataCon" (ppr args)
+
+vecRepDataConTyCon :: TyCon
+vecRepDataConTyCon = promoteDataCon vecRepDataCon
+
+ptrRepUnliftedDataConTyCon :: TyCon
+ptrRepUnliftedDataConTyCon = promoteDataCon ptrRepUnliftedDataCon
+
+-- See Note [Wiring in RuntimeRep]
+runtimeRepSimpleDataCons :: [DataCon]
+ptrRepLiftedDataCon, ptrRepUnliftedDataCon :: DataCon
+runtimeRepSimpleDataCons@(ptrRepLiftedDataCon : ptrRepUnliftedDataCon : _)
+ = zipWithLazy mk_runtime_rep_dc
+ [ PtrRep, PtrRep, VoidRep, IntRep, WordRep, Int64Rep
+ , Word64Rep, AddrRep, FloatRep, DoubleRep
+ , panic "unboxed tuple PrimRep" ]
+ runtimeRepSimpleDataConNames
+ where
+ mk_runtime_rep_dc primrep name
+ = pcSpecialDataCon name [] runtimeRepTyCon (RuntimeRep (\_ -> primrep))
+
+-- See Note [Wiring in RuntimeRep]
+voidRepDataConTy, intRepDataConTy, wordRepDataConTy, int64RepDataConTy,
+ word64RepDataConTy, addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy,
+ unboxedTupleRepDataConTy :: Type
+[_, _, voidRepDataConTy, intRepDataConTy, wordRepDataConTy, int64RepDataConTy,
+ word64RepDataConTy, addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy,
+ unboxedTupleRepDataConTy] = map (mkTyConTy . promoteDataCon)
+ runtimeRepSimpleDataCons
+
+vecCountTyCon :: TyCon
+vecCountTyCon = pcNonRecDataTyCon vecCountTyConName Nothing []
+ vecCountDataCons
+
+-- See Note [Wiring in RuntimeRep]
+vecCountDataCons :: [DataCon]
+vecCountDataCons = zipWithLazy mk_vec_count_dc
+ [ 2, 4, 8, 16, 32, 64 ]
+ vecCountDataConNames
+ where
+ mk_vec_count_dc n name
+ = pcSpecialDataCon name [] vecCountTyCon (VecCount n)
+
+-- See Note [Wiring in RuntimeRep]
+vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
+ vec64DataConTy :: Type
+[vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
+ vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons
+
+vecElemTyCon :: TyCon
+vecElemTyCon = pcNonRecDataTyCon vecElemTyConName Nothing [] vecElemDataCons
+
+-- See Note [Wiring in RuntimeRep]
+vecElemDataCons :: [DataCon]
+vecElemDataCons = zipWithLazy mk_vec_elem_dc
+ [ Int8ElemRep, Int16ElemRep, Int32ElemRep, Int64ElemRep
+ , Word8ElemRep, Word16ElemRep, Word32ElemRep, Word64ElemRep
+ , FloatElemRep, DoubleElemRep ]
+ vecElemDataConNames
+ where
+ mk_vec_elem_dc elem name
+ = pcSpecialDataCon name [] vecElemTyCon (VecElem elem)
+
+-- See Note [Wiring in RuntimeRep]
+int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
+ int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
+ word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
+ doubleElemRepDataConTy :: Type
+[int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
+ int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
+ word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
+ doubleElemRepDataConTy] = map (mkTyConTy . promoteDataCon)
+ vecElemDataCons
+
+-- The type ('PtrRepLifted)
+ptrRepLiftedTy :: Type
+ptrRepLiftedTy = mkTyConTy $ promoteDataCon ptrRepLiftedDataCon
{- *********************************************************************
* *
@@ -943,13 +1102,13 @@ done by enumeration\srcloc{lib/prelude/InTup?.hs}.
-}
-- | Make a tuple type. The list of types should /not/ include any
--- levity specifications.
+-- RuntimeRep specifications.
mkTupleTy :: Boxity -> [Type] -> Type
-- Special case for *boxed* 1-tuples, which are represented by the type itself
mkTupleTy Boxed [ty] = ty
mkTupleTy Boxed tys = mkTyConApp (tupleTyCon Boxed (length tys)) tys
mkTupleTy Unboxed tys = mkTyConApp (tupleTyCon Unboxed (length tys))
- (map (getLevity "mkTupleTy") tys ++ tys)
+ (map (getRuntimeRep "mkTupleTy") tys ++ tys)
-- | Build the type of a small tuple that holds the specified type of thing
mkBoxedTupleTy :: [Type] -> Type
diff --git a/compiler/prelude/TysWiredIn.hs-boot b/compiler/prelude/TysWiredIn.hs-boot
index f7ae6354b3..7216d2667c 100644
--- a/compiler/prelude/TysWiredIn.hs-boot
+++ b/compiler/prelude/TysWiredIn.hs-boot
@@ -1,6 +1,6 @@
module TysWiredIn where
-import TyCon
+import {-# SOURCE #-} TyCon ( TyCon )
import {-# SOURCE #-} TyCoRep (Type, Kind)
@@ -8,6 +8,22 @@ listTyCon :: TyCon
typeNatKind, typeSymbolKind :: Type
mkBoxedTupleTy :: [Type] -> Type
-levityTy, unliftedDataConTy :: Type
-
liftedTypeKind :: Kind
+constraintKind :: Kind
+
+runtimeRepTyCon, vecCountTyCon, vecElemTyCon :: TyCon
+runtimeRepTy :: Type
+
+ptrRepUnliftedDataConTyCon, vecRepDataConTyCon :: TyCon
+
+voidRepDataConTy, intRepDataConTy,
+ wordRepDataConTy, int64RepDataConTy, word64RepDataConTy, addrRepDataConTy,
+ floatRepDataConTy, doubleRepDataConTy, unboxedTupleRepDataConTy :: Type
+
+vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
+ vec64DataConTy :: Type
+
+int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
+ int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy,
+ word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy,
+ doubleElemRepDataConTy :: Type
View Lorry Controller Status