diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for ghc-debug-common
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2019, Ben Gamari
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Ben Gamari nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/cbits/GhcDebug.cmm b/cbits/GhcDebug.cmm
new file mode 100644
--- /dev/null
+++ b/cbits/GhcDebug.cmm
@@ -0,0 +1,69 @@
+#include "Cmm.h"
+
+
+closureSizezh ( P_ closure )
+{
+    W_ clos;
+    clos = UNTAG(closure);
+
+    W_ len;
+    (len) = foreign "C" heap_view_closureSize(clos "ptr");
+    return (len);
+}
+
+unpackClosureDatzh ( P_ closure )
+{
+    W_ p, ptrs_arr, dat_arr;
+
+    W_ clos;
+    clos = UNTAG(closure);
+
+    W_ len;
+    (len) = foreign "C" heap_view_closureSize(clos "ptr");
+    foreign "C" printf("unpack %p %d\n", clos, len);
+
+    W_ dat_arr_sz;
+    dat_arr_sz = SIZEOF_StgArrBytes + WDS(len);
+
+    ALLOC_PRIM_N (dat_arr_sz, unpackClosureDatzh, closure);
+    foreign "C" printf("unpack(2) %p %d\n", clos, len);
+
+    dat_arr = Hp - dat_arr_sz + WDS(1);
+
+    SET_HDR(dat_arr, stg_ARR_WORDS_info, CCCS);
+    StgArrBytes_bytes(dat_arr) = WDS(len);
+    foreign "C" printf("unpack(3) %p %d\n", clos, len);
+    p = 0;
+for:
+    if(p < len) {
+         foreign "C" printf("unpack(3a) %p %d/%d %p\n", clos,p, len, clos + WDS(p));
+         W_[BYTE_ARR_CTS(dat_arr) + WDS(p)] = W_[clos + WDS(p)];
+         p = p + 1;
+
+         goto for;
+    }
+    foreign "C" printf("unpack(4) %p %d\n", clos, len);
+
+
+    return (dat_arr);
+}
+
+unpackClosureInfozh ( P_ closure )
+{
+    W_ info;
+    info = %GET_STD_INFO(UNTAG(closure));
+
+    return (info);
+}
+
+unpackClosurePtrzh ( P_ closure )
+{
+    W_ clos;
+    clos = UNTAG(closure);
+
+    W_ ptrArray;
+
+    ("ptr" ptrArray) = foreign "C" heap_view_closurePtrsAsWords(MyCapability() "ptr", clos "ptr");
+
+    return (ptrArray);
+}
diff --git a/cbits/Heap.c b/cbits/Heap.c
new file mode 100644
--- /dev/null
+++ b/cbits/Heap.c
@@ -0,0 +1,26 @@
+#include <Rts.h>
+#include "rts/storage/Heap.h"
+
+StgArrBytes *heap_view_closurePtrsAsWords(Capability *cap, StgClosure *closure) {
+    ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));
+
+    StgWord size = heap_view_closureSize(closure);
+
+    // First collect all pointers here, with the comfortable memory bound
+    // of the whole closure. Afterwards we know how many pointers are in
+    // the closure and then we can allocate space on the heap and copy them
+    // there
+    StgClosure *ptrs[size];
+    StgWord nptrs = collect_pointers(closure, size, ptrs);
+    StgArrBytes *arr =
+        (StgArrBytes *)allocate(cap, sizeofW(StgArrBytes) + nptrs);
+    TICK_ALLOC_PRIM(sizeofW(StgArrBytes), nptrs, 0);
+    SET_HDR(arr, &stg_ARR_WORDS_info, ((CapabilityPublic *)cap)->r.rCCCS);
+    arr->bytes = sizeof(StgWord) * nptrs;
+
+    for (StgWord i = 0; i<nptrs; i++) {
+        arr->payload[i] = (StgWord)ptrs[i];
+    }
+
+    return arr;
+}
diff --git a/ghc-debug-common.cabal b/ghc-debug-common.cabal
new file mode 100644
--- /dev/null
+++ b/ghc-debug-common.cabal
@@ -0,0 +1,47 @@
+cabal-version:       3.0
+name:                ghc-debug-common
+version:             0.1.0.0
+synopsis:            Connect to a socket created by ghc-debug-stub and analyse
+                     the heap of the debuggee program.
+description:         Connect to a socket created by ghc-debug-stub and analyse
+                     the heap of the debuggee program.
+homepage:            https://gitlab.haskell.org/ghc/ghc-debug
+license:             BSD-3-Clause
+license-file:        LICENSE
+author:              Ben Gamari, Matthew Pickering
+maintainer:          matthewtpickering@gmail.com
+copyright:           (c) 2021 Ben Gamari, Matthew Pickering
+category:            Development
+build-type:          Simple
+extra-source-files:  CHANGELOG.md
+
+library
+  exposed-modules:     GHC.Debug.Decode,
+                       GHC.Debug.Decode.Convert,
+                       GHC.Debug.Decode.Stack,
+                       GHC.Debug.Types,
+                       GHC.Debug.Types.Closures,
+                       GHC.Debug.Types.Graph,
+                       GHC.Debug.Types.Ptr
+  build-depends:       base >=4.12 && <4.14,
+                       bytestring ^>=0.11,
+                       binary ^>=0.8,
+                       array ^>= 0.5,
+                       directory ^>= 1.3 ,
+                       filepath ^>= 1.4,
+                       hashable ^>= 1.3,
+                       ghc-heap >= 9.1,
+                       cpu ^>= 0.1,
+                       containers ^>= 0.6,
+                       transformers ^>= 0.5,
+                       dom-lt ^>= 0.2,
+                       unordered-containers ^>= 0.2,
+                       ghc-debug-convention ^>= 0.1,
+                       deepseq ^>= 1.4
+
+  hs-source-dirs:      src
+  cmm-sources:         cbits/GhcDebug.cmm
+  c-sources:           cbits/Heap.c
+  ghc-options: -Wall
+  default-language:    Haskell2010
+  default-extensions: ApplicativeDo
diff --git a/src/GHC/Debug/Decode.hs b/src/GHC/Debug/Decode.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Debug/Decode.hs
@@ -0,0 +1,286 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE BangPatterns #-}
+-- | Low-level functions for decoding a closure representation from the raw
+-- bytes
+module GHC.Debug.Decode ( decodeClosure
+                        , decodeInfoTable
+                        ) where
+
+import GHC.Ptr (plusPtr, castPtr)
+import GHC.Exts hiding (closureSize#) -- (Addr#, unsafeCoerce#, Any, Word#, ByteArray#)
+import GHC.Word
+import GHC.IO.Unsafe
+import Foreign.Storable
+
+import qualified Data.ByteString.Internal as BSI
+import Data.ByteString.Short.Internal (ShortByteString(..), toShort)
+import qualified Data.ByteString.Lazy as BSL
+
+import GHC.Exts.Heap (GenClosure)
+import GHC.Exts.Heap hiding (GenClosure(..), Closure)
+import qualified GHC.Exts.Heap.InfoTable as Itbl
+import qualified GHC.Exts.Heap.InfoTableProf as ItblProf
+
+import GHC.Debug.Types.Ptr
+import GHC.Debug.Types.Closures
+import GHC.Debug.Decode.Convert
+import Foreign.Marshal.Alloc    (allocaBytes)
+import Foreign.ForeignPtr       (withForeignPtr)
+import Data.Binary.Get as B
+import Data.Binary
+import Control.Monad
+import Data.Void
+import Control.DeepSeq
+
+import qualified Data.ByteString as B
+
+foreign import prim "unpackClosurePtrzh" unpackClosurePtr# ::
+              Addr# -> (# ByteArray# #)
+
+foreign import prim "closureSizezh" closureSize# ::
+              Addr# -> (# Word# #)
+
+getClosureRaw :: StgInfoTable -> Ptr a -> BSI.ByteString -> IO (GenClosure Word, Size)
+getClosureRaw itb (Ptr closurePtr) datString = do
+  let !(# pointers #) = unpackClosurePtr# closurePtr
+      !(# raw_size_wh #) = closureSize# closurePtr
+      raw_size = fromIntegral (W# raw_size_wh) * 8
+  -- Not strictly necessary to take the size of the raw string but its
+  -- a good sanity check. In particular it helps with stack decoding.
+  let !(SBS datArr) = (toShort (B.take raw_size datString))
+  let nelems_ptrs = (I# (sizeofByteArray# pointers)) `div` 8
+      end_ptrs = fromIntegral nelems_ptrs - 1
+      rawPtrs = force [W# (indexWordArray# pointers i) | I# i <- [0.. end_ptrs] ]
+  gen_closure <- getClosureDataFromHeapRepPrim (return ("", "", ""))
+                                               (\_ -> return Nothing) itb datArr  rawPtrs
+  return (gen_closure, Size raw_size)
+
+-- | Allow access directly to the chunk of memory used by a bytestring
+allocate :: BSI.ByteString -> (Ptr a -> IO a) -> IO a
+allocate = allocateByCopy
+
+
+-- | Allocate a bytestring directly into memory and return a pointer to the
+-- allocated buffer
+allocateByCopy :: BSI.ByteString -> (Ptr a -> IO a) -> IO a
+allocateByCopy (BSI.PS fp o l) action =
+ allocaBytes l $ \buf ->
+   withForeignPtr fp $ \p -> do
+     --print (fp, o, l)
+     BSI.memcpy buf (p `plusPtr` o) (fromIntegral l)
+     action (castPtr buf)
+
+skipClosureHeader :: Get ()
+skipClosureHeader
+  | profiling = () <$ skip (8 * 3)
+  | otherwise = () <$ skip (8 * 1)
+
+decodePAPClosure :: (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
+decodePAPClosure (infot, _) (_, rc) = decodeFromBS rc $ do
+  _itbl <- skipClosureHeader
+  carity <- getWord32le
+  nargs <- getWord32le
+  funp <- getClosurePtr
+  cpayload <- replicateM (fromIntegral nargs) getWord64le
+  let cont = PayloadCont funp cpayload
+  return $ (GHC.Debug.Types.Closures.PAPClosure infot carity nargs funp cont)
+
+decodeAPClosure :: (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
+decodeAPClosure (infot, _) (_, rc) = decodeFromBS rc $ do
+  _itbl <- skipClosureHeader
+  _itbl <- skipClosureHeader
+  carity <- getWord32le
+  nargs <- getWord32le
+  funp <- getClosurePtr
+  cpayload <- replicateM (fromIntegral nargs) getWord64le
+  let cont = PayloadCont funp cpayload
+  return $ (GHC.Debug.Types.Closures.APClosure infot carity nargs funp cont)
+
+
+decodeTVarClosure :: (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
+decodeTVarClosure (infot, _) (_, rc) = decodeFromBS rc $ do
+  _itbl <- skipClosureHeader
+  ptr <- getClosurePtr
+  watch_queue <- getClosurePtr
+  updates <- getInt64le
+  return $ (TVarClosure infot ptr watch_queue (fromIntegral updates))
+
+getClosurePtr :: Get ClosurePtr
+getClosurePtr = get
+
+getWord :: Get Word64
+getWord = getWord64le
+
+decodeMutPrim :: (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
+decodeMutPrim (infot, _) (_, rc) = decodeFromBS rc $ do
+  _itbl <- skipClosureHeader
+  let kptrs = fromIntegral (ptrs (decodedTable infot))
+      kdat = fromIntegral (nptrs (decodedTable infot))
+  pts <- replicateM kptrs getClosurePtr
+  dat <- replicateM kdat (fromIntegral <$> getWord64le)
+  return $ (MutPrimClosure infot pts dat)
+
+decodeTrecChunk :: (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
+decodeTrecChunk (infot, _) (_, rc) = decodeFromBS rc $ do
+  _itbl <- skipClosureHeader
+  prev <- getClosurePtr
+  clos_next_idx <- getWord64le
+  chunks <- replicateM (fromIntegral clos_next_idx) getChunk
+  return $ (TRecChunkClosure infot prev (fromIntegral clos_next_idx) chunks)
+  where
+    getChunk = do
+      TRecEntry <$> getClosurePtr
+                <*> getClosurePtr
+                <*> getClosurePtr
+                <*> (fromIntegral <$> getInt64le) -- TODO: num_updates field is wrong
+                                                  -- Not sure how it should
+                                                  -- be decoded
+
+decodeBlockingQueue :: (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
+decodeBlockingQueue (infot, _) (_, rc) = decodeFromBS rc $ do
+  _itbl <- skipClosureHeader
+  q <- getClosurePtr
+  bh <- getClosurePtr
+  tso <- getClosurePtr
+  bh_q <- getClosurePtr
+  return $ (GHC.Debug.Types.Closures.BlockingQueueClosure infot q bh tso bh_q)
+
+-- It is just far simpler to directly decode the stack here rather than use
+-- the existing logic in ghc-heap......
+decodeStack :: (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
+decodeStack (infot, _) (cp, rc) = decodeFromBS rc $ do
+   _itbl <- skipClosureHeader
+   st_size <- getWord32le
+   st_dirty <- getWord8
+   st_marking <- getWord8
+   -- Up to now, 14 bytes are read, skip 2 to get to 16/start of
+   -- sp field
+   skip 2
+   st_sp <- StackPtr <$> getWord
+   stackHeaderSize <- bytesRead
+   let stack_offset = fromIntegral (subtractStackPtr st_sp cp)
+             -- -stackHeaderSize for the bytes already read
+             - fromIntegral stackHeaderSize
+       len = calculateStackLen st_size (fromIntegral stackHeaderSize) cp st_sp
+   -- Skip to start of stack frames
+   skip stack_offset
+   -- Read the raw frames, we can't decode them yet because we
+   -- need to query the debuggee for the bitmaps
+   raw_stack <- RawStack <$> getByteString (fromIntegral len)
+   return (GHC.Debug.Types.Closures.StackClosure
+            infot
+            st_size
+            st_dirty
+            st_marking
+            (StackCont st_sp raw_stack))
+
+decodeFromBS :: RawClosure -> Get (DebugClosure pap string s b)
+                           -> DebugClosureWithExtra Size pap string s b
+decodeFromBS (RawClosure rc) parser =
+  case runGetOrFail parser (BSL.fromStrict rc) of
+    Left err -> error ("DEC:" ++ show err ++ printBS rc)
+    Right (_rem, o, v) ->
+      let !s = fromIntegral o
+      in DCS (Size s) v
+
+decodeAPStack :: (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
+decodeAPStack (infot, _) (ClosurePtr cp, rc) = decodeFromBS rc $ do
+  _itbl <- skipClosureHeader
+  _itbl <- skipClosureHeader
+  st_size <- getWord
+  fun_closure <- getClosurePtr
+  k <- bytesRead
+  let sp = addStackPtr (StackPtr cp) (fromIntegral k)
+  clos_payload <- RawStack <$> getByteString (fromIntegral st_size)
+  return $ GHC.Debug.Types.Closures.APStackClosure
+              infot
+              (fromIntegral st_size)
+              fun_closure
+              (StackCont sp clos_payload)
+
+decodeStandardLayout :: Get ()
+                     -> ([ClosurePtr] -> [Word] -> Closure)
+                     -> (StgInfoTableWithPtr, RawInfoTable)
+                     -> (ClosurePtr, RawClosure)
+                     -> SizedClosure
+decodeStandardLayout extra k (infot, _) (_, rc) = decodeFromBS rc $ do
+  _itbl <- skipClosureHeader
+  -- For the THUNK header
+  extra
+  pts <- replicateM (fromIntegral (ptrs (decodedTable infot))) getClosurePtr
+  cwords <- replicateM (fromIntegral (nptrs (decodedTable infot))) getWord
+  return $ k pts (map fromIntegral cwords)
+
+decodeClosure :: (StgInfoTableWithPtr, RawInfoTable) -> (ClosurePtr, RawClosure) ->  SizedClosure
+decodeClosure i@(itb, _) c
+  -- MP: It was far easier to implement the decoding of these closures in
+  -- ghc-heap using binary rather than patching GHC and going through that
+  -- dance. I think in the future it's better to do this for all the
+  -- closures... it's simpler and probably much faster.
+  | (StgInfoTable { tipe = PAP }) <- decodedTable itb = decodePAPClosure i c
+  | (StgInfoTable { tipe = AP }) <- decodedTable itb = decodeAPClosure i c
+  | (StgInfoTable { tipe = TVAR }) <- decodedTable itb = decodeTVarClosure i c
+  | (StgInfoTable { tipe = MUT_PRIM }) <- decodedTable itb = decodeMutPrim i c
+  | (StgInfoTable { tipe = TREC_CHUNK }) <- decodedTable itb = decodeTrecChunk i c
+  | (StgInfoTable { tipe = BLOCKING_QUEUE }) <- decodedTable itb = decodeBlockingQueue i c
+  | (StgInfoTable { tipe = STACK }) <- decodedTable itb = decodeStack i c
+  | (StgInfoTable { tipe = AP_STACK }) <- decodedTable itb = decodeAPStack i c
+  | (StgInfoTable { tipe = ty }) <- decodedTable itb
+  , CONSTR <= ty && ty <= CONSTR_0_2 =
+      decodeStandardLayout (return ()) (\pts ws -> ConstrClosure itb pts ws (tableId itb)) i c
+  | (StgInfoTable { tipe = ty }) <- decodedTable itb
+  , CONSTR <= ty && ty <= CONSTR_NOCAF =
+      decodeStandardLayout (return ()) (\pts ws -> ConstrClosure itb pts ws (tableId itb)) i c
+  | (StgInfoTable { tipe = ty }) <- decodedTable itb
+  , FUN <= ty && ty <= FUN_STATIC =
+      decodeStandardLayout (return ()) (FunClosure itb) i c
+  | (StgInfoTable { tipe = ty }) <- decodedTable itb
+  , THUNK <= ty && ty <= THUNK_0_2 =
+      decodeStandardLayout (() <$ getWord) (ThunkClosure itb) i c
+decodeClosure (itb, RawInfoTable rit) (_, (RawClosure clos)) = unsafePerformIO $ do
+    allocate rit $ \itblPtr -> do
+      allocate clos $ \closPtr -> do
+        let ptr_to_itbl_ptr :: Ptr (Ptr StgInfoTable)
+            ptr_to_itbl_ptr = castPtr closPtr
+        -- The pointer is to the end of the info table (not the start)
+        -- Info table is two words long which is why we subtract 16 from
+        -- the pointer
+        --print (itblPtr, closPtr)
+        poke ptr_to_itbl_ptr (fixTNTC itblPtr)
+        -- You should be able to print these addresses in gdb
+        -- and observe the memory layout is identical to the debugee
+        -- process
+        -- Printing this return value can lead to segfaults because the
+        -- pointer for constrDesc won't point to a string after being
+        -- decoded.
+        --print (tipe (decodedTable itb), ptr, closPtr, itblPtr)
+        (!r, !s) <- getClosureRaw (decodedTable itb) closPtr clos
+        -- Mutate back the ByteArray as if we attempt to use it again then
+        -- the itbl pointer will point somewhere into our address space
+        -- rather than the debuggee address space
+        --
+        return $ DCS s . quadmap absurd
+                        id
+                        absurd
+                        mkClosurePtr . convertClosure itb
+          $ fmap (\(W# w) -> (W64# w)) r
+
+
+fixTNTC :: Ptr a -> Ptr StgInfoTable
+fixTNTC ptr
+  | tablesNextToCode = castPtr $ ptr  `plusPtr` realItblSize
+  | otherwise        = castPtr $ ptr
+
+realItblSize :: Int
+realItblSize
+  | profiling  = ItblProf.itblSize
+  | otherwise  = Itbl.itblSize
+
+decodeInfoTable :: RawInfoTable -> StgInfoTable
+decodeInfoTable (RawInfoTable itbl) = unsafePerformIO $ do
+  allocate itbl $ \itblPtr -> do
+    peekItbl itblPtr
diff --git a/src/GHC/Debug/Decode/Convert.hs b/src/GHC/Debug/Decode/Convert.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Debug/Decode/Convert.hs
@@ -0,0 +1,49 @@
+{- Convert a GenClosure to a DebugClosure -}
+module GHC.Debug.Decode.Convert where
+
+import qualified GHC.Exts.Heap as GHC
+
+import GHC.Debug.Types.Closures
+import GHC.Debug.Types.Ptr
+import Data.Void
+
+-- | Convert a GenClosure from ghc-heap to a 'DebugClosure',
+convertClosure :: (Num a, Eq a, Show a) => StgInfoTableWithPtr -> GHC.GenClosure a -> DebugClosure Void InfoTablePtr Void a
+convertClosure itb g =
+  case g of
+    GHC.ConstrClosure _ a2 a3 _ _ _ -> ConstrClosure itb a2 a3 (tableId itb)
+    GHC.FunClosure _ a2 a3             -> FunClosure itb a2 a3
+    GHC.ThunkClosure _ a2 a3           -> ThunkClosure itb a2 a3
+    GHC.SelectorClosure _ a2           -> SelectorClosure itb a2
+--    GHC.PAPClosure _ a2 a3 a4 a5       -> PAPClosure itb a2 a3 a4 a5
+--    GHC.APClosure _ a2 a3 a4 a5        -> APClosure itb a2 a3 a4 a5
+--    GHC.APStackClosure _ a2 a3         -> APStackClosure itb a2
+    GHC.IndClosure _ a2                -> IndClosure itb a2
+    GHC.BCOClosure _ a2 a3 a4 a5 a6 a7 -> BCOClosure itb a2 a3 a4 a5 a6 a7
+    GHC.BlackholeClosure _ a2          -> BlackholeClosure itb a2
+    GHC.ArrWordsClosure _ a2 a3        -> ArrWordsClosure itb a2 a3
+    GHC.MutArrClosure _ a2 a3 a4       -> MutArrClosure itb a2 a3 a4
+    GHC.SmallMutArrClosure _ a2 a3     -> SmallMutArrClosure itb a2 a3
+    GHC.MVarClosure _ a2 a3 a4         -> MVarClosure itb a2 a3 a4
+    GHC.MutVarClosure _ a2             -> MutVarClosure itb a2
+    GHC.BlockingQueueClosure _ a2 a3 a4 a5 -> BlockingQueueClosure itb a2 a3 a4 a5
+    GHC.TSOClosure _ a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 -> TSOClosure itb a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16
+--    GHC.StackClosure _ a2 a3 a4 a5      -> StackClosure itb a2 a3 a4 (a2, (StackPtr a5))
+{-
+    GHC.IntClosure a1 a2                -> IntClosure a1 a2
+    GHC.WordClosure a1 a2               -> WordClosure a1 a2
+    GHC.Int64Closure a1 a2              -> Int64Closure a1 a2
+    GHC.Word64Closure a1 a2             -> Word64Closure a1 a2
+    GHC.AddrClosure a1 a2               -> AddrClosure a1 a2
+    GHC.FloatClosure a1 a2              -> FloatClosure a1 a2
+    GHC.DoubleClosure a1 a2             -> DoubleClosure a1 a2
+    -}
+    GHC.OtherClosure _ a2 a3           -> OtherClosure itb a2 a3
+    GHC.WeakClosure _ a2 a3 a4 a5 a6   ->
+      -- nullPtr check
+      let w_link = if a6 == 0
+                  then Nothing
+                  else Just a6
+      in WeakClosure itb a2 a3 a4 a5 w_link
+    GHC.UnsupportedClosure _           -> UnsupportedClosure itb
+    c -> error ("Unexpected closure type: " ++ show c)
diff --git a/src/GHC/Debug/Decode/Stack.hs b/src/GHC/Debug/Decode/Stack.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Debug/Decode/Stack.hs
@@ -0,0 +1,62 @@
+module GHC.Debug.Decode.Stack
+  ( decodeStack
+  ) where
+
+import Data.Word
+import qualified Data.ByteString as BS
+
+import Data.Binary.Get as B
+
+import GHC.Debug.Types
+import Control.Monad
+
+import Data.Coerce
+
+decodeStack :: Monad m
+            => (RawClosure -> m StgInfoTableWithPtr) -- ^ How to decode the info table for the stack frame
+            -> (Word32 -> m PtrBitmap) -- ^ How to decode the bitmap for the stack frame at a given offset
+            -> RawStack
+            -> m StackFrames
+decodeStack decodeInfoTable getBitmap rs = do
+  GenStackFrames <$> get_frames 0 rs
+  where
+    get_frames sp raw@(RawStack c) = do
+      st_it <- decodeInfoTable (coerce raw)
+      bm <- getBitmap sp
+      let res = B.runGetIncremental (getFrame bm st_it) `pushChunk` c
+      case res of
+        Fail _rem _offset err -> error err
+        Partial _inp -> error "Not enough input"
+        Done more offset v
+          | BS.null more -> return []
+          | otherwise -> (v:) <$> get_frames (sp + (fromIntegral offset)) (RawStack more)
+
+getFrame :: PtrBitmap
+         -> StgInfoTableWithPtr
+         -> Get (DebugStackFrame ClosurePtr)
+getFrame st_bitmap itbl =
+    case tipe (decodedTable itbl) of
+      RET_BCO ->
+        -- TODO: In the case of a RET_BCO frame we must decode the frame as a BCO
+        -- MP: If you trigger this case, then the decoding logic might
+        -- already work but I have never encountered a stack frame with
+        -- this type to test it. You might also need to modify `stub.cpp`
+        -- but that should be straightforward.
+        error "getStack: RET_BCO"
+      ty -> do
+        -- In all other cases we request the pointer bitmap from the debuggee
+        -- and decode as appropriate.
+        --traceShowM (headerSize ty, ty, st_bitmap, itbl)
+        _itblPtr <- replicateM (headerSize ty) getWord64le
+        fields <- traversePtrBitmap decodeField st_bitmap
+        return (DebugStackFrame itbl fields)
+  where
+    decodeField True  = SPtr . mkClosurePtr <$> getWord
+    decodeField False = SNonPtr <$> getWord
+
+    headerSize RET_FUN = 3
+    headerSize RET_BCO = 2
+    headerSize _ = 1
+
+getWord :: Get Word64
+getWord = getWord64le -- TODO word size
diff --git a/src/GHC/Debug/Types.hs b/src/GHC/Debug/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Debug/Types.hs
@@ -0,0 +1,471 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE BangPatterns #-}
+
+module GHC.Debug.Types(module T
+                      , Request(..)
+                      , ForkOrPause(..)
+                      , requestCommandId
+                      , doRequest
+                      , isWriteRequest
+                      , withWriteRequest
+                      , isImmutableRequest
+                      , AnyReq(..)
+                      , AnyResp(..)
+                      , CommandId(..)
+                      , SourceInformation(..)
+                      , ClosureType(..)
+
+                      -- * Serialisation functions
+                      , getIPE
+                      , putIPE
+                      , getInfoTable
+                      , putInfoTable
+                      , putRequest
+                      , getRequest ) where
+
+import Control.Applicative
+import Control.Exception
+import Control.Monad
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as C8
+import Data.Word
+import System.IO
+
+import Data.Binary
+import Data.Binary.Put
+import Data.Binary.Get
+import Data.Hashable
+
+import GHC.Debug.Types.Closures as T
+import GHC.Debug.Types.Ptr as T
+import GHC.Exts.Heap.ClosureTypes
+import GHC.Debug.Decode
+import Control.Concurrent
+import Debug.Trace
+
+-- | The decision about whether to fork the running process or
+-- pause it running whilst we are debugging it.
+data ForkOrPause = Pause | Fork deriving (Eq, Ord, Show, Enum)
+
+instance Hashable ForkOrPause where
+  hashWithSalt s v = s `hashWithSalt` (fromEnum v)
+
+instance Binary ForkOrPause where
+  put     = putWord8 . fromIntegral . fromEnum
+  get     = getWord8 >>= toBool
+    where
+      toBool 0 = return (toEnum 0)
+      toBool 1 = return (toEnum 1)
+      toBool c = fail ("Could not map value " ++ show c ++ " to ForkOrPause")
+
+
+-- | A request sent from the debugger to the debuggee parametrized on the result type.
+data Request a where
+    -- | Request protocol version
+    RequestVersion :: Request Word32
+    -- | Pause the debuggee.
+    RequestPause :: ForkOrPause -> Request ()
+    -- | Resume the debuggee.
+    RequestResume :: Request ()
+    -- | Request the debuggee's root pointers.
+    RequestRoots :: Request [ClosurePtr]
+    -- | Request a closure
+    RequestClosure :: ClosurePtr -> Request RawClosure
+    -- | Request an info table
+    RequestInfoTable :: InfoTablePtr -> Request (StgInfoTableWithPtr, RawInfoTable)
+    -- | Wait for the debuggee to pause itself and then
+    -- execute an action. It currently impossible to resume after
+    -- a pause caused by a poll.
+    RequestPoll :: Request ()
+    -- | A client can save objects by calling a special RTS method
+    -- This function returns the closures it saved.
+    RequestSavedObjects :: Request [ClosurePtr]
+    -- | Request the pointer bitmap for a stack frame at a given offset
+    -- from a StackPtr.
+    RequestStackBitmap :: StackPtr -> Word32 -> Request PtrBitmap
+    -- | Decode the bitmap contained in a StgFunInfoTable
+    -- Used by PAP and AP closure types.
+    RequestFunBitmap :: Word16 -> ClosurePtr -> Request PtrBitmap
+    -- | Request the constructor description for an info table.
+    -- The info table must be from a 'ConstrClosure'
+    RequestConstrDesc :: InfoTablePtr -> Request ConstrDesc
+    -- | Lookup source information of an info table
+    RequestSourceInfo :: InfoTablePtr -> Request (Maybe SourceInformation)
+    -- | Copy all blocks from the process at once
+    RequestAllBlocks :: Request [RawBlock]
+    -- | Request the block which contains a specific pointer
+    RequestBlock :: ClosurePtr -> Request RawBlock
+
+data SourceInformation = SourceInformation { infoName        :: !String
+                                         , infoClosureType :: !ClosureType
+                                         , infoType        :: !String
+                                         , infoLabel       :: !String
+                                         , infoModule      :: !String
+                                         , infoPosition    :: !String }
+                                         deriving (Show, Eq, Ord)
+
+eq1request :: Request a -> Request b -> Bool
+eq1request r1 r2 =
+  case r1 of
+    RequestVersion -> case r2 of {RequestVersion -> True; _ -> False}
+    RequestPause f1 -> case r2 of {RequestPause f2 -> f1 == f2; _ -> False }
+    RequestResume  -> case r2 of {RequestResume -> True; _ -> False }
+    RequestRoots   -> case r2 of {RequestRoots -> True; _ -> False }
+    RequestClosure cs -> case r2 of {(RequestClosure cs') -> cs == cs'; _ -> False }
+    RequestInfoTable itp -> case r2 of { (RequestInfoTable itp') ->  itp == itp'; _ -> False }
+    RequestPoll           -> case r2 of { RequestPoll -> True; _ -> False }
+    RequestSavedObjects    -> case r2 of {RequestSavedObjects -> True; _ -> False }
+    RequestStackBitmap p o      -> case r2 of {(RequestStackBitmap p' o') -> p == p' && o == o'; _ -> False }
+    RequestFunBitmap n cp    -> case r2 of {(RequestFunBitmap n' cp') -> n == n' && cp == cp'; _ -> False }
+    RequestConstrDesc cp   -> case r2 of { (RequestConstrDesc cp') -> cp == cp'; _ -> False }
+    RequestSourceInfo itp  -> case r2 of { (RequestSourceInfo itp') -> itp == itp'; _ -> False }
+    RequestAllBlocks       -> case r2 of { RequestAllBlocks -> True; _ -> False }
+    RequestBlock cp        -> case r2 of { RequestBlock cp' -> cp == cp'; _ -> False }
+
+-- | Whether a request mutates the debuggee state, don't cache these ones
+isWriteRequest :: Request a -> Bool
+isWriteRequest r = getConst $ withWriteRequest r (Const False) (const (Const True))
+
+withWriteRequest :: Request a -> r a -> ((a ~ ()) => Request a -> r a) -> r a
+withWriteRequest r def k =
+  case r of
+    RequestPause f -> k (RequestPause f)
+    RequestResume -> k RequestResume
+    RequestPoll -> k RequestPoll
+    _ -> def
+
+-- | Requests which will always answer the same.
+-- For example, info tables are immutable and so requesting an info table
+-- will always result in the same value and is safe to cache across pause
+-- lines.
+isImmutableRequest :: Request a -> Bool
+isImmutableRequest r =
+  case r of
+    RequestVersion {} -> True
+    RequestInfoTable {} -> True
+    RequestSourceInfo {} -> True
+    RequestConstrDesc {} -> True
+    _ -> False
+
+
+deriving instance Show (Request a)
+deriving instance Eq (Request a)
+
+instance Hashable (Request a) where
+  hashWithSalt s r = case r of
+    RequestVersion ->  s `hashWithSalt` cmdRequestVersion
+    RequestPause f ->  s `hashWithSalt` f `hashWithSalt` cmdRequestPause
+    RequestResume  ->  s `hashWithSalt` cmdRequestResume
+    RequestRoots   -> s `hashWithSalt` cmdRequestRoots
+    RequestClosure cs -> s `hashWithSalt` cmdRequestClosures `hashWithSalt` cs
+    RequestInfoTable itp -> s `hashWithSalt` cmdRequestInfoTables `hashWithSalt` itp
+    RequestPoll           -> s `hashWithSalt` cmdRequestPoll
+    RequestSavedObjects    -> s `hashWithSalt` cmdRequestSavedObjects
+    RequestStackBitmap p o -> s `hashWithSalt` cmdRequestStackBitmap `hashWithSalt` p `hashWithSalt` o
+    RequestFunBitmap n cp  -> s `hashWithSalt` cmdRequestFunBitmap `hashWithSalt` cp `hashWithSalt` n
+    RequestConstrDesc cp   -> s `hashWithSalt` cmdRequestConstrDesc `hashWithSalt` cp
+    RequestSourceInfo itp  -> s `hashWithSalt` cmdRequestSourceInfo `hashWithSalt` itp
+    RequestAllBlocks       -> s `hashWithSalt` cmdRequestAllBlocks
+    RequestBlock cp        -> s `hashWithSalt` cmdRequestBlock `hashWithSalt` cp
+
+
+newtype CommandId = CommandId Word32
+                  deriving (Eq, Ord, Show)
+                  deriving newtype (Binary, Hashable)
+
+requestCommandId :: Request a -> CommandId
+requestCommandId r = case r of
+    RequestVersion {} -> cmdRequestVersion
+    RequestPause {}   -> cmdRequestPause
+    RequestResume {}  -> cmdRequestResume
+    RequestRoots {}   -> cmdRequestRoots
+    RequestClosure {}  -> cmdRequestClosures
+    RequestInfoTable {}  -> cmdRequestInfoTables
+    RequestPoll {}         -> cmdRequestPoll
+    RequestSavedObjects {} -> cmdRequestSavedObjects
+    RequestStackBitmap {}       -> cmdRequestStackBitmap
+    RequestFunBitmap {}       -> cmdRequestFunBitmap
+    RequestConstrDesc {}   -> cmdRequestConstrDesc
+    RequestSourceInfo {}   -> cmdRequestSourceInfo
+    RequestAllBlocks {} -> cmdRequestAllBlocks
+    RequestBlock {} -> cmdRequestBlock
+
+cmdRequestVersion :: CommandId
+cmdRequestVersion = CommandId 1
+
+cmdRequestPause :: CommandId
+cmdRequestPause = CommandId 2
+
+cmdRequestResume :: CommandId
+cmdRequestResume = CommandId 3
+
+cmdRequestRoots :: CommandId
+cmdRequestRoots = CommandId 4
+
+cmdRequestClosures :: CommandId
+cmdRequestClosures = CommandId 5
+
+cmdRequestInfoTables :: CommandId
+cmdRequestInfoTables = CommandId 6
+
+cmdRequestStackBitmap :: CommandId
+cmdRequestStackBitmap = CommandId 7
+
+cmdRequestPoll :: CommandId
+cmdRequestPoll = CommandId 8
+
+cmdRequestSavedObjects :: CommandId
+cmdRequestSavedObjects = CommandId 9
+
+cmdRequestConstrDesc :: CommandId
+cmdRequestConstrDesc = CommandId 11
+
+cmdRequestSourceInfo :: CommandId
+cmdRequestSourceInfo = CommandId 12
+
+cmdRequestAllBlocks :: CommandId
+cmdRequestAllBlocks = CommandId 14
+
+cmdRequestBlock :: CommandId
+cmdRequestBlock = CommandId 15
+
+cmdRequestFunBitmap :: CommandId
+cmdRequestFunBitmap = CommandId 16
+
+data AnyReq = forall req . AnyReq !(Request req)
+
+instance Hashable AnyReq where
+  hashWithSalt s (AnyReq r) = hashWithSalt s r
+
+instance Eq AnyReq where
+  (AnyReq r1) == (AnyReq r2) = eq1request r1 r2
+
+data AnyResp = forall a . AnyResp !a !(a -> Put)
+
+putCommand :: CommandId -> Put -> Put
+putCommand c body = do
+    putWord32be $ fromIntegral (4 + BSL.length body')
+    put c
+    putLazyByteString body'
+  where
+    body' = runPut body
+
+putRequest :: Request a -> Put
+putRequest RequestVersion        = putCommand cmdRequestVersion mempty
+putRequest (RequestPause p)      = putCommand cmdRequestPause (put p)
+putRequest RequestResume         = putCommand cmdRequestResume mempty
+putRequest RequestRoots          = putCommand cmdRequestRoots mempty
+putRequest (RequestClosure cs)  =
+  putCommand cmdRequestClosures $ do
+    putWord16be 1
+    put cs
+putRequest (RequestInfoTable ts) =
+  putCommand cmdRequestInfoTables $ do
+    putWord16be 1
+    put ts
+putRequest (RequestStackBitmap sp o)       =
+  putCommand cmdRequestStackBitmap $ put sp >> putWord32be o
+putRequest (RequestFunBitmap n cp)       =
+  putCommand cmdRequestFunBitmap $ put cp >> putWord16be n
+putRequest (RequestConstrDesc itb) =
+  putCommand cmdRequestConstrDesc $ put itb
+putRequest RequestPoll           = putCommand cmdRequestPoll mempty
+putRequest RequestSavedObjects   = putCommand cmdRequestSavedObjects mempty
+--putRequest (RequestFindPtr c)       =
+--  putCommand cmdRequestFindPtr $ put c
+putRequest (RequestSourceInfo it) = putCommand cmdRequestSourceInfo $ put it
+putRequest (RequestAllBlocks) = putCommand cmdRequestAllBlocks $ return ()
+putRequest (RequestBlock cp)  = putCommand cmdRequestBlock $ put cp
+
+-- This is used to serialise the RequestCache
+getRequest :: Get AnyReq
+getRequest = do
+  len <- getWord32be
+  isolate (fromIntegral len) $ do
+    cmd <- get
+    if
+      | cmd == cmdRequestVersion -> return (AnyReq RequestVersion)
+      | cmd == cmdRequestPause   -> do
+          b <- get
+          return (AnyReq (RequestPause b))
+      | cmd == cmdRequestResume  -> return (AnyReq RequestResume)
+      | cmd == cmdRequestRoots   -> return (AnyReq RequestRoots)
+      | cmd == cmdRequestClosures -> do
+          _n <- getWord16be
+--          cs <- replicateM (fromIntegral n) get
+          cp <- get
+          return (AnyReq (RequestClosure cp))
+      | cmd == cmdRequestInfoTables -> do
+          _n <- getWord16be
+          --itbs <- replicateM (fromIntegral n) get
+          itb <- get
+          return (AnyReq (RequestInfoTable itb))
+      | cmd == cmdRequestStackBitmap -> do
+          sp <- get
+          o  <- getWord32be
+          return (AnyReq (RequestStackBitmap sp o))
+      | cmd == cmdRequestFunBitmap -> do
+          cp <- get
+          n <- getWord16be
+          return (AnyReq (RequestFunBitmap n cp))
+      | cmd == cmdRequestConstrDesc -> do
+          itb <- get
+          return (AnyReq (RequestConstrDesc itb))
+      | cmd == cmdRequestPoll -> return (AnyReq RequestPoll)
+      | cmd == cmdRequestSavedObjects -> return (AnyReq RequestSavedObjects)
+      | cmd == cmdRequestSourceInfo -> do
+          it <- get
+          return (AnyReq (RequestSourceInfo it))
+      | cmd == cmdRequestAllBlocks -> return (AnyReq RequestAllBlocks)
+      | cmd == cmdRequestBlock -> do
+            cp <- get
+            return (AnyReq (RequestBlock cp))
+      | otherwise -> error (show cmd)
+
+
+getResponse :: Request a -> Get a
+getResponse RequestVersion       = getWord32be
+getResponse RequestPause {}      = get
+getResponse RequestResume        = get
+getResponse RequestRoots         = many get
+getResponse (RequestClosure {}) = get
+getResponse (RequestInfoTable itbp) = (\(it, r) -> (StgInfoTableWithPtr itbp it, r)) <$> getInfoTable
+--    zipWith (\p (it, r) -> (StgInfoTableWithPtr p it, r)) itps
+--      <$> replicateM (length itps) getInfoTable
+getResponse (RequestStackBitmap {}) = get
+getResponse (RequestFunBitmap {}) = get
+getResponse (RequestConstrDesc _)  = getConstrDesc
+getResponse RequestPoll          = get
+getResponse RequestSavedObjects  = many get
+getResponse (RequestSourceInfo _c) = getIPE
+getResponse RequestAllBlocks = many get
+getResponse RequestBlock {}  = get
+
+
+getConstrDesc :: Get ConstrDesc
+getConstrDesc = do
+  len <- getInt32be
+  parseConstrDesc . C8.unpack <$> getByteString (fromIntegral len)
+
+getIPE :: Get (Maybe SourceInformation)
+getIPE = do
+  num <- getInt32be
+  res <- replicateM (fromIntegral num) getOne
+  case res of
+    (id_name:cty:ty:lab:modu:loc:[]) ->
+      return . Just $! SourceInformation id_name (readCTy cty) ty lab modu loc
+    [] -> return Nothing
+    fs -> fail (show ("Expecting 6 or 0 fields in IPE" :: String,  fs,num))
+  where
+    getOne = do
+      !len <- getInt32be
+      !res <- C8.unpack <$> getByteString (fromIntegral len)
+      return res
+    -- All constructor nodes get 0, this is a wibble in the implementation
+    -- of IPEs
+    readCTy "0" = CONSTR
+    readCTy n   = toEnum (read @Int n)
+
+putIPE :: Maybe SourceInformation -> Put
+putIPE Nothing = putInt32be 0
+putIPE (Just (SourceInformation a ty b c d e)) = do
+  putInt32be 6
+  putOne a
+  putOne (show (fromEnum ty))
+  putOne b
+  putOne c
+  putOne d
+  putOne e
+  where
+    putOne s = do
+      putInt32be (fromIntegral $ length s)
+      putByteString (C8.pack s)
+
+
+
+
+getInfoTable :: Get (StgInfoTable, RawInfoTable)
+getInfoTable = do
+  !len <- getInt32be
+  !r <- RawInfoTable <$> getByteString (fromIntegral len)
+  let !it = decodeInfoTable r
+  return (it, r)
+
+putInfoTable :: RawInfoTable -> Put
+putInfoTable (RawInfoTable rc) = do
+  let n = BS.length rc
+  putWord32be (fromIntegral n)
+  putByteString rc
+
+
+
+data Error = BadCommand
+           | BadStack
+           | AlreadyPaused
+           | NotPaused
+           | NoResume
+           deriving stock (Eq, Ord, Show)
+
+instance Exception Error
+
+data ResponseCode = Okay
+                  | OkayContinues
+                  | Error Error
+                  deriving stock (Eq, Ord, Show)
+
+getResponseCode :: Get ResponseCode
+getResponseCode = getWord16be >>= f
+  where
+    f 0x0   = pure Okay
+    f 0x1   = pure OkayContinues
+    f 0x100 = pure $ Error BadCommand
+    f 0x104 = pure $ Error BadStack
+    f 0x101 = pure $ Error AlreadyPaused
+    f 0x102 = pure $ Error NotPaused
+    f 0x103 = pure $ Error NoResume
+    f _     = fail "Unknown response code"
+
+data Stream a r = Next !a (Stream a r)
+                | End r
+
+readFrames :: Handle -> IO (Stream BS.ByteString (Maybe Error))
+readFrames hdl = do
+    (respLen, status) <- runGet frameHeader <$> BSL.hGet hdl 6
+    respBody <- BS.hGet hdl (fromIntegral respLen)
+    case status of
+      OkayContinues -> do rest <- readFrames hdl
+                          return $ Next respBody rest
+      Okay     -> return $ Next respBody (End Nothing)
+      Error err-> return $ End (Just err)
+  where
+    frameHeader :: Get (Word32, ResponseCode)
+    frameHeader =
+      (,) <$> getWord32be
+          <*> getResponseCode
+
+throwStream :: Exception e => Stream a (Maybe e) -> [a]
+throwStream = f
+  where
+    f (Next x rest)  = x : f rest
+    f (End Nothing)  = []
+    f (End (Just e)) = throw e
+
+concatStream :: Stream BS.ByteString (Maybe Error) -> BSL.ByteString
+concatStream = BSL.fromChunks . throwStream
+
+-- | Perform a request
+doRequest :: MVar Handle -> Request a -> IO a
+doRequest mhdl req = withMVar mhdl $ \hdl -> do
+    BSL.hPutStr hdl $ runPut $ putRequest req
+    bframes <- readFrames hdl
+    let x = runGet (getResponse req) (concatStream bframes)
+    return x
diff --git a/src/GHC/Debug/Types/Closures.hs b/src/GHC/Debug/Types/Closures.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Debug/Types/Closures.hs
@@ -0,0 +1,486 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{- | The Haskell representation of a heap closure, the 'DebugClosure' type
+- is quite similar to the one found in the @ghc-heap@ package but with some
+- more type parameters and other changes..
+-}
+module GHC.Debug.Types.Closures (
+    -- * Closure Representation
+      Closure
+    , SizedClosure
+    , SizedClosureC
+    , DebugClosure(..)
+    , TRecEntry(..)
+    -- * Wrappers
+    , DebugClosureWithSize
+    , DebugClosureWithExtra(..)
+    , Size(..)
+    , InclusiveSize(..)
+    , RetainerSize(..)
+    , noSize
+    , dcSize
+    , allClosures
+    -- * Info Table Representation
+    , StgInfoTable(..)
+    , GHC.ClosureType(..)
+    , StgInfoTableWithPtr(..)
+    -- * Stack Frame Representation
+    , DebugStackFrame(..)
+    , FieldValue(..)
+    , GenStackFrames(..)
+    , StackFrames
+    , StackCont(..)
+    -- * PAP payload representation
+    , GenPapPayload(..)
+    , PapPayload
+    , PayloadCont(..)
+    -- * Constructor Description Representation
+    , ConstrDesc(..)
+    , ConstrDescCont
+    , parseConstrDesc
+
+    -- * Traversing functions
+    , Quadtraversable(..)
+    , quadmap
+    ) where
+
+import Prelude -- See note [Why do we import Prelude here?]
+-- TODO: Support profiling
+--import qualified GHC.Exts.Heap.InfoTableProf as ItblProf
+import GHC.Exts.Heap.InfoTable
+import qualified GHC.Exts.Heap as GHC
+import GHC.Exts.Heap.ProfInfo.Types as ProfTypes
+
+
+import Data.Functor.Identity
+import Data.Int
+import Data.Word
+import GHC.Exts
+import GHC.Generics
+import GHC.Debug.Types.Ptr
+import Data.List (sortBy, intercalate)
+import Data.Char
+import Data.Kind
+
+import Control.Applicative
+import Data.Monoid
+
+
+------------------------------------------------------------------------
+-- Closures
+
+
+type Closure = DebugClosure PayloadCont ConstrDescCont StackCont ClosurePtr
+type SizedClosure = DebugClosureWithSize PayloadCont ConstrDescCont StackCont ClosurePtr
+type SizedClosureC = DebugClosureWithSize PayloadCont ConstrDesc StackCont ClosurePtr
+
+-- | Information needed to decode a 'ConstrDesc'
+type ConstrDescCont = InfoTablePtr
+
+-- | Information needed to decode a PAP payload
+data PayloadCont = PayloadCont ClosurePtr [Word64] deriving Show
+
+type DebugClosureWithSize = DebugClosureWithExtra Size
+
+data DebugClosureWithExtra x pap string s b = DCS { extraDCS :: x
+                                              , unDCS :: DebugClosure pap string s b }
+    deriving (Show, Ord, Eq)
+
+-- | Exclusive size
+newtype Size = Size { getSize :: Int }
+  deriving stock (Show, Generic)
+  deriving (Semigroup, Monoid) via (Sum Int)
+  deriving newtype (Num, Ord, Eq)
+
+newtype InclusiveSize = InclusiveSize { getInclusiveSize :: Int }
+  deriving stock (Show, Generic)
+  deriving (Semigroup, Monoid) via (Sum Int)
+
+newtype RetainerSize = RetainerSize { getRetainerSize :: Int }
+  deriving stock (Show, Generic, Ord, Eq)
+  deriving (Semigroup, Monoid) via (Sum Int)
+
+
+noSize :: DebugClosureWithSize pap string s b -> DebugClosure pap string s b
+noSize = unDCS
+
+dcSize :: DebugClosureWithSize pap string s b -> Size
+dcSize = extraDCS
+
+instance Quadtraversable (DebugClosureWithExtra x) where
+  quadtraverse f g h i (DCS x v) = DCS x <$> quadtraverse f g h i v
+
+data StgInfoTableWithPtr = StgInfoTableWithPtr {
+                              tableId :: InfoTablePtr
+                            , decodedTable :: StgInfoTable
+                            } deriving (Show)
+
+instance Ord StgInfoTableWithPtr where
+  compare t1 t2 = compare (tableId t1) (tableId t2)
+
+instance Eq StgInfoTableWithPtr where
+  t1 == t2 = tableId t1 == tableId t2
+
+
+-- | This is the representation of a Haskell value on the heap. It reflects
+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/Closures.h>
+--
+-- The data type is parametrized by 4 type parameters which correspond to
+-- different pointer types.
+--
+-- All Heap objects have the same basic layout. A header containing a pointer
+-- to the info table and a payload with various fields. The @info@ field below
+-- always refers to the info table pointed to by the header. The remaining
+-- fields are the payload.
+--
+-- See
+-- <https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/storage/heap-objects>
+-- for more information.
+data DebugClosure pap string s b
+  = -- | A data constructor
+    ConstrClosure
+        { info       :: !StgInfoTableWithPtr
+        , ptrArgs    :: ![b]            -- ^ Pointer arguments
+        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments
+        , constrDesc :: !string
+        }
+
+    -- | A function
+  | FunClosure
+        { info       :: !StgInfoTableWithPtr
+        , ptrArgs    :: ![b]            -- ^ Pointer arguments
+        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments
+        }
+
+    -- | A thunk, an expression not obviously in head normal form
+  | ThunkClosure
+        { info       :: !StgInfoTableWithPtr
+        , ptrArgs    :: ![b]            -- ^ Pointer arguments
+        , dataArgs   :: ![Word]         -- ^ Non-pointer arguments
+        }
+
+    -- | A thunk which performs a simple selection operation
+  | SelectorClosure
+        { info       :: !StgInfoTableWithPtr
+        , selectee   :: !b              -- ^ Pointer to the object being
+                                        --   selected from
+        }
+
+    -- | An unsaturated function application
+  | PAPClosure
+        { info       :: !StgInfoTableWithPtr
+        , arity      :: !HalfWord       -- ^ Arity of the partial application
+        , n_args     :: !HalfWord       -- ^ Size of the payload in words
+        , fun        :: !b              -- ^ Pointer to a 'FunClosure'
+        , pap_payload    :: !pap            -- ^ Sequence of already applied
+                                        --   arguments
+        }
+
+    -- In GHCi, if Linker.h would allow a reverse lookup, we could for exported
+    -- functions fun actually find the name here.
+    -- At least the other direction works via "lookupSymbol
+    -- base_GHCziBase_zpzp_closure" and yields the same address (up to tags)
+    -- | A function application
+  | APClosure
+        { info       :: !StgInfoTableWithPtr
+        , arity      :: !HalfWord       -- ^ Always 0
+        , n_args     :: !HalfWord       -- ^ Size of payload in words
+        , fun        :: !b              -- ^ Pointer to a 'FunClosure'
+        , ap_payload    :: !pap            -- ^ Sequence of already applied
+                                        --   arguments
+        }
+
+    -- | A suspended thunk evaluation
+  | APStackClosure
+        { info       :: !StgInfoTableWithPtr
+        , ap_st_size :: !Word
+        , fun        :: !b              -- ^ Function closure
+        , payload    :: !s            -- ^ Stack right before suspension
+        }
+
+    -- | A pointer to another closure, introduced when a thunk is updated
+    -- to point at its value
+  | IndClosure
+        { info       :: !StgInfoTableWithPtr
+        , indirectee :: !b              -- ^ Target closure
+        }
+
+   -- | A byte-code object (BCO) which can be interpreted by GHC's byte-code
+   -- interpreter (e.g. as used by GHCi)
+  | BCOClosure
+        { info       :: !StgInfoTableWithPtr
+        , instrs     :: !b              -- ^ A pointer to an ArrWords
+                                        --   of instructions
+        , literals   :: !b              -- ^ A pointer to an ArrWords
+                                        --   of literals
+        , bcoptrs    :: !b              -- ^ A pointer to an ArrWords
+                                        --   of byte code objects
+        , arity      :: !HalfWord       -- ^ The arity of this BCO
+        , size       :: !HalfWord       -- ^ The size of this BCO in words
+        , bitmap     :: ![Word]         -- ^ An StgLargeBitmap describing the
+                                        --   pointerhood of its args/free vars
+        }
+
+    -- | A thunk under evaluation by another thread
+  | BlackholeClosure
+        { info       :: !StgInfoTableWithPtr
+        , indirectee :: !b              -- ^ The target closure
+        }
+
+    -- | A @ByteArray#@
+  | ArrWordsClosure
+        { info       :: !StgInfoTableWithPtr
+        , bytes      :: !Word           -- ^ Size of array in bytes
+        , arrWords   :: ![Word]         -- ^ Array payload
+        }
+
+    -- | A @MutableByteArray#@
+  | MutArrClosure
+        { info       :: !StgInfoTableWithPtr
+        , mccPtrs    :: !Word           -- ^ Number of pointers
+        , mccSize    :: !Word           -- ^ ?? Closures.h vs ClosureMacros.h
+        , mccPayload :: ![b]            -- ^ Array payload
+        -- Card table ignored
+        }
+
+    -- | A @SmallMutableArray#@
+    --
+    -- @since 8.10.1
+  | SmallMutArrClosure
+        { info       :: !StgInfoTableWithPtr
+        , mccPtrs    :: !Word           -- ^ Number of pointers
+        , mccPayload :: ![b]            -- ^ Array payload
+        }
+
+    -- | An @MVar#@, with a queue of thread state objects blocking on them
+  | MVarClosure
+        { info       :: !StgInfoTableWithPtr
+        , queueHead  :: !b              -- ^ Pointer to head of queue
+        , queueTail  :: !b              -- ^ Pointer to tail of queue
+        , value      :: !b              -- ^ Pointer to closure
+        }
+
+    -- | A @MutVar#@
+  | MutVarClosure
+        { info       :: !StgInfoTableWithPtr
+        , var        :: !b              -- ^ Pointer to contents
+        }
+
+    -- | An STM blocking queue.
+  | BlockingQueueClosure
+        { info       :: !StgInfoTableWithPtr
+        , link       :: !b              -- ^ ?? Here so it looks like an IND
+        , blackHole  :: !b              -- ^ The blackhole closure
+        , owner      :: !b              -- ^ The owning thread state object
+        , queue      :: !b              -- ^ ??
+        }
+
+  | TSOClosure
+      { info :: !StgInfoTableWithPtr
+      -- pointers
+      , _link :: !b
+      , global_link :: !b
+      , tsoStack :: !b -- ^ stackobj from StgTSO
+      , trec :: !b
+      , blocked_exceptions :: !b
+      , bq :: !b
+      -- values
+      , what_next :: GHC.WhatNext
+      , why_blocked :: GHC.WhyBlocked
+      , flags :: [GHC.TsoFlags]
+      , threadId :: Word64
+      , saved_errno :: Word32
+      , dirty:: Word32
+      , alloc_limit :: Int64
+      , tot_stack_size :: Word32
+      , prof :: Maybe ProfTypes.StgTSOProfInfo
+      }
+
+ | StackClosure
+     { info :: !StgInfoTableWithPtr
+     , stack_size :: !Word32 -- ^ stack size in *words*
+     , stack_dirty :: !Word8 -- ^ non-zero => dirty
+     , stack_marking :: !Word8
+     , frames :: s
+     }
+
+
+  | WeakClosure
+     { info        :: !StgInfoTableWithPtr
+     , cfinalizers :: !b
+     , key         :: !b
+     , value       :: !b
+     , finalizer   :: !b
+     , mlink       :: !(Maybe b) -- ^ next weak pointer for the capability, can be NULL.
+     }
+
+  | TVarClosure
+    { info :: !StgInfoTableWithPtr
+    , current_value :: !b
+    , tvar_watch_queue :: !b
+    , num_updates :: !Int }
+
+  | TRecChunkClosure
+    { info :: !StgInfoTableWithPtr
+    , prev_chunk  :: !b
+    , next_idx :: !Word
+    , entries :: ![TRecEntry b]
+    }
+
+  | MutPrimClosure
+    { info :: !StgInfoTableWithPtr
+    , ptrArgs :: ![b]
+    , dataArgs :: ![Word]
+    }
+
+    -----------------------------------------------------------
+    -- Anything else
+
+    -- | Another kind of closure
+  | OtherClosure
+        { info       :: !StgInfoTableWithPtr
+        , hvalues    :: ![b]
+        , rawWords   :: ![Word]
+        }
+
+  | UnsupportedClosure
+        { info       :: !StgInfoTableWithPtr
+        }
+  deriving (Show, Generic, Functor, Foldable, Traversable, Ord, Eq)
+
+data TRecEntry b = TRecEntry { tvar :: !b
+                             , expected_value :: !b
+                             , new_value :: !b
+                             , trec_num_updates :: Int -- Only in THREADED, TODO: This is not an Int,
+                                                       -- is it a pointer
+                                                       -- to a haskell int
+                             } deriving (Show, Generic, Functor, Foldable, Traversable, Ord, Eq)
+
+newtype GenPapPayload b = GenPapPayload { getValues :: [FieldValue b] }
+  deriving (Functor, Foldable, Traversable, Show, Ord, Eq)
+
+type PapPayload = GenPapPayload ClosurePtr
+
+-- | Information needed to decode a set of stack frames
+data StackCont = StackCont StackPtr -- Address of start of frames
+                           RawStack -- The raw frames
+                           deriving Show
+
+type StackFrames = GenStackFrames ClosurePtr
+newtype GenStackFrames b = GenStackFrames { getFrames :: [DebugStackFrame b] }
+  deriving (Functor, Foldable, Traversable, Show, Ord, Eq)
+
+data DebugStackFrame b
+  = DebugStackFrame
+        { frame_info :: !StgInfoTableWithPtr
+        , values     :: [FieldValue b]
+        } deriving (Traversable, Functor, Foldable, Show, Ord, Eq)
+
+
+
+data ConstrDesc = ConstrDesc {
+          pkg        :: !String         -- ^ Package name
+        , modl       :: !String         -- ^ Module name
+        , name       :: !String         -- ^ Constructor name
+        } deriving (Show, Eq, Ord)
+
+
+-- Copied from ghc-heap
+parseConstrDesc :: String -> ConstrDesc
+parseConstrDesc input =
+    if not . all (>0) . fmap length $ [p,m,occ]
+                     then ConstrDesc "" "" input
+                     else ConstrDesc p m occ
+  where
+    (p, rest1) = break (== ':') input
+    (m, occ)
+        = (intercalate "." $ reverse modWords, occWord)
+        where
+        (modWords, occWord) =
+            if null rest1 --  XXXXXXXXx YUKX
+                --then error "getConDescAddress:parse:length rest1 < 1"
+                then parseModOcc [] []
+                else parseModOcc [] (tail rest1)
+    -- We only look for dots if str could start with a module name,
+    -- i.e. if it starts with an upper case character.
+    -- Otherwise we might think that "X.:->" is the module name in
+    -- "X.:->.+", whereas actually "X" is the module name and
+    -- ":->.+" is a constructor name.
+    parseModOcc :: [String] -> String -> ([String], String)
+    parseModOcc acc str@(c : _)
+        | isUpper c =
+            case break (== '.') str of
+                (top, []) -> (acc, top)
+                (top, _:bot) -> parseModOcc (top : acc) bot
+    parseModOcc acc str = (acc, str)
+
+class Quadtraversable m where
+  quadtraverse ::
+    Applicative f => (a -> f b)
+                  -> (c -> f d)
+                  -> (e -> f g)
+                  -> (h -> f i)
+                  -> m a c e h
+                  -> f (m b d g i)
+
+quadmap :: forall a b c d e f g h t . Quadtraversable t => (a -> b) -> (c -> d) -> (e -> f) -> (g -> h) -> t a c e g -> t b d f h
+quadmap = coerce
+  (quadtraverse :: (a -> Identity b)
+              -> (c -> Identity d)
+              -> (e -> Identity f)
+              -> (g -> Identity h)
+              -> t a c e g -> Identity (t b d f h))
+
+allClosures :: DebugClosure (GenPapPayload c) a (GenStackFrames c) c -> [c]
+allClosures c = getConst $ quadtraverse (traverse (Const . (:[]))) (const (Const [])) (traverse (Const . (:[]))) (Const . (:[])) c
+
+data FieldValue b = SPtr b
+                  | SNonPtr !Word64 deriving (Show, Traversable, Functor, Foldable, Ord, Eq)
+
+
+instance Quadtraversable DebugClosure where
+  quadtraverse p h f g c =
+    case c of
+      ConstrClosure a1 bs ds str ->
+        (\cs cstr -> ConstrClosure a1 cs ds cstr) <$> traverse g bs <*> h str
+      FunClosure a1 bs ws -> (\cs -> FunClosure a1 cs ws) <$> traverse g bs
+      ThunkClosure a1 bs ws -> (\cs -> ThunkClosure a1 cs ws) <$> traverse g bs
+      SelectorClosure a1 b  -> SelectorClosure a1 <$> g b
+      PAPClosure a1 a2 a3 a4 a5 -> PAPClosure a1 a2 a3 <$> g a4 <*> p a5
+      APClosure a1 a2 a3 a4 a5 -> APClosure a1 a2 a3 <$> g a4 <*> p a5
+      APStackClosure a1 s b bs   -> APStackClosure a1 s <$> g b <*> f bs
+      IndClosure a1 b -> IndClosure a1 <$> g b
+      BCOClosure a1 b1 b2 b3 a2 a3 a4 ->
+        (\c1 c2 c3 -> BCOClosure a1 c1 c2 c3 a2 a3 a4) <$> g b1 <*> g b2 <*> g b3
+      BlackholeClosure a1 b -> BlackholeClosure a1 <$> g b
+      ArrWordsClosure a1 a2 a3 -> pure (ArrWordsClosure a1 a2 a3)
+      MutArrClosure a1 a2 a3 bs -> MutArrClosure a1 a2 a3 <$> traverse g bs
+      SmallMutArrClosure a1 a2 bs -> SmallMutArrClosure a1 a2 <$> traverse g bs
+      MVarClosure a1 b1 b2 b3     -> MVarClosure a1 <$> g b1 <*> g b2 <*> g b3
+      MutVarClosure a1 b -> MutVarClosure a1 <$> g b
+      BlockingQueueClosure a1 b1 b2 b3 b4 ->
+        BlockingQueueClosure a1 <$> g b1 <*> g b2 <*> g b3 <*> g b4
+      TSOClosure a1 b1 b2 b3 b4 b5 b6 a2 a3 a4 a5 a6 a7 a8 a9 a10 ->
+        (\c1 c2 c3 c4 c5 c6 -> TSOClosure a1 c1 c2 c3 c4 c5 c6 a2 a3 a4 a5 a6 a7 a8 a9 a10) <$> g b1 <*> g b2 <*> g b3 <*> g b4 <*> g b5 <*> g b6
+      StackClosure a1 a2 a3 a4 a5 -> StackClosure a1 a2 a3 a4 <$> f a5
+      WeakClosure a1 a2 a3 a4 a5 a6 ->
+        WeakClosure a1 <$> g a2 <*> g a3 <*> g a4 <*> g a5 <*> traverse g a6
+      TVarClosure a1 a2 a3 a4 ->
+        TVarClosure a1 <$> g a2 <*> g a3 <*> pure a4
+      TRecChunkClosure a1 a2 a3 a4 -> TRecChunkClosure a1 <$> g a2 <*>  pure a3 <*> traverse (traverse g) a4
+      MutPrimClosure a1 a2 a3 -> MutPrimClosure a1 <$> traverse g a2 <*> pure a3
+      OtherClosure a1 bs ws -> OtherClosure a1 <$> traverse g bs <*> pure ws
+      UnsupportedClosure i  -> pure (UnsupportedClosure i)
diff --git a/src/GHC/Debug/Types/Graph.hs b/src/GHC/Debug/Types/Graph.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Debug/Types/Graph.hs
@@ -0,0 +1,376 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module GHC.Debug.Types.Graph( -- * Types
+                              HeapGraph(..)
+                            , HeapGraphEntry(..)
+                            , HeapGraphIndex
+                            , PapHI
+                            , StackHI
+                            -- * Building a heap graph
+                            , DerefFunction
+                            , buildHeapGraph
+                            , multiBuildHeapGraph
+                            , generalBuildHeapGraph
+
+                            -- * Printing a heap graph
+                            , ppHeapGraph
+                            , ppClosure
+
+                            -- * Utility
+                            , lookupHeapGraph
+                            , traverseHeapGraph
+                            , updateHeapGraph
+                            , heapGraphSize
+                            , annotateHeapGraph
+
+                            -- * Reverse Graph
+                            , ReverseGraph
+                            , mkReverseGraph
+                            , reverseEdges
+                            )
+                            where
+
+import Data.Char
+import Data.List (intercalate, foldl', sort, group, sortBy, groupBy)
+import Data.Maybe       ( catMaybes )
+import Data.Function
+import qualified Data.HashMap.Strict as M
+import qualified Data.IntMap as IM
+import qualified Data.IntSet as IS
+import Control.Monad
+import Control.Monad.Fix
+import Control.Monad.Trans.State
+import Control.Monad.Trans.Class
+import GHC.Debug.Types.Ptr
+import GHC.Debug.Types.Closures
+import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty (NonEmpty(..))
+
+-- | For heap graphs, i.e. data structures that also represent sharing and
+-- cyclic structures, these are the entries. If the referenced value is
+-- @Nothing@, then we do not have that value in the map, most likely due to
+-- exceeding the recursion bound passed to 'buildHeapGraph'.
+--
+-- Besides a pointer to the stored value and the closure representation we
+-- have a slot for arbitrary data, for the user's convenience.
+data HeapGraphEntry a = HeapGraphEntry {
+        hgeClosurePtr :: ClosurePtr,
+        hgeClosure :: DebugClosure PapHI ConstrDesc StackHI (Maybe HeapGraphIndex),
+        hgeData :: a}
+    deriving (Show, Functor, Foldable, Traversable)
+type HeapGraphIndex = ClosurePtr
+
+type StackHI = GenStackFrames (Maybe HeapGraphIndex)
+type PapHI =  GenPapPayload (Maybe HeapGraphIndex)
+
+-- | The whole graph. The suggested interface is to only use 'lookupHeapGraph',
+-- as the internal representation may change. Nevertheless, we export it here:
+-- Sometimes the user knows better what he needs than we do.
+data HeapGraph a = HeapGraph
+                      { roots :: !(NE.NonEmpty ClosurePtr)
+                      , graph :: !(IM.IntMap (HeapGraphEntry a)) }
+    deriving (Show, Foldable, Traversable, Functor)
+
+traverseHeapGraph :: Applicative m =>
+                    (HeapGraphEntry a -> m (HeapGraphEntry b))
+                  -> HeapGraph a
+                  -> m (HeapGraph b)
+traverseHeapGraph f (HeapGraph r im) = HeapGraph r <$> traverse f im
+
+
+lookupHeapGraph :: HeapGraphIndex -> HeapGraph a -> Maybe (HeapGraphEntry a)
+lookupHeapGraph (ClosurePtr i) (HeapGraph _r m) = IM.lookup (fromIntegral i) m
+
+insertHeapGraph :: HeapGraphIndex -> HeapGraphEntry a -> HeapGraph a -> HeapGraph a
+insertHeapGraph (ClosurePtr i) a (HeapGraph r m) = HeapGraph r (IM.insert (fromIntegral i) a m)
+
+updateHeapGraph :: (HeapGraphEntry a -> Maybe (HeapGraphEntry a))
+                -> HeapGraphIndex
+                -> HeapGraph a
+                -> HeapGraph a
+updateHeapGraph f (ClosurePtr i) (HeapGraph r m) = HeapGraph r (IM.update f (fromIntegral i) m)
+
+heapGraphSize :: HeapGraph a -> Int
+heapGraphSize (HeapGraph _ g) = IM.size g
+
+-- | Creates a 'HeapGraph' for the value in the box, but not recursing further
+-- than the given limit.
+buildHeapGraph
+   :: (MonadFix m)
+   => DerefFunction m a
+   -> Maybe Int
+   -> ClosurePtr -- ^ The value to start with
+   -> m (HeapGraph a)
+buildHeapGraph deref limit initialBox =
+  multiBuildHeapGraph deref limit (NE.singleton initialBox)
+
+-- TODO: It is a bit undesirable that the ConstrDesc field is already
+-- dereferenced, but also, not such a big deal. It could lead to additional
+-- requests to the debuggee which are not necessary and causes a mismatch
+-- with the step-by-step decoding functions in `Client.hs`
+type DerefFunction m a = ClosurePtr -> m (DebugClosureWithExtra a PapPayload ConstrDesc StackFrames ClosurePtr)
+
+-- | Creates a 'HeapGraph' for the values in multiple boxes, but not recursing
+--   further than the given limit.
+multiBuildHeapGraph
+    :: (MonadFix m)
+    => DerefFunction m a
+    -> Maybe Int
+    -> NonEmpty ClosurePtr -- ^ Starting values with associated data entry
+    -> m (HeapGraph a)
+multiBuildHeapGraph deref limit rs =
+  generalBuildHeapGraph deref limit (HeapGraph rs IM.empty) rs
+{-# INLINE multiBuildHeapGraph #-}
+
+-- | Adds the given annotation to the entry at the given index, using the
+-- 'mappend' operation of its 'Monoid' instance.
+annotateHeapGraph ::  (a -> a) -> HeapGraphIndex -> HeapGraph a -> HeapGraph a
+annotateHeapGraph f i hg = updateHeapGraph go i hg
+  where
+    go hge = Just $ hge { hgeData = f (hgeData hge) }
+
+{-# INLINE generalBuildHeapGraph #-}
+generalBuildHeapGraph
+    :: forall m a .  (MonadFix m)
+    => DerefFunction m a
+    -> Maybe Int
+    -> HeapGraph a
+    -> NonEmpty ClosurePtr
+    -> m (HeapGraph a)
+generalBuildHeapGraph deref limit hg addBoxes = do
+    -- First collect all boxes from the existing heap graph
+    (_is, hg') <- runStateT (mapM (add limit) addBoxes) hg
+    return hg'
+  where
+    add :: Maybe Int -> ClosurePtr -> StateT (HeapGraph a) m (Maybe ClosurePtr)
+    add (Just 0) _ = return Nothing
+    add n cp = do
+        -- If the box is in the map, return the index
+        hm <- get
+        case lookupHeapGraph cp hm of
+            Just {} -> return (Just cp)
+            -- FIXME GHC BUG: change `mdo` to `do` below:
+            --       "GHC internal error: ‘c’ is not in scope during type checking, but it passed the renamer"
+            Nothing -> mdo
+                -- Look up the closure
+                c <- lift $ deref cp
+                let new_add = add (subtract 1 <$> n)
+                -- NOTE: We tie-the-knot here with RecursiveDo so that we don't
+                -- get into an infinite loop with cycles in the heap.
+                rec modify' (insertHeapGraph cp (HeapGraphEntry cp c' e))
+                    -- Add the resulting closure below to the map (above):
+                    DCS e c' <- quadtraverse (traverse new_add) pure (traverse new_add) new_add c
+                return (Just cp)
+
+-- | Pretty-prints a HeapGraph. The resulting string contains newlines. Example
+-- for @let s = \"Ki\" in (s, s, cycle \"Ho\")@:
+--
+-- >let x1 = "Ki"
+-- >    x6 = C# 'H' : C# 'o' : x6
+-- >in (x1,x1,x6)
+ppHeapGraph :: (a -> String) -> HeapGraph a -> String
+ppHeapGraph printData (HeapGraph (heapGraphRoot :| rs) m) = letWrapper ++ "(" ++ printData (hgeData (iToE heapGraphRoot)) ++ ") " ++ roots
+  where
+    -- All variables occuring more than once
+    bindings = boundMultipleTimes (HeapGraph (heapGraphRoot :| rs) m) [heapGraphRoot]
+
+    roots = unlines [
+              "r" ++ show n ++ ":(" ++ printData (hgeData (iToE r)) ++ ") " ++ ppRef 0 (Just r) ++ "\n"
+              | (n, r) <- zip [0 :: Int ..] (heapGraphRoot : rs) ]
+
+    letWrapper =
+        if null bindings
+        then ""
+        else "let " ++ intercalate "\n    " (map ppBinding bindings) ++ "\nin "
+
+    bindingLetter i = case hgeClosure (iToE i) of
+        ThunkClosure {} -> 't'
+        SelectorClosure {} -> 't'
+        APClosure {} -> 't'
+        PAPClosure {} -> 'f'
+        BCOClosure {} -> 't'
+        FunClosure {} -> 'f'
+        _ -> 'x'
+
+    ppBindingMap = M.fromList $
+        concatMap (zipWith (\j (i,c) -> (i, c : show j)) [(1::Int)..]) $
+        groupBy ((==) `on` snd) $
+        sortBy (compare `on` snd)
+        [ (i, bindingLetter i) | i <- bindings ]
+
+    ppVar i = ppBindingMap M.! i
+    ppBinding i = ppVar i ++ "(" ++ printData (hgeData (iToE i)) ++  ") = " ++ ppEntry 0 (iToE i)
+
+    ppEntry prec hge
+        | Just s <- isString (hgeClosure hge) = show s
+        | Just l <- isList (hgeClosure hge)   = "[" ++ intercalate "," (map (ppRef 0) l) ++ "]"
+        | otherwise = ppClosure (printData (hgeData hge)) ppRef prec (hgeClosure hge)
+      where
+        _app [a] = a  ++ "()"
+        _app xs = addBraces (10 <= prec) (unwords xs)
+
+    ppRef _ Nothing = "..."
+    ppRef prec (Just i) | i `elem` bindings = ppVar i
+                        | otherwise = ppEntry prec (iToE i)
+    iToE (ClosurePtr i) = m IM.! (fromIntegral i)
+
+    iToUnboundE cp@(ClosurePtr i)
+        | cp `elem` bindings = Nothing
+        | otherwise         = IM.lookup (fromIntegral i) m
+
+    isList :: DebugClosure p ConstrDesc s (Maybe HeapGraphIndex) -> Maybe [Maybe HeapGraphIndex]
+    isList c
+        | isNil c =
+            return []
+        | otherwise = do
+            (h,t) <- isCons c
+            ti <- t
+            e <- iToUnboundE ti
+            t' <- isList (hgeClosure e)
+            return $ (:) h t'
+
+    isString :: DebugClosure p ConstrDesc s (Maybe HeapGraphIndex) -> Maybe String
+    isString e = do
+        list <- isList e
+        -- We do not want to print empty lists as "" as we do not know that they
+        -- are really strings.
+        if null list
+        then Nothing
+        else mapM (isChar . hgeClosure <=< iToUnboundE <=< id) list
+
+
+-- | In the given HeapMap, list all indices that are used more than once. The
+-- second parameter adds external references, commonly @[heapGraphRoot]@.
+boundMultipleTimes :: HeapGraph a -> [HeapGraphIndex] -> [HeapGraphIndex]
+boundMultipleTimes (HeapGraph _rs m) roots = map head $ filter (not.null) $ group $ sort $
+     roots ++ concatMap (catMaybes . allClosures . hgeClosure) (IM.elems m)
+
+-- Utilities
+
+addBraces :: Bool -> String -> String
+addBraces True t = "(" ++ t ++ ")"
+addBraces False t = t
+
+braceize :: [String] -> String
+braceize [] = ""
+braceize xs = "{" ++ intercalate "," xs ++ "}"
+
+isChar :: DebugClosure p ConstrDesc s c -> Maybe Char
+isChar ConstrClosure{ constrDesc = ConstrDesc {pkg = "ghc-prim", modl = "GHC.Types", name = "C#"}, dataArgs = [ch], ptrArgs = []} = Just (chr (fromIntegral ch))
+isChar _ = Nothing
+
+isNil :: DebugClosure p ConstrDesc s c -> Bool
+isNil ConstrClosure{ constrDesc = ConstrDesc {pkg = "ghc-prim", modl = "GHC.Types", name = "[]"}, dataArgs = _, ptrArgs = []} = True
+isNil _ = False
+
+isCons :: DebugClosure p ConstrDesc s c -> Maybe (c, c)
+isCons ConstrClosure{ constrDesc = ConstrDesc {pkg = "ghc-prim", modl = "GHC.Types", name = ":"}, dataArgs = [], ptrArgs = [h,t]} = Just (h,t)
+isCons _ = Nothing
+
+isTup :: DebugClosure p ConstrDesc s c -> Maybe [c]
+isTup ConstrClosure{ dataArgs = [], ..} =
+    if length (name constrDesc) >= 3 &&
+       head (name constrDesc) == '(' && last (name constrDesc) == ')' &&
+       all (==',') (tail (init (name constrDesc)))
+    then Just ptrArgs else Nothing
+isTup _ = Nothing
+
+
+
+-- | A pretty-printer that tries to generate valid Haskell for evalutated data.
+-- It assumes that for the included boxes, you already replaced them by Strings
+-- using 'Data.Foldable.map' or, if you need to do IO, 'Data.Foldable.mapM'.
+--
+-- The parameter gives the precedendence, to avoid avoidable parenthesises.
+ppClosure :: String -> (Int -> c -> String) -> Int -> DebugClosure p ConstrDesc s c -> String
+ppClosure herald showBox prec c = case c of
+    _ | Just ch <- isChar c -> app
+        ["C#", show ch]
+    _ | Just (h,t) <- isCons c -> addBraces (5 <= prec) $
+        showBox 5 h ++ " : " ++ showBox 4 t
+    _ | Just vs <- isTup c ->
+        "(" ++ intercalate "," (map (showBox 0) vs) ++ ")"
+    ConstrClosure {..} -> app $
+        name constrDesc : map (showBox 10) ptrArgs ++ map show dataArgs
+    ThunkClosure {..} -> app $
+        "_thunk(" : herald : ")" : map (showBox 10) ptrArgs ++ map show dataArgs
+    SelectorClosure {..} -> app
+        ["_sel", showBox 10 selectee]
+    IndClosure {..} -> app
+        ["_ind", showBox 10 indirectee]
+    BlackholeClosure {..} -> app
+        ["_bh",  showBox 10 indirectee]
+    APClosure {..} -> app $ map (showBox 10) $
+        [fun]
+        -- TODO: Payload
+    PAPClosure {..} -> app $ map (showBox 10) $
+        [fun] -- TODO payload
+    APStackClosure {..} -> app $ map (showBox 10) $
+        [fun] -- TODO: stack
+    TRecChunkClosure {} -> "_trecChunk" --TODO
+    BCOClosure {..} -> app
+        ["_bco", showBox 10 bcoptrs]
+    ArrWordsClosure {..} -> app
+        ["ARR_WORDS", "("++show bytes ++ " bytes)", ((show $ arrWordsBS arrWords)) ]
+    MutArrClosure {..} -> app
+        --["toMutArray", "("++show (length mccPayload) ++ " ptrs)",  intercalate "," (shorten (map (showBox 10) mccPayload))]
+        ["[", intercalate ", " (shorten (map (showBox 10) mccPayload)),"]"]
+    SmallMutArrClosure {..} -> app
+        ["[", intercalate ", " (shorten (map (showBox 10) mccPayload)),"]"]
+    MutVarClosure {..} -> app
+        ["_mutVar", showBox 10 var]
+    MVarClosure {..} -> app
+        ["MVar", showBox 10 value]
+    FunClosure {..} ->
+        "_fun" ++ braceize (map (showBox 0) ptrArgs ++ map show dataArgs)
+    BlockingQueueClosure {} ->
+        "_blockingQueue"
+    OtherClosure {} ->
+        "_other"
+    TSOClosure {} -> "TSO"
+    StackClosure {..} -> app ["Stack(", show stack_size, ")"] -- TODO
+    WeakClosure {} -> "_wk" -- TODO
+    TVarClosure {} -> "_tvar" -- TODO
+    MutPrimClosure {} -> "_mutPrim" -- TODO
+    UnsupportedClosure {info} -> (show info)
+
+
+  where
+    app [a] = a  ++ "()"
+    app xs = addBraces (10 <= prec) (unwords xs)
+
+    shorten xs = if length xs > 20 then take 20 xs ++ ["(and more)"] else xs
+
+
+-- Reverse Edges
+--
+closurePtrToInt :: ClosurePtr -> Int
+closurePtrToInt (ClosurePtr p) = fromIntegral p
+
+intToClosurePtr :: Int -> ClosurePtr
+intToClosurePtr i = mkClosurePtr (fromIntegral i)
+
+newtype ReverseGraph = ReverseGraph (IM.IntMap IS.IntSet)
+
+reverseEdges :: ClosurePtr -> ReverseGraph -> Maybe [ClosurePtr]
+reverseEdges cp (ReverseGraph rg) =
+  map intToClosurePtr . IS.toList <$> IM.lookup (closurePtrToInt cp) rg
+
+mkReverseGraph :: HeapGraph a -> ReverseGraph
+mkReverseGraph (HeapGraph _ hg) = ReverseGraph graph
+  where
+    graph = IM.foldlWithKey' collectNodes IM.empty hg
+    collectNodes newMap k h =
+      let bs = allClosures (hgeClosure h)
+      in foldl' (\m ma ->
+                    case ma of
+                      Nothing -> m
+                      Just a -> IM.insertWith IS.union (closurePtrToInt a) (IS.singleton k) m) newMap bs
+
diff --git a/src/GHC/Debug/Types/Ptr.hs b/src/GHC/Debug/Types/Ptr.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Debug/Types/Ptr.hs
@@ -0,0 +1,321 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+-- | Data types for representing different pointers and raw information
+-- All pointers are stored in little-endian to make arithmetic easier.
+--
+-- We have to send and recieve the pointers in big endian though. This
+-- conversion is dealt with in the Binary instance for ClosurePtr and
+-- then the other pointers are derived from this instance using DerivingVia
+module GHC.Debug.Types.Ptr( -- * InfoTables
+                            InfoTablePtr(..)
+                          , RawInfoTable(..)
+                          -- UntaggedClosurePtr constructor not exported so
+                          -- we can maintain the invariant that all
+                          -- ClosurePtr are untagged
+                          -- * Closures
+                          , ClosurePtr(..,ClosurePtr)
+                          , mkClosurePtr
+                          , RawClosure(..)
+                          , rawClosureSize
+                          , getInfoTblPtr
+                          -- * Operations on 'ClosurePtr'
+                          , applyBlockMask
+                          , applyMBlockMask
+                          , subtractBlockPtr
+                          , heapAlloced
+
+                          , getBlockOffset
+                          -- * Blocks
+                          , BlockPtr(..)
+                          , RawBlock(..)
+                          , isLargeBlock
+                          , isPinnedBlock
+                          , rawBlockAddr
+                          , extractFromBlock
+                          , blockMBlock
+                          , rawBlockSize
+                          -- * Stacks
+                          , StackPtr(..)
+                          , RawStack(..)
+
+                          , subtractStackPtr
+                          , calculateStackLen
+                          , addStackPtr
+                          , rawStackSize
+                          , printStack
+                          -- * Bitmaps
+                          , PtrBitmap(..)
+                          , traversePtrBitmap
+                          -- * Constants
+                          , blockMask
+                          , mblockMask
+                          , mblockMaxSize
+                          , blockMaxSize
+                          , profiling
+                          , tablesNextToCode
+
+                          -- * Other utility
+                          , arrWordsBS
+                          , prettyPrint
+                          , printBS
+                          )  where
+
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString as BS
+import Data.Hashable
+import Data.Word
+
+import Data.Binary
+import Data.Binary.Get
+import Data.Binary.Put
+import System.Endian
+
+import Numeric (showHex)
+import Data.Coerce
+import Data.Bits
+import GHC.Stack
+import Control.Applicative
+import qualified Data.Array.Unboxed as A
+import Control.Monad
+import qualified Data.Foldable as F
+
+prettyPrint :: BS.ByteString -> String
+prettyPrint = concatMap (flip showHex "") . BS.unpack
+
+-- TODO: Fetch this from debuggee
+tablesNextToCode :: Bool
+tablesNextToCode = True
+
+-- TODO: Fetch this from debuggee
+profiling :: Bool
+profiling = False
+
+newtype InfoTablePtr = InfoTablePtr Word64
+                     deriving (Eq, Ord)
+                     deriving newtype (Hashable)
+                     deriving (Show, Binary) via ClosurePtr
+
+-- Invariant, ClosurePtrs are *always* untagged, we take some care to
+-- untag them when making a ClosurePtr so we don't have to do it on every
+-- call to decodeClosure
+newtype ClosurePtr = UntaggedClosurePtr Word64
+                   deriving (Eq)
+                   deriving newtype (Hashable)
+
+pattern ClosurePtr :: Word64 -> ClosurePtr
+pattern ClosurePtr p <- UntaggedClosurePtr p
+
+{-# COMPLETE ClosurePtr #-}
+
+mkClosurePtr :: Word64 -> ClosurePtr
+mkClosurePtr = untagClosurePtr . UntaggedClosurePtr
+
+instance Binary ClosurePtr where
+  put (ClosurePtr p) = putWord64be (toBE64 p)
+  get = mkClosurePtr . fromBE64 <$> getWord64be
+
+instance Ord ClosurePtr where
+  (ClosurePtr x) `compare` (ClosurePtr y) = x `compare` y
+
+instance Show ClosurePtr where
+  show (ClosurePtr 0) = "null"
+  show (ClosurePtr p) =  "0x" ++ showHex p ""
+
+
+newtype StackPtr = StackPtr Word64
+                   deriving (Eq, Ord)
+                   deriving newtype (Hashable)
+                   deriving (Show, Binary) via ClosurePtr
+
+newtype StringPtr = StringPtr Word64
+  deriving Show via StackPtr
+
+
+subtractBlockPtr :: ClosurePtr -> BlockPtr -> Word64
+subtractBlockPtr cp bp = subtractStackPtr (coerce cp) (coerce bp)
+
+subtractStackPtr :: StackPtr -> ClosurePtr -> Word64
+subtractStackPtr (StackPtr c) (ClosurePtr c2) =
+  c - c2
+
+addStackPtr :: StackPtr -> Word64 -> StackPtr
+addStackPtr (StackPtr c) o = StackPtr (c + o)
+
+rawClosureSize :: RawClosure -> Int
+rawClosureSize (RawClosure s) = BS.length s
+
+calculateStackLen :: Word32 -> Word64 -> ClosurePtr -> StackPtr -> Word64
+calculateStackLen siz offset (ClosurePtr p) (StackPtr sp) =
+  (p  -- Pointer to start of StgStack closure
+    + offset       -- Offset to end of closure
+    + (fromIntegral siz * 8) -- Stack_Size (in words)
+    )
+    - sp -- Minus current Sp
+
+printBS :: BS.ByteString -> String
+-- Not technically all ClosurePtr but good for the show instance
+printBS bs = show (runGet (many (get @ClosurePtr)) (BSL.fromStrict bs))
+
+printStack :: RawStack -> String
+printStack (RawStack s) = printBS s
+
+arrWordsBS :: [Word] -> BSL.ByteString
+arrWordsBS = runPut . mapM_ putWordhost
+
+-- | Check if the ClosurePtr is block allocated or not
+-- TODO: MP: These numbers are hard-coded from what
+-- mblock_address_space.begin and mblock_address_space.end were when
+-- I inspected them in gdb. I don't know if they are always the same of
+-- should be queried from the debuggee
+heapAlloced :: ClosurePtr -> Bool
+heapAlloced (ClosurePtr w) = (w >= 0x4200000000 && w <= 0x14200000000)
+
+newtype RawInfoTable = RawInfoTable BS.ByteString
+                     deriving (Eq, Ord, Show)
+                     deriving newtype (Binary)
+
+newtype RawClosure = RawClosure BS.ByteString
+                   deriving (Eq, Ord, Show)
+
+getRawClosure :: Get RawClosure
+getRawClosure = do
+  len <- getWord32be
+  RawClosure <$!> getByteString (fromIntegral len)
+
+putRawClosure :: RawClosure -> Put
+putRawClosure (RawClosure rc) = do
+  let n = BS.length rc
+  putWord32be (fromIntegral n)
+  putByteString rc
+
+instance Binary RawClosure where
+  get = getRawClosure
+  put = putRawClosure
+
+newtype RawStack = RawStack BS.ByteString
+                   deriving (Eq, Ord, Show)
+
+newtype RawPayload = RawPayload BS.ByteString
+                   deriving (Eq, Ord, Show)
+
+rawStackSize :: RawStack -> Int
+rawStackSize (RawStack bs) = BS.length bs
+
+
+newtype BlockPtr = BlockPtr Word64
+                   deriving (Eq, Ord)
+                   deriving newtype (Hashable)
+                   deriving (Binary, Show) via StackPtr
+
+blockMBlock :: BlockPtr -> Word64
+blockMBlock (BlockPtr p) = p .&. (complement mblockMask)
+
+applyMBlockMask :: ClosurePtr -> BlockPtr
+applyMBlockMask (ClosurePtr p) = BlockPtr (p .&. complement mblockMask)
+
+applyBlockMask :: ClosurePtr -> BlockPtr
+applyBlockMask (ClosurePtr p) = BlockPtr (p .&. complement blockMask)
+
+getBlockOffset :: ClosurePtr -> Word64
+getBlockOffset (ClosurePtr p) = p .&. blockMask
+
+mblockMaxSize, blockMaxSize :: Word64
+mblockMaxSize = mblockMask + 1
+blockMaxSize = blockMask + 1
+
+mblockMask :: Word64
+mblockMask = 0b11111111111111111111 -- 20 bits
+
+blockMask :: Word64
+blockMask = 0b111111111111 -- 12 bits
+
+isPinnedBlock :: RawBlock -> Bool
+isPinnedBlock (RawBlock _ flags _) = (flags .&. 0b100) /= 0
+
+isLargeBlock :: RawBlock -> Bool
+isLargeBlock (RawBlock _ flags _) = (flags .&. 0b10) /= 0
+
+data RawBlock = RawBlock BlockPtr Word16 BS.ByteString
+                    deriving (Show)
+
+-- flags, Ptr, size then raw block
+getBlock :: Get RawBlock
+getBlock = do
+  bflags <- getWord16le
+  bptr <- get
+  len <- getInt32be
+  rb <- getByteString (fromIntegral len)
+  return (RawBlock bptr bflags rb)
+
+putBlock :: RawBlock -> Put
+putBlock (RawBlock bptr bflags rb) = do
+  putWord16le bflags
+  put bptr
+  putInt32be (fromIntegral $ BS.length rb)
+  putByteString rb
+
+instance Binary RawBlock where
+  get = getBlock
+  put = putBlock
+
+rawBlockSize :: RawBlock -> Int
+rawBlockSize (RawBlock _ _ bs) = BS.length bs
+
+rawBlockAddr :: RawBlock -> BlockPtr
+rawBlockAddr (RawBlock addr _ _) = addr
+
+-- | Invariant: ClosurePtr is within the range of the block
+-- The 'RawClosure' this returns is actually the tail of the whole block,
+-- this is fine because the memory for each block is only allocated once
+-- due to how BS.drop is implemented via pointer arithmetic.
+extractFromBlock :: ClosurePtr
+                -> RawBlock
+                -> RawClosure
+extractFromBlock cp (RawBlock bp _ b) =
+--  Calling closureSize doesn't work as the info table addresses are bogus
+--  clos_size_w <- withForeignPtr fp' (\p -> return $ closureSize (ptrToBox p))
+--  let clos_size = clos_size_w * 8
+    --traceShow (fp, offset, cp, bp,o, l)
+    --traceShow ("FP", fp `plusForeignPtr` offset)
+    RawClosure (BS.drop offset b)
+    where
+      offset = fromIntegral (subtractBlockPtr cp bp)
+
+tAG_MASK :: Word64
+tAG_MASK = 0b111
+
+untagClosurePtr :: ClosurePtr -> ClosurePtr
+untagClosurePtr (ClosurePtr w) = UntaggedClosurePtr (w .&. complement tAG_MASK)
+
+getInfoTblPtr :: HasCallStack => RawClosure -> InfoTablePtr
+getInfoTblPtr (RawClosure bs) = runGet (isolate 8 get) (BSL.fromStrict bs)
+
+-- | A bitmap that records whether each field of a stack frame is a pointer.
+newtype PtrBitmap = PtrBitmap (A.Array Int Bool) deriving (Show)
+
+traversePtrBitmap :: Monad m => (Bool -> m a) -> PtrBitmap -> m [a]
+traversePtrBitmap f (PtrBitmap arr) = mapM f (A.elems arr)
+
+getPtrBitmap :: Get PtrBitmap
+getPtrBitmap = do
+  len <- getWord32be
+  bits <- replicateM (fromIntegral len) getWord8
+  let arr = A.listArray (0, fromIntegral len-1) (map (==1) bits)
+  return $ PtrBitmap arr
+
+putPtrBitmap :: PtrBitmap -> Put
+putPtrBitmap (PtrBitmap pbm) = do
+  let n = F.length pbm
+  putWord32be (fromIntegral n)
+  F.traverse_ (\b -> if b then putWord8 1 else putWord8 0) pbm
+
+instance Binary PtrBitmap where
+  get = getPtrBitmap
+  put = putPtrBitmap