{- 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 :: forall a.
(Num a, Eq a, Show a) =>
StgInfoTableWithPtr
-> GenClosure a -> DebugClosure Void InfoTablePtr Void a
convertClosure StgInfoTableWithPtr
itb GenClosure a
g =
  case GenClosure a
g of
    GHC.ConstrClosure StgInfoTable
_ [a]
a2 [Word]
a3 String
_ String
_ String
_ -> StgInfoTableWithPtr
-> [a]
-> [Word]
-> InfoTablePtr
-> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr
-> [b] -> [Word] -> string -> DebugClosure pap string s b
ConstrClosure StgInfoTableWithPtr
itb [a]
a2 [Word]
a3 (StgInfoTableWithPtr -> InfoTablePtr
tableId StgInfoTableWithPtr
itb)
    GHC.FunClosure StgInfoTable
_ [a]
a2 [Word]
a3             -> StgInfoTableWithPtr
-> [a] -> [Word] -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr -> [b] -> [Word] -> DebugClosure pap string s b
FunClosure StgInfoTableWithPtr
itb [a]
a2 [Word]
a3
    GHC.ThunkClosure StgInfoTable
_ [a]
a2 [Word]
a3           -> StgInfoTableWithPtr
-> [a] -> [Word] -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr -> [b] -> [Word] -> DebugClosure pap string s b
ThunkClosure StgInfoTableWithPtr
itb [a]
a2 [Word]
a3
    GHC.SelectorClosure StgInfoTable
_ a
a2           -> StgInfoTableWithPtr -> a -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure pap string s b
SelectorClosure StgInfoTableWithPtr
itb a
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 StgInfoTable
_ a
a2                -> StgInfoTableWithPtr -> a -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure pap string s b
IndClosure StgInfoTableWithPtr
itb a
a2
    GHC.BCOClosure StgInfoTable
_ a
a2 a
a3 a
a4 HalfWord
a5 HalfWord
a6 [Word]
a7 -> StgInfoTableWithPtr
-> a
-> a
-> a
-> HalfWord
-> HalfWord
-> [Word]
-> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr
-> b
-> b
-> b
-> HalfWord
-> HalfWord
-> [Word]
-> DebugClosure pap string s b
BCOClosure StgInfoTableWithPtr
itb a
a2 a
a3 a
a4 HalfWord
a5 HalfWord
a6 [Word]
a7
    GHC.BlackholeClosure StgInfoTable
_ a
a2          -> StgInfoTableWithPtr -> a -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure pap string s b
BlackholeClosure StgInfoTableWithPtr
itb a
a2
    GHC.ArrWordsClosure StgInfoTable
_ Word
a2 [Word]
a3        -> StgInfoTableWithPtr
-> Word -> [Word] -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr
-> Word -> [Word] -> DebugClosure pap string s b
ArrWordsClosure StgInfoTableWithPtr
itb Word
a2 [Word]
a3
    GHC.MutArrClosure StgInfoTable
_ Word
a2 Word
a3 [a]
a4       -> StgInfoTableWithPtr
-> Word -> Word -> [a] -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr
-> Word -> Word -> [b] -> DebugClosure pap string s b
MutArrClosure StgInfoTableWithPtr
itb Word
a2 Word
a3 [a]
a4
    GHC.SmallMutArrClosure StgInfoTable
_ Word
a2 [a]
a3     -> StgInfoTableWithPtr
-> Word -> [a] -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr -> Word -> [b] -> DebugClosure pap string s b
SmallMutArrClosure StgInfoTableWithPtr
itb Word
a2 [a]
a3
    GHC.MVarClosure StgInfoTable
_ a
a2 a
a3 a
a4         -> StgInfoTableWithPtr
-> a -> a -> a -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr -> b -> b -> b -> DebugClosure pap string s b
MVarClosure StgInfoTableWithPtr
itb a
a2 a
a3 a
a4
    GHC.MutVarClosure StgInfoTable
_ a
a2             -> StgInfoTableWithPtr -> a -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure pap string s b
MutVarClosure StgInfoTableWithPtr
itb a
a2
    GHC.BlockingQueueClosure StgInfoTable
_ a
a2 a
a3 a
a4 a
a5 -> StgInfoTableWithPtr
-> a -> a -> a -> a -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr
-> b -> b -> b -> b -> DebugClosure pap string s b
BlockingQueueClosure StgInfoTableWithPtr
itb a
a2 a
a3 a
a4 a
a5
    GHC.TSOClosure StgInfoTable
_ a
a2 a
a3 a
a4 a
a5 a
a6 a
a7 WhatNext
a8 WhyBlocked
a9 [TsoFlags]
a10 Word64
a11 HalfWord
a12 HalfWord
a13 Int64
a14 HalfWord
a15 Maybe StgTSOProfInfo
a16 -> StgInfoTableWithPtr
-> a
-> a
-> a
-> a
-> a
-> a
-> WhatNext
-> WhyBlocked
-> [TsoFlags]
-> Word64
-> HalfWord
-> HalfWord
-> Int64
-> HalfWord
-> Maybe StgTSOProfInfo
-> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr
-> b
-> b
-> b
-> b
-> b
-> b
-> WhatNext
-> WhyBlocked
-> [TsoFlags]
-> Word64
-> HalfWord
-> HalfWord
-> Int64
-> HalfWord
-> Maybe StgTSOProfInfo
-> DebugClosure pap string s b
TSOClosure StgInfoTableWithPtr
itb a
a2 a
a3 a
a4 a
a5 a
a6 a
a7 WhatNext
a8 WhyBlocked
a9 [TsoFlags]
a10 Word64
a11 HalfWord
a12 HalfWord
a13 Int64
a14 HalfWord
a15 Maybe StgTSOProfInfo
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 StgInfoTable
_ [a]
a2 [Word]
a3           -> StgInfoTableWithPtr
-> [a] -> [Word] -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr -> [b] -> [Word] -> DebugClosure pap string s b
OtherClosure StgInfoTableWithPtr
itb [a]
a2 [Word]
a3
    GHC.WeakClosure StgInfoTable
_ a
a2 a
a3 a
a4 a
a5 a
a6   ->
      -- nullPtr check
      let w_link :: Maybe a
w_link = if a
a6 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
                  then Maybe a
forall a. Maybe a
Nothing
                  else a -> Maybe a
forall a. a -> Maybe a
Just a
a6
      in StgInfoTableWithPtr
-> a
-> a
-> a
-> a
-> Maybe a
-> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr
-> b -> b -> b -> b -> Maybe b -> DebugClosure pap string s b
WeakClosure StgInfoTableWithPtr
itb a
a2 a
a3 a
a4 a
a5 Maybe a
w_link
    GHC.UnsupportedClosure StgInfoTable
_           -> StgInfoTableWithPtr -> DebugClosure Void InfoTablePtr Void a
forall pap string s b.
StgInfoTableWithPtr -> DebugClosure pap string s b
UnsupportedClosure StgInfoTableWithPtr
itb
    GenClosure a
c -> String -> DebugClosure Void InfoTablePtr Void a
forall a. HasCallStack => String -> a
error (String
"Unexpected closure type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenClosure a -> String
forall a. Show a => a -> String
show GenClosure a
c)