Work even if #5931 is not accepted.

diff --git a/ghc-heap-view.cabal b/ghc-heap-view.cabal
index 8cf1840..5c60bb3 100644 (file)
--- a/ghc-heap-view.cabal
+++ b/ghc-heap-view.cabal
@@ -16,9 +16,17 @@ Build-type:          Simple
 Cabal-version:       >=1.2
 Extra-source-files:  Demo.hs
 
+Flag prim-supports-any
+    Description: The used GHC supports Any as an argument to foreign prim functions (GHC ticket #5931)
+    Default: False
+
 Library
   Exposed-modules: GHC.HeapView 
   Build-depends:  base, ghc, integer-gmp, ghc-prim
   C-Sources: cbits/HeapView.c cbits/HeapViewPrim.cmm
   Hs-source-dirs: src/
+
+  if flag(prim-supports-any)
+    cpp-options: -DPRIM_SUPPORTS_ANY
+ 
   

diff --git a/src/GHC/HeapView.hs b/src/GHC/HeapView.hs
index a16ebb6..7286bf8 100644 (file)
--- a/src/GHC/HeapView.hs
+++ b/src/GHC/HeapView.hs
@@ -293,8 +293,25 @@ allPtrs (MutArrClosure {..}) = mccPayload
 allPtrs (FunClosure {..}) = ptrArgs
 allPtrs (OtherClosure {..}) = hvalues
 
+#ifdef PRIM_SUPPORTS_ANY
 foreign import prim "aToInt" aToInt# :: Any -> Int#
 foreign import prim "slurpClosurezh" slurpClosure# :: Any -> (# Addr#, ByteArray#, Array# b #)
+#else
+-- Workd-around code until http://hackage.haskell.org/trac/ghc/ticket/5931 was
+-- accepted
+
+foreign import prim "aToInt" aToInt'# :: Addr# -> Int#
+foreign import prim "slurpClosurezh" slurpClosure'# :: Addr#  -> (# Addr#, ByteArray#, Array# b #)
+
+-- 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
+
+aToInt# :: Any -> Int#
+aToInt# a = case Ptr' a of mb@(Ptr' _) -> case unsafeCoerce# mb :: Ptr () of Ptr addr -> aToInt'# addr
+slurpClosure# :: Any -> (# Addr#, ByteArray#, Array# b #)
+slurpClosure# a = case Ptr' a of mb@(Ptr' _) -> case unsafeCoerce# mb :: Ptr () of Ptr addr -> slurpClosure'# addr
+#endif
 
 --pClosure x = do
 --    getClosure x >>= print