{-# LANGUAGE CPP #-}
#if MIN_TOOL_VERSION_ghc(9,9,0)
{-# LANGUAGE RecordWildCards #-}

module GHC.Exts.Stack
  ( -- * Stack inspection
    decodeStack,
    stackFrameSize,
  )
where

import GHC.Exts.Heap.Closures
import GHC.Exts.Stack.Constants
import GHC.Exts.Stack.Decode
import Prelude

-- | Get the size of the `StackFrame` in words.
--
-- Includes header and payload. Does not follow pointers.
stackFrameSize :: StackFrame -> Int
stackFrameSize :: StackFrame -> Int
stackFrameSize (UpdateFrame {}) = Int
sizeStgUpdateFrame
stackFrameSize (CatchFrame {}) = Int
sizeStgCatchFrame
stackFrameSize (CatchStmFrame {}) = Int
sizeStgCatchSTMFrame
stackFrameSize (CatchRetryFrame {}) = Int
sizeStgCatchRetryFrame
stackFrameSize (AtomicallyFrame {}) = Int
sizeStgAtomicallyFrame
stackFrameSize (RetSmall {[GenStackField Box]
StgInfoTable
info_tbl :: StgInfoTable
stack_payload :: [GenStackField Box]
info_tbl :: forall b. GenStackFrame b -> StgInfoTable
stack_payload :: forall b. GenStackFrame b -> [GenStackField b]
..}) = Int
sizeStgClosure Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [GenStackField Box] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenStackField Box]
stack_payload
stackFrameSize (RetBig {[GenStackField Box]
StgInfoTable
info_tbl :: forall b. GenStackFrame b -> StgInfoTable
stack_payload :: forall b. GenStackFrame b -> [GenStackField b]
info_tbl :: StgInfoTable
stack_payload :: [GenStackField Box]
..}) = Int
sizeStgClosure Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [GenStackField Box] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenStackField Box]
stack_payload
stackFrameSize (RetFun {[GenStackField Box]
Word
StgInfoTable
Box
info_tbl :: forall b. GenStackFrame b -> StgInfoTable
info_tbl :: StgInfoTable
retFunSize :: Word
retFunFun :: Box
retFunPayload :: [GenStackField Box]
retFunPayload :: forall b. GenStackFrame b -> [GenStackField b]
retFunFun :: forall b. GenStackFrame b -> b
retFunSize :: forall b. GenStackFrame b -> Word
..}) = Int
sizeStgRetFunFrame Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [GenStackField Box] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenStackField Box]
retFunPayload
-- The one additional word is a pointer to the StgBCO in the closure's payload
stackFrameSize (RetBCO {[GenStackField Box]
StgInfoTable
Box
info_tbl :: forall b. GenStackFrame b -> StgInfoTable
info_tbl :: StgInfoTable
bco :: Box
bcoArgs :: [GenStackField Box]
bcoArgs :: forall b. GenStackFrame b -> [GenStackField b]
bco :: forall b. GenStackFrame b -> b
..}) = Int
sizeStgClosure Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [GenStackField Box] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenStackField Box]
bcoArgs
-- The one additional word is a pointer to the next stack chunk
stackFrameSize (UnderflowFrame {}) = Int
sizeStgClosure Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
stackFrameSize StackFrame
_ = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Unexpected stack frame type"

#else
module GHC.Exts.Stack where
#endif