[commit: ghc] master: Implement an unlifted Proxy type, Proxy# (1711208)
git at git.haskell.org
git at git.haskell.org
Fri Sep 27 07:19:25 CEST 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/17112084f87d7ccebf639068b85948190d52c6ba/ghc
>---------------------------------------------------------------
commit 17112084f87d7ccebf639068b85948190d52c6ba
Author: Austin Seipp <austin at well-typed.com>
Date: Wed Sep 25 02:42:21 2013 -0500
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 <ekmett at gmail.com>
Authored-by: Austin Seipp <austin at well-typed.com>
Signed-off-by: Austin Seipp <austin at well-typed.com>
>---------------------------------------------------------------
17112084f87d7ccebf639068b85948190d52c6ba
compiler/basicTypes/MkId.lhs | 19 +++++++++++++++++--
compiler/ghci/RtClosureInspect.hs | 1 +
compiler/prelude/PrelNames.lhs | 6 ++++++
compiler/prelude/TysPrim.lhs | 15 ++++++++++++++-
4 files changed, 38 insertions(+), 3 deletions(-)
diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 45d9459..252384d 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -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
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 9a5edbd..c02b87c 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -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>"
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 453f554..6b0c432 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -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
-----------------------------------------------------
diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
index b17f1a6..6e653d0 100644
--- a/compiler/prelude/TysPrim.lhs
+++ b/compiler/prelude/TysPrim.lhs
@@ -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
More information about the ghc-commits
mailing list