{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}

{- 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'.
--
-- N.B. This only handles cases not already handled by
-- 'GHC.Debug.Decode.decodeClosure'. Eventually this codepath should be
-- retired.
convertClosure :: (Num a, Eq a, Show a) => StgInfoTableWithPtr -> GHC.GenClosure a -> DebugClosure InfoTablePtr Void InfoTablePtr Void a
convertClosure :: forall a.
(Num a, Eq a, Show a) =>
StgInfoTableWithPtr
-> GenClosure a
-> DebugClosure InfoTablePtr Void InfoTablePtr Void a
convertClosure StgInfoTableWithPtr
itb GenClosure a
g =
  case GenClosure a
g of
    -- N.B. decodeClosure doesn't handle THUNK_STATIC
    GHC.ThunkClosure StgInfoTable
_ [a]
a2 [Word]
a3           -> forall srt pap string s b.
StgInfoTableWithPtr
-> srt -> [b] -> [Word] -> DebugClosure srt pap string s b
ThunkClosure StgInfoTableWithPtr
itb (StgInfoTableWithPtr -> InfoTablePtr
tableId StgInfoTableWithPtr
itb) [a]
a2 [Word]
a3
    GHC.SelectorClosure StgInfoTable
_ a
a2           -> forall srt pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure srt pap string s b
SelectorClosure StgInfoTableWithPtr
itb a
a2
    GHC.BCOClosure StgInfoTable
_ a
a2 a
a3 a
a4 HalfWord
a5 HalfWord
a6 [Word]
a7 -> forall srt pap string s b.
StgInfoTableWithPtr
-> b
-> b
-> b
-> HalfWord
-> HalfWord
-> [Word]
-> DebugClosure srt pap string s b
BCOClosure StgInfoTableWithPtr
itb a
a2 a
a3 a
a4 HalfWord
a5 HalfWord
a6 [Word]
a7
    GHC.BlackholeClosure StgInfoTable
_ a
a2          -> forall srt pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure srt pap string s b
BlackholeClosure StgInfoTableWithPtr
itb a
a2
    GHC.MutArrClosure StgInfoTable
_ Word
a2 Word
a3 [a]
a4       -> forall srt pap string s b.
StgInfoTableWithPtr
-> Word -> Word -> [b] -> DebugClosure srt pap string s b
MutArrClosure StgInfoTableWithPtr
itb Word
a2 Word
a3 [a]
a4
    GHC.SmallMutArrClosure StgInfoTable
_ Word
a2 [a]
a3     -> forall srt pap string s b.
StgInfoTableWithPtr
-> Word -> [b] -> DebugClosure srt pap string s b
SmallMutArrClosure StgInfoTableWithPtr
itb Word
a2 [a]
a3
    GHC.MVarClosure StgInfoTable
_ a
a2 a
a3 a
a4         -> forall srt pap string s b.
StgInfoTableWithPtr
-> b -> b -> b -> DebugClosure srt pap string s b
MVarClosure StgInfoTableWithPtr
itb a
a2 a
a3 a
a4
    GHC.OtherClosure StgInfoTable
_ [a]
a2 [Word]
a3           -> forall srt pap string s b.
StgInfoTableWithPtr
-> [b] -> [Word] -> DebugClosure srt pap string s b
OtherClosure StgInfoTableWithPtr
itb [a]
a2 [Word]
a3
    GHC.IndClosure StgInfoTable
_ a
a2                -> forall srt pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure srt pap string s b
IndClosure StgInfoTableWithPtr
itb a
a2
    GHC.MutVarClosure StgInfoTable
_ a
a2             -> forall srt pap string s b.
StgInfoTableWithPtr -> b -> DebugClosure srt pap string s b
MutVarClosure StgInfoTableWithPtr
itb a
a2
    GHC.WeakClosure StgInfoTable
_ a
a2 a
a3 a
a4 a
a5 a
a6   ->
#if MIN_VERSION_GLASGOW_HASKELL(9,4,2,0)
      let w_link = a6
#else
      -- nullPtr check
      let w_link :: Maybe a
w_link = if a
a6 forall a. Eq a => a -> a -> Bool
== a
0
                  then forall a. Maybe a
Nothing
                  else forall a. a -> Maybe a
Just a
a6
#endif
      in forall srt pap string s b.
StgInfoTableWithPtr
-> b -> b -> b -> b -> Maybe b -> DebugClosure srt pap string s b
WeakClosure StgInfoTableWithPtr
itb a
a2 a
a3 a
a4 a
a5 Maybe a
w_link
    GHC.UnsupportedClosure StgInfoTable
_           -> forall srt pap string s b.
StgInfoTableWithPtr -> DebugClosure srt pap string s b
UnsupportedClosure StgInfoTableWithPtr
itb
    GenClosure a
c -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Unexpected closure type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show GenClosure a
c)