Trying to implement equality without tags

diff --git a/cbits/HeapViewPrim.cmm b/cbits/HeapViewPrim.cmm
index 2520e9c..2193801 100644 (file)
--- a/cbits/HeapViewPrim.cmm
+++ b/cbits/HeapViewPrim.cmm
@@ -47,3 +47,9 @@ for:
     RET_NPP(info, data_arr, ptrArray);
 }
 
+untag
+{
+    W_ clos;
+    clos = UNTAG(R1);
+    RET_N(clos);
+}

diff --git a/src/GHC/HeapView.hs b/src/GHC/HeapView.hs
index af0d315..c73da98 100644 (file)
--- a/src/GHC/HeapView.hs
+++ b/src/GHC/HeapView.hs
@@ -370,6 +370,7 @@ allPtrs (UnsupportedClosure {..}) = []
 #ifdef PRIM_SUPPORTS_ANY
 foreign import prim "aToWordzh" aToWord# :: Any -> Word#
 foreign import prim "slurpClosurezh" slurpClosure# :: Any -> (# Addr#, ByteArray#, Array# b #)
+foreign import prim "untag" untag# :: Any -> Any
 #else
 -- Workd-around code until http://hackage.haskell.org/trac/ghc/ticket/5931 was
 -- accepted
@@ -377,6 +378,8 @@ foreign import prim "slurpClosurezh" slurpClosure# :: Any -> (# Addr#, ByteArray
 -- foreign import prim "aToWordzh" aToWord'# :: Addr# -> Word#
 foreign import prim "slurpClosurezh" slurpClosure'# :: Word#  -> (# Addr#, ByteArray#, Array# b #)
 
+foreign import prim "untag" untag'# :: Word# -> Word#
+
 -- This is a datatype that has the same layout as Ptr, so that by
 -- unsafeCoerce'ing, we obtain the Addr of the wrapped value
 data Ptr' a = Ptr' a
@@ -386,6 +389,9 @@ aToWord# a = case Ptr' a of mb@(Ptr' _) -> case unsafeCoerce# mb :: Word of W# a
 
 slurpClosure# :: Any -> (# Addr#, ByteArray#, Array# b #)
 slurpClosure# a = slurpClosure'# (aToWord# a)
+
+untag# :: Any -> Any
+untag# a = unsafeCoerce# (untag'# (unsafeCoerce# a))
 #endif
 
 --pClosure x = do