Commit 17112084 authored by Austin Seipp's avatar Austin Seipp
Browse files

Implement an unlifted Proxy type, Proxy#



A value of type 'Proxy# a' can only be created through the new,
primitive witness 'proxy# :: Proxy# a' - a Proxy# has no runtime
representation and is thus free.

This lets us clean up the internals of TypeRep, as well as Adam's future
work concerning records (by using a zero-width primitive type.)
Authored-by: Edward Kmett's avatarEdward Kmett <ekmett@gmail.com>
Authored-by: default avatarAustin Seipp <austin@well-typed.com>
Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>
parent 5e2f145a
......@@ -138,7 +138,8 @@ ghcPrimIds
nullAddrId,
seqId,
magicSingIId,
coerceId
coerceId,
proxyHashId
]
\end{code}
......@@ -1037,7 +1038,7 @@ they can unify with both unlifted and lifted types. Hence we provide
another gun with which to shoot yourself in the foot.
\begin{code}
lazyIdName, unsafeCoerceName, nullAddrName, seqName, realWorldName, coercionTokenName, magicSingIName, coerceName :: Name
lazyIdName, unsafeCoerceName, nullAddrName, seqName, realWorldName, coercionTokenName, magicSingIName, coerceName, proxyName :: Name
unsafeCoerceName = mkWiredInIdName gHC_PRIM (fsLit "unsafeCoerce#") unsafeCoerceIdKey unsafeCoerceId
nullAddrName = mkWiredInIdName gHC_PRIM (fsLit "nullAddr#") nullAddrIdKey nullAddrId
seqName = mkWiredInIdName gHC_PRIM (fsLit "seq") seqIdKey seqId
......@@ -1046,9 +1047,23 @@ lazyIdName = mkWiredInIdName gHC_MAGIC (fsLit "lazy") lazyIdKey
coercionTokenName = mkWiredInIdName gHC_PRIM (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
magicSingIName = mkWiredInIdName gHC_PRIM (fsLit "magicSingI") magicSingIKey magicSingIId
coerceName = mkWiredInIdName gHC_PRIM (fsLit "coerce") coerceKey coerceId
proxyName = mkWiredInIdName gHC_PRIM (fsLit "proxy#") proxyHashKey proxyHashId
\end{code}
\begin{code}
------------------------------------------------
-- proxy# :: forall a. Proxy# a
proxyHashId :: Id
proxyHashId
= pcMiscPrelId proxyName ty noCafIdInfo
where
ty = mkForAllTys [kv, tv] (mkProxyPrimTy k t)
kv = kKiVar
k = mkTyVarTy kv
tv:_ = tyVarList k
t = mkTyVarTy tv
------------------------------------------------
-- unsafeCoerce# :: forall a b. a -> b
unsafeCoerceId :: Id
......
......@@ -508,6 +508,7 @@ repPrim t = rep where
| t == stablePtrPrimTyCon = text "<stablePtr>"
| t == stableNamePrimTyCon = text "<stableName>"
| t == statePrimTyCon = text "<statethread>"
| t == proxyPrimTyCon = text "<proxy>"
| t == realWorldTyCon = text "<realworld>"
| t == threadIdPrimTyCon = text "<ThreadId>"
| t == weakPrimTyCon = text "<Weak>"
......
......@@ -1480,6 +1480,9 @@ ntTyConKey = mkPreludeTyConUnique 174
coercibleTyConKey :: Unique
coercibleTyConKey = mkPreludeTyConUnique 175
proxyPrimTyConKey :: Unique
proxyPrimTyConKey = mkPreludeTyConUnique 176
---------------- Template Haskell -------------------
-- USES TyConUniques 200-299
-----------------------------------------------------
......@@ -1793,6 +1796,9 @@ fromListClassOpKey = mkPreludeMiscIdUnique 199
fromListNClassOpKey = mkPreludeMiscIdUnique 500
toListClassOpKey = mkPreludeMiscIdUnique 501
proxyHashKey :: Unique
proxyHashKey = mkPreludeMiscIdUnique 502
---------------- Template Haskell -------------------
-- USES IdUniques 200-499
-----------------------------------------------------
......
......@@ -48,6 +48,8 @@ module TysPrim(
statePrimTyCon, mkStatePrimTy,
realWorldTyCon, realWorldTy, realWorldStatePrimTy,
proxyPrimTyCon, mkProxyPrimTy,
arrayPrimTyCon, mkArrayPrimTy,
byteArrayPrimTyCon, byteArrayPrimTy,
arrayArrayPrimTyCon, mkArrayArrayPrimTy,
......@@ -126,6 +128,7 @@ primTyCons
, stablePtrPrimTyCon
, stableNamePrimTyCon
, statePrimTyCon
, proxyPrimTyCon
, threadIdPrimTyCon
, wordPrimTyCon
, word32PrimTyCon
......@@ -151,7 +154,7 @@ mkPrimTc fs unique tycon
(ATyCon tycon) -- Relevant TyCon
UserSyntax -- None are built-in syntax
charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName :: Name
charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName :: Name
charPrimTyConName = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
intPrimTyConName = mkPrimTc (fsLit "Int#") intPrimTyConKey intPrimTyCon
int32PrimTyConName = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon
......@@ -163,6 +166,7 @@ addrPrimTyConName = mkPrimTc (fsLit "Addr#") addrPrimTyConKey addrPrim
floatPrimTyConName = mkPrimTc (fsLit "Float#") floatPrimTyConKey floatPrimTyCon
doublePrimTyConName = mkPrimTc (fsLit "Double#") doublePrimTyConKey doublePrimTyCon
statePrimTyConName = mkPrimTc (fsLit "State#") statePrimTyConKey statePrimTyCon
proxyPrimTyConName = mkPrimTc (fsLit "Proxy#") proxyPrimTyConKey proxyPrimTyCon
eqPrimTyConName = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon
eqReprPrimTyConName = mkPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon
realWorldTyConName = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
......@@ -473,6 +477,15 @@ mkStatePrimTy ty = TyConApp statePrimTyCon [ty]
statePrimTyCon :: TyCon -- See Note [The State# TyCon]
statePrimTyCon = pcPrimTyCon statePrimTyConName [Nominal] VoidRep
mkProxyPrimTy :: Type -> Type -> Type
mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]
proxyPrimTyCon :: TyCon
proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName kind [Nominal,Nominal] VoidRep
where kind = ForAllTy kv $ mkArrowKind k unliftedTypeKind
kv = kKiVar
k = mkTyVarTy kv
eqPrimTyCon :: TyCon -- The representation type for equality predicates
-- See Note [The ~# TyCon]
eqPrimTyCon = mkPrimTyCon eqPrimTyConName kind [Nominal, Nominal, Nominal] VoidRep
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment