{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}

module GHC.Internal.Stack.Decode (
  -- * High-level stack decoders
  decode,
  decodeStack,
  decodeStackWithIpe,
  -- * Stack decoder helpers
  decodeStackWithFrameUnpack,
  -- * StackEntry
  StackEntry(..),
  -- * Pretty printing
  prettyStackEntry,
  )
where

import GHC.Internal.Base
import GHC.Internal.Show
import GHC.Internal.Real
import GHC.Internal.Word
import GHC.Internal.Num
import GHC.Internal.Data.Bits
import GHC.Internal.Data.Functor
import GHC.Internal.Data.Maybe (catMaybes)
import GHC.Internal.Data.List
import GHC.Internal.Data.Tuple
import GHC.Internal.Foreign.Ptr
import GHC.Internal.Foreign.Storable
import GHC.Internal.Exts

import GHC.Internal.ClosureTypes
import GHC.Internal.Heap.Closures
  ( Box (..),
    StackFrame,
    GenStackFrame (..),
    StgStackClosure,
    GenStgStackClosure (..),
    StackField,
    GenStackField(..)
  )
import GHC.Internal.Heap.Constants (wORD_SIZE_IN_BITS)
import GHC.Internal.Heap.InfoTable
import GHC.Internal.Stack.Constants
import GHC.Internal.Stack.CloneStack
import GHC.Internal.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE)

{- Note [Decoding the stack]
   ~~~~~~~~~~~~~~~~~~~~~~~~~

The stack is represented by a chain of StgStack closures. Each of these closures
is subject to garbage collection. I.e. they can be moved in memory (in a
simplified perspective) at any time.

The array of closures inside an StgStack (that makeup the execution stack; the
stack frames) is moved as bare memory by the garbage collector. References
(pointers) to stack frames are not updated by the garbage collector.

As the StgStack closure is moved as whole, the relative offsets inside it stay
the same. (Though, the absolute addresses change!)

Decoding
========

Stack frames are defined by their `StackSnapshot#` (`StgStack*` in RTS) and
their relative offset. This tuple is described by `StackFrameLocation`.

`StackFrame` is an ADT for decoded stack frames. Regarding payload and fields we
have to deal with three cases:

- If the payload can only be a closure, we put it in a `Box` for later decoding
  by the heap closure functions.

- If the payload can either be a closure or a word-sized value (this happens for
  bitmap-encoded payloads), we use a `StackField` which is a sum type to
  represent either a `Word` or a `Box`.

- Fields that are just simple (i.e. non-closure) values are decoded as such.

The decoding happens in two phases:

1. The whole stack is decoded into `StackFrameLocation`s.

2. All `StackFrameLocation`s are decoded into `StackFrame`s.

`StackSnapshot#` parameters are updated by the garbage collector and thus safe
to hand around.

The head of the stack frame array has offset (index) 0. To traverse the stack
frames the latest stack frame's offset is incremented by the closure size. The
unit of the offset is machine words (32bit or 64bit.)

IO
==

Unfortunately, ghc-heap decodes `Closure`s in `IO`. This leads to `StackFrames`
also being decoded in `IO`, due to references to `Closure`s.

Technical details
=================

- All access to StgStack/StackSnapshot# closures is made through Cmm code. This
  keeps the closure from being moved by the garbage collector during the
  operation.

- As StgStacks are mainly used in Cmm and C code, much of the decoding logic is
  implemented in Cmm and C. It's just easier to reuse existing helper macros and
  functions, than reinventing them in Haskell.

- Offsets and sizes of closures are imported from DerivedConstants.h via HSC.
  This keeps the code very portable.
-}

foreign import prim "getUnderflowFrameNextChunkzh"
  getUnderflowFrameNextChunk# ::
    StackSnapshot# -> Word# -> StackSnapshot#

getUnderflowFrameNextChunk :: StackSnapshot# -> WordOffset -> StackSnapshot
getUnderflowFrameNextChunk :: StackSnapshot# -> WordOffset -> StackSnapshot
getUnderflowFrameNextChunk StackSnapshot#
stackSnapshot# WordOffset
index =
  StackSnapshot# -> StackSnapshot
StackSnapshot (StackSnapshot# -> Word# -> StackSnapshot#
getUnderflowFrameNextChunk# StackSnapshot#
stackSnapshot# (WordOffset -> Word#
wordOffsetToWord# WordOffset
index))

foreign import prim "getWordzh"
  getWord# ::
    StackSnapshot# -> Word# -> Word#

getWord :: StackSnapshot# -> WordOffset -> Word
getWord :: StackSnapshot# -> WordOffset -> Word
getWord StackSnapshot#
stackSnapshot# WordOffset
index =
  Word# -> Word
W# (StackSnapshot# -> Word# -> Word#
getWord# StackSnapshot#
stackSnapshot# (WordOffset -> Word#
wordOffsetToWord# WordOffset
index))

foreign import prim "isArgGenBigRetFunTypezh" isArgGenBigRetFunType# :: StackSnapshot# -> Word# -> Int#

isArgGenBigRetFunType :: StackSnapshot# -> WordOffset -> Bool
isArgGenBigRetFunType :: StackSnapshot# -> WordOffset -> Bool
isArgGenBigRetFunType StackSnapshot#
stackSnapshot# WordOffset
index =
  Int# -> Int
I# (StackSnapshot# -> Word# -> Int#
isArgGenBigRetFunType# StackSnapshot#
stackSnapshot# (WordOffset -> Word#
wordOffsetToWord# WordOffset
index)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

-- | Gets contents of a `LargeBitmap` (@StgLargeBitmap@)
--
-- The first two arguments identify the location of the frame on the stack.
-- Returned is the `Addr#` of the @StgWord[]@ (bitmap) and it's size.
type LargeBitmapGetter = StackSnapshot# -> Word# -> (# Addr#, Word# #)

foreign import prim "getLargeBitmapzh" getLargeBitmap# :: LargeBitmapGetter

foreign import prim "getBCOLargeBitmapzh" getBCOLargeBitmap# :: LargeBitmapGetter

foreign import prim "getRetFunLargeBitmapzh" getRetFunLargeBitmap# :: LargeBitmapGetter

-- | Gets contents of a small bitmap (fitting in one @StgWord@)
--
-- The first two arguments identify the location of the frame on the stack.
-- Returned is the bitmap and it's size.
type SmallBitmapGetter = StackSnapshot# -> Word# -> (# Word#, Word# #)

foreign import prim "getSmallBitmapzh" getSmallBitmap# :: SmallBitmapGetter

foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: SmallBitmapGetter

foreign import prim "getInfoTableAddrszh" getInfoTableAddrs# :: StackSnapshot# -> Word# -> (# Addr#, Addr# #)

foreign import prim "getStackInfoTableAddrzh" getStackInfoTableAddr# :: StackSnapshot# -> Addr#

-- | Get the 'StgInfoTable' of the stack frame.
-- Additionally, provides 'InfoProv' for the 'StgInfoTable' if there is any.
getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO (StgInfoTable, Maybe InfoProv)
getInfoTableOnStack :: StackSnapshot# -> WordOffset -> IO (StgInfoTable, Maybe InfoProv)
getInfoTableOnStack StackSnapshot#
stackSnapshot# WordOffset
index =
  let !(# Addr#
itbl_struct#, Addr#
itbl_ptr_ipe_key# #) = StackSnapshot# -> Word# -> (# Addr#, Addr# #)
getInfoTableAddrs# StackSnapshot#
stackSnapshot# (WordOffset -> Word#
wordOffsetToWord# WordOffset
index)
   in
    (,) (StgInfoTable -> Maybe InfoProv -> (StgInfoTable, Maybe InfoProv))
-> IO StgInfoTable
-> IO (Maybe InfoProv -> (StgInfoTable, Maybe InfoProv))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr StgInfoTable -> IO StgInfoTable
peekItbl (Addr# -> Ptr StgInfoTable
forall a. Addr# -> Ptr a
Ptr Addr#
itbl_struct#) IO (Maybe InfoProv -> (StgInfoTable, Maybe InfoProv))
-> IO (Maybe InfoProv) -> IO (StgInfoTable, Maybe InfoProv)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr StgInfoTable -> IO (Maybe InfoProv)
lookupIPE (Addr# -> Ptr StgInfoTable
forall a. Addr# -> Ptr a
Ptr Addr#
itbl_ptr_ipe_key#)

getInfoTableForStack :: StackSnapshot# -> IO StgInfoTable
getInfoTableForStack :: StackSnapshot# -> IO StgInfoTable
getInfoTableForStack StackSnapshot#
stackSnapshot# =
  Ptr StgInfoTable -> IO StgInfoTable
peekItbl (Ptr StgInfoTable -> IO StgInfoTable)
-> Ptr StgInfoTable -> IO StgInfoTable
forall a b. (a -> b) -> a -> b
$
    Addr# -> Ptr StgInfoTable
forall a. Addr# -> Ptr a
Ptr (StackSnapshot# -> Addr#
getStackInfoTableAddr# StackSnapshot#
stackSnapshot#)

foreign import prim "getStackClosurezh"
  getStackClosure# ::
    StackSnapshot# -> Word# ->  Any

foreign import prim "getStackFieldszh"
  getStackFields# ::
    StackSnapshot# -> Word32#

getStackFields :: StackSnapshot# -> Word32
getStackFields :: StackSnapshot# -> Word32
getStackFields StackSnapshot#
stackSnapshot# =
  case StackSnapshot# -> Word32#
getStackFields# StackSnapshot#
stackSnapshot# of
    Word32#
sSize# -> Word32# -> Word32
W32# Word32#
sSize#

-- | `StackFrameLocation` of the top-most stack frame
stackHead :: StackSnapshot# -> StackFrameLocation
stackHead :: StackSnapshot# -> StackFrameLocation
stackHead StackSnapshot#
s# = (StackSnapshot# -> StackSnapshot
StackSnapshot StackSnapshot#
s#, WordOffset
0) -- GHC stacks are never empty

-- | Advance to the next stack frame (if any)
--
-- The last `Int#` in the result tuple is meant to be treated as bool
-- (has_next).
foreign import prim "advanceStackFrameLocationzh"
  advanceStackFrameLocation# ::
    StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #)

-- | Advance to the next stack frame (if any)
advanceStackFrameLocation :: StackFrameLocation -> Maybe StackFrameLocation
advanceStackFrameLocation :: StackFrameLocation -> Maybe StackFrameLocation
advanceStackFrameLocation ((StackSnapshot StackSnapshot#
stackSnapshot#), WordOffset
index) =
  let !(# StackSnapshot#
s', Word#
i', Int#
hasNext #) = StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #)
advanceStackFrameLocation# StackSnapshot#
stackSnapshot# (WordOffset -> Word#
wordOffsetToWord# WordOffset
index)
   in if Int# -> Int
I# Int#
hasNext Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        then StackFrameLocation -> Maybe StackFrameLocation
forall a. a -> Maybe a
Just (StackSnapshot# -> StackSnapshot
StackSnapshot StackSnapshot#
s', Word# -> WordOffset
primWordToWordOffset Word#
i')
        else Maybe StackFrameLocation
forall a. Maybe a
Nothing
  where
    primWordToWordOffset :: Word# -> WordOffset
    primWordToWordOffset :: Word# -> WordOffset
primWordToWordOffset Word#
w# = Word -> WordOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word# -> Word
W# Word#
w#)

getClosureBox :: StackSnapshot# -> WordOffset -> Box
getClosureBox :: StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# WordOffset
index =
        case StackSnapshot# -> Word# -> Any
getStackClosure# StackSnapshot#
stackSnapshot# (WordOffset -> Word#
wordOffsetToWord# WordOffset
index) of
          -- c needs to be strictly evaluated, otherwise a thunk gets boxed (and
          -- will later be decoded as such)
          !Any
c -> Any -> Box
Box Any
c

-- | Representation of @StgLargeBitmap@ (RTS)
data LargeBitmap = LargeBitmap
  { LargeBitmap -> Word
largeBitmapSize :: Word,
    LargeBitmap -> Ptr Word
largebitmapWords :: Ptr Word
  }

-- | Is a bitmap entry a closure pointer or a primitive non-pointer?
data Pointerness = Pointer | NonPointer
  deriving (Int -> Pointerness -> ShowS
[Pointerness] -> ShowS
Pointerness -> String
(Int -> Pointerness -> ShowS)
-> (Pointerness -> String)
-> ([Pointerness] -> ShowS)
-> Show Pointerness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pointerness -> ShowS
showsPrec :: Int -> Pointerness -> ShowS
$cshow :: Pointerness -> String
show :: Pointerness -> String
$cshowList :: [Pointerness] -> ShowS
showList :: [Pointerness] -> ShowS
Show)

decodeLargeBitmap :: LargeBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField]
decodeLargeBitmap :: LargeBitmapGetter
-> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField]
decodeLargeBitmap LargeBitmapGetter
getterFun# StackSnapshot#
stackSnapshot# WordOffset
index WordOffset
relativePayloadOffset = do
  let largeBitmap :: LargeBitmap
largeBitmap = case LargeBitmapGetter
getterFun# StackSnapshot#
stackSnapshot# (WordOffset -> Word#
wordOffsetToWord# WordOffset
index) of
        (# Addr#
wordsAddr#, Word#
size# #) -> Word -> Ptr Word -> LargeBitmap
LargeBitmap (Word# -> Word
W# Word#
size#) (Addr# -> Ptr Word
forall a. Addr# -> Ptr a
Ptr Addr#
wordsAddr#)
  bitmapWords <- LargeBitmap -> IO [Word]
largeBitmapToList LargeBitmap
largeBitmap
  pure $ decodeBitmaps
          stackSnapshot#
          (index + relativePayloadOffset)
          (bitmapWordsPointerness (largeBitmapSize largeBitmap) bitmapWords)
  where
    largeBitmapToList :: LargeBitmap -> IO [Word]
    largeBitmapToList :: LargeBitmap -> IO [Word]
largeBitmapToList LargeBitmap {Word
Ptr Word
largeBitmapSize :: LargeBitmap -> Word
largebitmapWords :: LargeBitmap -> Ptr Word
largeBitmapSize :: Word
largebitmapWords :: Ptr Word
..} =
      Ptr Word -> Int -> IO [Word]
cWordArrayToList Ptr Word
largebitmapWords (Int -> IO [Word]) -> Int -> IO [Word]
forall a b. (a -> b) -> a -> b
$
        (Int -> Int
usedBitmapWords (Int -> Int) -> (Word -> Int) -> Word -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Word
largeBitmapSize

    cWordArrayToList :: Ptr Word -> Int -> IO [Word]
    cWordArrayToList :: Ptr Word -> Int -> IO [Word]
cWordArrayToList Ptr Word
ptr Int
size = (Int -> IO Word) -> [Int] -> IO [Word]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr Word -> Int -> IO Word
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word
ptr) [Int
0 .. (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]

    usedBitmapWords :: Int -> Int
    usedBitmapWords :: Int -> Int
usedBitmapWords Int
0 = String -> Int
forall a. HasCallStack => String -> a
error String
"Invalid large bitmap size 0."
    usedBitmapWords Int
size = (Int
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wORD_SIZE_IN_BITS) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

    bitmapWordsPointerness :: Word -> [Word] -> [Pointerness]
    bitmapWordsPointerness :: Word -> [Word] -> [Pointerness]
bitmapWordsPointerness Word
size [Word]
_ | Word
size Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0 = []
    bitmapWordsPointerness Word
_ [] = []
    bitmapWordsPointerness Word
size (Word
w : [Word]
wds) =
      Word -> Word -> [Pointerness]
bitmapWordPointerness (Word -> Word -> Word
forall a. Ord a => a -> a -> a
min Word
size (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wORD_SIZE_IN_BITS)) Word
w
        [Pointerness] -> [Pointerness] -> [Pointerness]
forall a. [a] -> [a] -> [a]
++ Word -> [Word] -> [Pointerness]
bitmapWordsPointerness (Word
size Word -> Word -> Word
forall a. Num a => a -> a -> a
- Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wORD_SIZE_IN_BITS) [Word]
wds

bitmapWordPointerness :: Word -> Word -> [Pointerness]
bitmapWordPointerness :: Word -> Word -> [Pointerness]
bitmapWordPointerness Word
0 Word
_ = []
bitmapWordPointerness Word
bSize Word
bitmapWord =
  ( if (Word
bitmapWord Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
1) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0
      then Pointerness
NonPointer
      else Pointerness
Pointer
  )
    Pointerness -> [Pointerness] -> [Pointerness]
forall a. a -> [a] -> [a]
: Word -> Word -> [Pointerness]
bitmapWordPointerness
      (Word
bSize Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
      (Word
bitmapWord Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)

decodeBitmaps :: StackSnapshot# -> WordOffset -> [Pointerness] -> [StackField]
decodeBitmaps :: StackSnapshot# -> WordOffset -> [Pointerness] -> [StackField]
decodeBitmaps StackSnapshot#
stack# WordOffset
index [Pointerness]
ps =
  (Pointerness -> WordOffset -> StackField)
-> [Pointerness] -> [WordOffset] -> [StackField]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Pointerness -> WordOffset -> StackField
toPayload [Pointerness]
ps [WordOffset
index ..]
  where
    toPayload :: Pointerness -> WordOffset -> StackField
    toPayload :: Pointerness -> WordOffset -> StackField
toPayload Pointerness
p WordOffset
i = case Pointerness
p of
      Pointerness
NonPointer -> Word -> StackField
forall b. Word -> GenStackField b
StackWord (StackSnapshot# -> WordOffset -> Word
getWord StackSnapshot#
stack# WordOffset
i)
      Pointerness
Pointer -> Box -> StackField
forall b. b -> GenStackField b
StackBox (StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stack# WordOffset
i)

decodeSmallBitmap :: SmallBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> [StackField]
decodeSmallBitmap :: SmallBitmapGetter
-> StackSnapshot# -> WordOffset -> WordOffset -> [StackField]
decodeSmallBitmap SmallBitmapGetter
getterFun# StackSnapshot#
stackSnapshot# WordOffset
index WordOffset
relativePayloadOffset =
  let (Word
bitmap, Word
size) = case SmallBitmapGetter
getterFun# StackSnapshot#
stackSnapshot# (WordOffset -> Word#
wordOffsetToWord# WordOffset
index) of
        (# Word#
b#, Word#
s# #) -> (Word# -> Word
W# Word#
b#, Word# -> Word
W# Word#
s#)
  in StackSnapshot# -> WordOffset -> [Pointerness] -> [StackField]
decodeBitmaps
      StackSnapshot#
stackSnapshot#
      (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
relativePayloadOffset)
      (Word -> Word -> [Pointerness]
bitmapWordPointerness Word
size Word
bitmap)

unpackStackFrame :: StackFrameLocation -> IO StackFrame
unpackStackFrame :: StackFrameLocation -> IO StackFrame
unpackStackFrame StackFrameLocation
stackFrameLoc = do
  StackFrameLocation
-> (StgInfoTable
    -> Maybe InfoProv -> StackSnapshot -> IO StackFrame)
-> (StackFrame -> Maybe InfoProv -> IO StackFrame)
-> IO StackFrame
forall a.
StackFrameLocation
-> (StgInfoTable -> Maybe InfoProv -> StackSnapshot -> IO a)
-> (StackFrame -> Maybe InfoProv -> IO a)
-> IO a
unpackStackFrameTo StackFrameLocation
stackFrameLoc
    (\ StgInfoTable
info Maybe InfoProv
_ StackSnapshot
nextChunk -> do
      stackClosure <- StackSnapshot -> IO StgStackClosure
decodeStack StackSnapshot
nextChunk
      pure $
        UnderflowFrame
          { info_tbl = info,
            nextChunk = stackClosure
          }
    )
    (\ StackFrame
frame Maybe InfoProv
_ -> StackFrame -> IO StackFrame
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StackFrame
frame)

unpackStackFrameWithIpe :: StackFrameLocation -> IO [(StackFrame, Maybe InfoProv)]
unpackStackFrameWithIpe :: StackFrameLocation -> IO [(StackFrame, Maybe InfoProv)]
unpackStackFrameWithIpe StackFrameLocation
stackFrameLoc = do
  StackFrameLocation
-> (StgInfoTable
    -> Maybe InfoProv
    -> StackSnapshot
    -> IO [(StackFrame, Maybe InfoProv)])
-> (StackFrame
    -> Maybe InfoProv -> IO [(StackFrame, Maybe InfoProv)])
-> IO [(StackFrame, Maybe InfoProv)]
forall a.
StackFrameLocation
-> (StgInfoTable -> Maybe InfoProv -> StackSnapshot -> IO a)
-> (StackFrame -> Maybe InfoProv -> IO a)
-> IO a
unpackStackFrameTo StackFrameLocation
stackFrameLoc
    (\ StgInfoTable
info Maybe InfoProv
mIpe nextChunk :: StackSnapshot
nextChunk@(StackSnapshot StackSnapshot#
stack#) -> do
      framesWithIpe <- StackSnapshot -> IO [(StackFrame, Maybe InfoProv)]
decodeStackWithIpe StackSnapshot
nextChunk
      pure
        [ ( UnderflowFrame
            { info_tbl = info,
              nextChunk =
                GenStgStackClosure
                  { ssc_info = info,
                    ssc_stack_size = getStackFields stack#,
                    ssc_stack = map fst framesWithIpe
                  }
            }
          , mIpe
          )
        ]
    )
    (\ StackFrame
frame Maybe InfoProv
mIpe -> [(StackFrame, Maybe InfoProv)] -> IO [(StackFrame, Maybe InfoProv)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(StackFrame
frame, Maybe InfoProv
mIpe)])

unpackStackFrameTo ::
  forall a .
  StackFrameLocation ->
  -- ^ Decode the given 'StackFrame'.
  (StgInfoTable -> Maybe InfoProv -> StackSnapshot -> IO a) ->
  -- ^ How to handle 'UNDERFLOW_FRAME's.
  (StackFrame -> Maybe InfoProv -> IO a) ->
  -- ^ How to handle all other 'StackFrame' values.
  IO a
unpackStackFrameTo :: forall a.
StackFrameLocation
-> (StgInfoTable -> Maybe InfoProv -> StackSnapshot -> IO a)
-> (StackFrame -> Maybe InfoProv -> IO a)
-> IO a
unpackStackFrameTo (StackSnapshot StackSnapshot#
stackSnapshot#, WordOffset
index) StgInfoTable -> Maybe InfoProv -> StackSnapshot -> IO a
unpackUnderflowFrame StackFrame -> Maybe InfoProv -> IO a
finaliseStackFrame = do
  (info, m_info_prov) <- StackSnapshot# -> WordOffset -> IO (StgInfoTable, Maybe InfoProv)
getInfoTableOnStack StackSnapshot#
stackSnapshot# WordOffset
index
  unpackStackFrame' info
    (unpackUnderflowFrame info m_info_prov)
    (`finaliseStackFrame` m_info_prov)
  where
    unpackStackFrame' ::
      StgInfoTable ->
      (StackSnapshot -> IO a) ->
      (StackFrame -> IO a) ->
      IO a
    unpackStackFrame' :: StgInfoTable
-> (StackSnapshot -> IO a) -> (StackFrame -> IO a) -> IO a
unpackStackFrame' StgInfoTable
info StackSnapshot -> IO a
mkUnderflowResult StackFrame -> IO a
mkStackFrameResult =
      case StgInfoTable -> ClosureType
tipe StgInfoTable
info of
        ClosureType
RET_BCO -> do
          let bco' :: Box
bco' = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgClosurePayload)
          -- The arguments begin directly after the payload's one element
          bcoArgs' <- LargeBitmapGetter
-> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField]
decodeLargeBitmap LargeBitmapGetter
getBCOLargeBitmap# StackSnapshot#
stackSnapshot# WordOffset
index (WordOffset
offsetStgClosurePayload WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
1)
          mkStackFrameResult
            RetBCO
              { info_tbl = info,
                bco = bco',
                bcoArgs = bcoArgs'
              }
        ClosureType
RET_SMALL ->
          let payload' :: [StackField]
payload' = SmallBitmapGetter
-> StackSnapshot# -> WordOffset -> WordOffset -> [StackField]
decodeSmallBitmap SmallBitmapGetter
getSmallBitmap# StackSnapshot#
stackSnapshot# WordOffset
index WordOffset
offsetStgClosurePayload
          in
            StackFrame -> IO a
mkStackFrameResult (StackFrame -> IO a) -> StackFrame -> IO a
forall a b. (a -> b) -> a -> b
$
              RetSmall
                { info_tbl :: StgInfoTable
info_tbl = StgInfoTable
info,
                  stack_payload :: [StackField]
stack_payload = [StackField]
payload'
                }
        ClosureType
RET_BIG -> do
          payload' <- LargeBitmapGetter
-> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField]
decodeLargeBitmap LargeBitmapGetter
getLargeBitmap# StackSnapshot#
stackSnapshot# WordOffset
index WordOffset
offsetStgClosurePayload
          mkStackFrameResult $
            RetBig
              { info_tbl = info,
                stack_payload = payload'
              }
        ClosureType
RET_FUN -> do
          let retFunSize' :: Word
retFunSize' = StackSnapshot# -> WordOffset -> Word
getWord StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgRetFunFrameSize)
              retFunFun' :: Box
retFunFun' = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgRetFunFrameFun)
          retFunPayload' <-
            if StackSnapshot# -> WordOffset -> Bool
isArgGenBigRetFunType StackSnapshot#
stackSnapshot# WordOffset
index Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True
              then LargeBitmapGetter
-> StackSnapshot# -> WordOffset -> WordOffset -> IO [StackField]
decodeLargeBitmap LargeBitmapGetter
getRetFunLargeBitmap# StackSnapshot#
stackSnapshot# WordOffset
index WordOffset
offsetStgRetFunFramePayload
              else [StackField] -> IO [StackField]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([StackField] -> IO [StackField])
-> [StackField] -> IO [StackField]
forall a b. (a -> b) -> a -> b
$ SmallBitmapGetter
-> StackSnapshot# -> WordOffset -> WordOffset -> [StackField]
decodeSmallBitmap SmallBitmapGetter
getRetFunSmallBitmap# StackSnapshot#
stackSnapshot# WordOffset
index WordOffset
offsetStgRetFunFramePayload
          mkStackFrameResult $
            RetFun
              { info_tbl = info,
                retFunSize = retFunSize',
                retFunFun = retFunFun',
                retFunPayload = retFunPayload'
              }
        ClosureType
UPDATE_FRAME ->
          let updatee' :: Box
updatee' = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgUpdateFrameUpdatee)
          in
            StackFrame -> IO a
mkStackFrameResult (StackFrame -> IO a) -> StackFrame -> IO a
forall a b. (a -> b) -> a -> b
$
              UpdateFrame
                { info_tbl :: StgInfoTable
info_tbl = StgInfoTable
info,
                  updatee :: Box
updatee = Box
updatee'
                }
        ClosureType
CATCH_FRAME -> do
          let handler' :: Box
handler' = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgCatchFrameHandler)
          StackFrame -> IO a
mkStackFrameResult (StackFrame -> IO a) -> StackFrame -> IO a
forall a b. (a -> b) -> a -> b
$
            CatchFrame
              { info_tbl :: StgInfoTable
info_tbl = StgInfoTable
info,
                handler :: Box
handler = Box
handler'
              }
        ClosureType
UNDERFLOW_FRAME -> do
          let nextChunk' :: StackSnapshot
nextChunk' = StackSnapshot# -> WordOffset -> StackSnapshot
getUnderflowFrameNextChunk StackSnapshot#
stackSnapshot# WordOffset
index
          StackSnapshot -> IO a
mkUnderflowResult StackSnapshot
nextChunk'
        ClosureType
STOP_FRAME -> StackFrame -> IO a
mkStackFrameResult (StackFrame -> IO a) -> StackFrame -> IO a
forall a b. (a -> b) -> a -> b
$ StopFrame {info_tbl :: StgInfoTable
info_tbl = StgInfoTable
info}
        ClosureType
ATOMICALLY_FRAME -> do
          let atomicallyFrameCode' :: Box
atomicallyFrameCode' = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgAtomicallyFrameCode)
              result' :: Box
result' = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgAtomicallyFrameResult)
          StackFrame -> IO a
mkStackFrameResult (StackFrame -> IO a) -> StackFrame -> IO a
forall a b. (a -> b) -> a -> b
$
            AtomicallyFrame
              { info_tbl :: StgInfoTable
info_tbl = StgInfoTable
info,
                atomicallyFrameCode :: Box
atomicallyFrameCode = Box
atomicallyFrameCode',
                result :: Box
result = Box
result'
              }
        ClosureType
CATCH_RETRY_FRAME ->
          let running_alt_code' :: Word
running_alt_code' = StackSnapshot# -> WordOffset -> Word
getWord StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgCatchRetryFrameRunningAltCode)
              first_code' :: Box
first_code' = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgCatchRetryFrameRunningFirstCode)
              alt_code' :: Box
alt_code' = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgCatchRetryFrameAltCode)
          in
            StackFrame -> IO a
mkStackFrameResult (StackFrame -> IO a) -> StackFrame -> IO a
forall a b. (a -> b) -> a -> b
$
              CatchRetryFrame
                { info_tbl :: StgInfoTable
info_tbl = StgInfoTable
info,
                  running_alt_code :: Word
running_alt_code = Word
running_alt_code',
                  first_code :: Box
first_code = Box
first_code',
                  alt_code :: Box
alt_code = Box
alt_code'
                }
        ClosureType
CATCH_STM_FRAME ->
          let catchFrameCode' :: Box
catchFrameCode' = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgCatchSTMFrameCode)
              handler' :: Box
handler' = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgCatchSTMFrameHandler)
          in
            StackFrame -> IO a
mkStackFrameResult (StackFrame -> IO a) -> StackFrame -> IO a
forall a b. (a -> b) -> a -> b
$
              CatchStmFrame
                { info_tbl :: StgInfoTable
info_tbl = StgInfoTable
info,
                  catchFrameCode :: Box
catchFrameCode = Box
catchFrameCode',
                  handler :: Box
handler = Box
handler'
                }
        ClosureType
ANN_FRAME ->
          let annotation :: Box
annotation = StackSnapshot# -> WordOffset -> Box
getClosureBox StackSnapshot#
stackSnapshot# (WordOffset
index WordOffset -> WordOffset -> WordOffset
forall a. Num a => a -> a -> a
+ WordOffset
offsetStgAnnFrameAnn)
           in
             StackFrame -> IO a
mkStackFrameResult (StackFrame -> IO a) -> StackFrame -> IO a
forall a b. (a -> b) -> a -> b
$
               AnnFrame
                { info_tbl :: StgInfoTable
info_tbl = StgInfoTable
info,
                  annotation :: Box
annotation = Box
annotation
                }
        ClosureType
x -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"Unexpected closure type on stack: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ClosureType -> String
forall a. Show a => a -> String
show ClosureType
x

-- | Unbox 'Int#' from 'Int'
toInt# :: Int -> Int#
toInt# :: Int -> Int#
toInt# (I# Int#
i) = Int#
i

-- | Convert `Int` to `Word#`
intToWord# :: Int -> Word#
intToWord# :: Int -> Word#
intToWord# Int
i = Int# -> Word#
int2Word# (Int -> Int#
toInt# Int
i)

wordOffsetToWord# :: WordOffset -> Word#
wordOffsetToWord# :: WordOffset -> Word#
wordOffsetToWord# WordOffset
wo = Int -> Word#
intToWord# (WordOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOffset
wo)

-- ----------------------------------------------------------------------------
-- Simplified source location representation of provenance information
-- ----------------------------------------------------------------------------

-- | Representation for the source location where a return frame was pushed on the stack.
-- This happens every time when a @case ... of@ scrutinee is evaluated.
data StackEntry = StackEntry
  { StackEntry -> String
functionName :: String,
    StackEntry -> String
moduleName :: String,
    StackEntry -> String
srcLoc :: String,
    StackEntry -> ClosureType
closureType :: ClosureType
  }
  deriving (Int -> StackEntry -> ShowS
[StackEntry] -> ShowS
StackEntry -> String
(Int -> StackEntry -> ShowS)
-> (StackEntry -> String)
-> ([StackEntry] -> ShowS)
-> Show StackEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackEntry -> ShowS
showsPrec :: Int -> StackEntry -> ShowS
$cshow :: StackEntry -> String
show :: StackEntry -> String
$cshowList :: [StackEntry] -> ShowS
showList :: [StackEntry] -> ShowS
Show, StackEntry -> StackEntry -> Bool
(StackEntry -> StackEntry -> Bool)
-> (StackEntry -> StackEntry -> Bool) -> Eq StackEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StackEntry -> StackEntry -> Bool
== :: StackEntry -> StackEntry -> Bool
$c/= :: StackEntry -> StackEntry -> Bool
/= :: StackEntry -> StackEntry -> Bool
Eq)

toStackEntry :: InfoProv -> StackEntry
toStackEntry :: InfoProv -> StackEntry
toStackEntry InfoProv
infoProv =
  StackEntry
  { functionName :: String
functionName = InfoProv -> String
ipLabel InfoProv
infoProv,
    moduleName :: String
moduleName = InfoProv -> String
ipMod InfoProv
infoProv,
    srcLoc :: String
srcLoc = InfoProv -> String
ipLoc InfoProv
infoProv,
    closureType :: ClosureType
closureType = InfoProv -> ClosureType
ipDesc InfoProv
infoProv
  }

-- ----------------------------------------------------------------------------
-- Stack decoders
-- ----------------------------------------------------------------------------

-- | Decode a 'StackSnapshot' to a stacktrace (a list of 'StackEntry').
-- The stack trace is created from return frames with according 'InfoProvEnt'
-- entries. To generate them, use the GHC flag @-finfo-table-map@. If there are
-- no 'InfoProvEnt' entries, an empty list is returned.
--
-- Please note:
--
--   * To gather 'StackEntry' from libraries, these have to be
--     compiled with @-finfo-table-map@, too.
--   * Due to optimizations by GHC (e.g. inlining) the stacktrace may change
--     with different GHC parameters and versions.
--   * The stack trace is empty (by design) if there are no return frames on
--     the stack. (These are pushed every time when a @case ... of@ scrutinee
--     is evaluated.)
--
-- @since base-4.17.0.0
decode :: StackSnapshot -> IO [StackEntry]
decode :: StackSnapshot -> IO [StackEntry]
decode StackSnapshot
stackSnapshot =
  ((InfoProv -> StackEntry) -> [InfoProv] -> [StackEntry]
forall a b. (a -> b) -> [a] -> [b]
map InfoProv -> StackEntry
toStackEntry ([InfoProv] -> [StackEntry])
-> ([(StackFrame, Maybe InfoProv)] -> [InfoProv])
-> [(StackFrame, Maybe InfoProv)]
-> [StackEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe InfoProv] -> [InfoProv]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe InfoProv] -> [InfoProv])
-> ([(StackFrame, Maybe InfoProv)] -> [Maybe InfoProv])
-> [(StackFrame, Maybe InfoProv)]
-> [InfoProv]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((StackFrame, Maybe InfoProv) -> Maybe InfoProv)
-> [(StackFrame, Maybe InfoProv)] -> [Maybe InfoProv]
forall a b. (a -> b) -> [a] -> [b]
map (StackFrame, Maybe InfoProv) -> Maybe InfoProv
forall a b. (a, b) -> b
snd ([(StackFrame, Maybe InfoProv)] -> [Maybe InfoProv])
-> ([(StackFrame, Maybe InfoProv)]
    -> [(StackFrame, Maybe InfoProv)])
-> [(StackFrame, Maybe InfoProv)]
-> [Maybe InfoProv]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(StackFrame, Maybe InfoProv)] -> [(StackFrame, Maybe InfoProv)]
forall a. [a] -> [a]
reverse) ([(StackFrame, Maybe InfoProv)] -> [StackEntry])
-> IO [(StackFrame, Maybe InfoProv)] -> IO [StackEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackSnapshot -> IO [(StackFrame, Maybe InfoProv)]
decodeStackWithIpe StackSnapshot
stackSnapshot


-- | Location of a stackframe on the stack
--
-- It's defined by the `StackSnapshot` (@StgStack@) and the offset to the bottom
-- of the stack.
type StackFrameLocation = (StackSnapshot, WordOffset)

-- | Decode `StackSnapshot` to a `StgStackClosure`
--
-- The return value is the representation of the @StgStack@ itself.
--
-- See /Note [Decoding the stack]/.
decodeStack :: StackSnapshot -> IO StgStackClosure
decodeStack :: StackSnapshot -> IO StgStackClosure
decodeStack snapshot :: StackSnapshot
snapshot@(StackSnapshot StackSnapshot#
stack#) = do
  (stackInfo, ssc_stack) <- (StackFrameLocation -> IO StackFrame)
-> StackSnapshot -> IO (StgInfoTable, [StackFrame])
forall a.
(StackFrameLocation -> IO a)
-> StackSnapshot -> IO (StgInfoTable, [a])
decodeStackWithFrameUnpack StackFrameLocation -> IO StackFrame
unpackStackFrame StackSnapshot
snapshot
  pure
    GenStgStackClosure
      { ssc_info = stackInfo,
        ssc_stack_size = getStackFields stack#,
        ssc_stack = ssc_stack
      }

decodeStackWithIpe :: StackSnapshot -> IO [(StackFrame, Maybe InfoProv)]
decodeStackWithIpe :: StackSnapshot -> IO [(StackFrame, Maybe InfoProv)]
decodeStackWithIpe StackSnapshot
snapshot =
  [[(StackFrame, Maybe InfoProv)]] -> [(StackFrame, Maybe InfoProv)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(StackFrame, Maybe InfoProv)]]
 -> [(StackFrame, Maybe InfoProv)])
-> ((StgInfoTable, [[(StackFrame, Maybe InfoProv)]])
    -> [[(StackFrame, Maybe InfoProv)]])
-> (StgInfoTable, [[(StackFrame, Maybe InfoProv)]])
-> [(StackFrame, Maybe InfoProv)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StgInfoTable, [[(StackFrame, Maybe InfoProv)]])
-> [[(StackFrame, Maybe InfoProv)]]
forall a b. (a, b) -> b
snd ((StgInfoTable, [[(StackFrame, Maybe InfoProv)]])
 -> [(StackFrame, Maybe InfoProv)])
-> IO (StgInfoTable, [[(StackFrame, Maybe InfoProv)]])
-> IO [(StackFrame, Maybe InfoProv)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StackFrameLocation -> IO [(StackFrame, Maybe InfoProv)])
-> StackSnapshot
-> IO (StgInfoTable, [[(StackFrame, Maybe InfoProv)]])
forall a.
(StackFrameLocation -> IO a)
-> StackSnapshot -> IO (StgInfoTable, [a])
decodeStackWithFrameUnpack StackFrameLocation -> IO [(StackFrame, Maybe InfoProv)]
unpackStackFrameWithIpe StackSnapshot
snapshot

-- ----------------------------------------------------------------------------
-- Write your own stack decoder!
-- ----------------------------------------------------------------------------

decodeStackWithFrameUnpack :: (StackFrameLocation -> IO a) -> StackSnapshot -> IO (StgInfoTable, [a])
decodeStackWithFrameUnpack :: forall a.
(StackFrameLocation -> IO a)
-> StackSnapshot -> IO (StgInfoTable, [a])
decodeStackWithFrameUnpack StackFrameLocation -> IO a
unpackFrame (StackSnapshot StackSnapshot#
stack#) = do
  info <- StackSnapshot# -> IO StgInfoTable
getInfoTableForStack StackSnapshot#
stack#
  case tipe info of
    ClosureType
STACK -> do
      let sfls :: [StackFrameLocation]
sfls = StackSnapshot# -> [StackFrameLocation]
stackFrameLocations StackSnapshot#
stack#
      stack' <- (StackFrameLocation -> IO a) -> [StackFrameLocation] -> IO [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM StackFrameLocation -> IO a
unpackFrame [StackFrameLocation]
sfls
      pure (info, stack')
    ClosureType
_ -> String -> IO (StgInfoTable, [a])
forall a. HasCallStack => String -> a
error (String -> IO (StgInfoTable, [a]))
-> String -> IO (StgInfoTable, [a])
forall a b. (a -> b) -> a -> b
$ String
"Expected STACK closure, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ StgInfoTable -> String
forall a. Show a => a -> String
show StgInfoTable
info
  where
    stackFrameLocations :: StackSnapshot# -> [StackFrameLocation]
    stackFrameLocations :: StackSnapshot# -> [StackFrameLocation]
stackFrameLocations StackSnapshot#
s# =
      StackSnapshot# -> StackFrameLocation
stackHead StackSnapshot#
s#
        StackFrameLocation -> [StackFrameLocation] -> [StackFrameLocation]
forall a. a -> [a] -> [a]
: Maybe StackFrameLocation -> [StackFrameLocation]
go (StackFrameLocation -> Maybe StackFrameLocation
advanceStackFrameLocation (StackSnapshot# -> StackFrameLocation
stackHead StackSnapshot#
s#))
      where
        go :: Maybe StackFrameLocation -> [StackFrameLocation]
        go :: Maybe StackFrameLocation -> [StackFrameLocation]
go Maybe StackFrameLocation
Nothing = []
        go (Just StackFrameLocation
r) = StackFrameLocation
r StackFrameLocation -> [StackFrameLocation] -> [StackFrameLocation]
forall a. a -> [a] -> [a]
: Maybe StackFrameLocation -> [StackFrameLocation]
go (StackFrameLocation -> Maybe StackFrameLocation
advanceStackFrameLocation StackFrameLocation
r)

-- ----------------------------------------------------------------------------
-- Pretty printing functions for stack entries, stack frames and provenance info
-- ----------------------------------------------------------------------------

prettyStackEntry :: StackEntry -> String
prettyStackEntry :: StackEntry -> String
prettyStackEntry (StackEntry {moduleName :: StackEntry -> String
moduleName=String
mod_nm, functionName :: StackEntry -> String
functionName=String
fun_nm, srcLoc :: StackEntry -> String
srcLoc=String
loc}) =
  String
mod_nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fun_nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"