Repository : ssh://g...@git.haskell.org/ghc
On branch : master
Link :
http://ghc.haskell.org/trac/ghc/changeset/17112084f87d7ccebf639068b85948190d52c6ba/ghc
>---------------------------------------------------------------
commit 17112084f87d7ccebf639068b85948190d52c6ba
Author: Austin Seipp <aus...@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 <ekm...@gmail.com>
Authored-by: Austin Seipp <aus...@well-typed.com>
Signed-off-by: Austin Seipp <aus...@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
_______________________________________________
ghc-commits mailing list
ghc-commits@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-commits
