{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Wrench.Isa.Wasm32.Report () where

import Data.String.Interpolate (i)
import Data.Text qualified as T
import Relude
import Relude.Extra (insertWith, toPairs, (!?))
import Wrench.Isa.Wasm32.Instruction
import Wrench.Isa.Wasm32.State
import Wrench.Machine.BitPack (unpackWords)
import Wrench.Machine.Memory
import Wrench.Machine.Types
import Wrench.Report
import Wrench.Report.View (Format (..), View, format, lit, mkView, optArg, withRenames)

instance (IsWord w) => Inspectable (Wasm32St w) where
    type WordOf (Wasm32St w) = w
    type IsaOf (Wasm32St w) = Wasm32Isa w w

    programCounter :: Wasm32St w -> Int
programCounter Wasm32St{Int
pc :: Int
pc :: forall w. Wasm32St w -> Int
pc} = Int
pc
    memoryDump :: Wasm32St w -> MemOf (Wasm32St w)
memoryDump Wasm32St{IoMem (Wasm32Isa w w) w
mem :: IoMem (Wasm32Isa w w) w
mem :: forall w. Wasm32St w -> IoMem (Wasm32Isa w w) w
mem} = IoMem (Wasm32Isa w w) w
MemOf (Wasm32St w)
mem
    ioStreams :: Wasm32St w -> IntMap ([WordOf (Wasm32St w)], [WordOf (Wasm32St w)])
ioStreams Wasm32St{mem :: forall w. Wasm32St w -> IoMem (Wasm32Isa w w) w
mem = IoMem{IntMap ([w], [w])
mIoStreams :: IntMap ([w], [w])
mIoStreams :: forall isa w. IoMem isa w -> IntMap ([w], [w])
mIoStreams}} = IntMap ([w], [w])
IntMap ([WordOf (Wasm32St w)], [WordOf (Wasm32St w)])
mIoStreams
    isHalted :: Wasm32St w -> Bool
isHalted Wasm32St{Bool
stopped :: Bool
stopped :: forall w. Wasm32St w -> Bool
stopped} = Bool
stopped
    views :: [View (StateEnv (Wasm32St w))]
views = [View (StateEnv (Wasm32St w))]
forall w. IsWord w => [View (StateEnv (Wasm32St w))]
wasm32Views

wasm32Views :: (IsWord w) => [View (StateEnv (Wasm32St w))]
wasm32Views :: forall w. IsWord w => [View (StateEnv (Wasm32St w))]
wasm32Views =
    [(Text, Text)]
-> [View (StateEnv (Wasm32St w))] -> [View (StateEnv (Wasm32St w))]
forall env. [(Text, Text)] -> [View env] -> [View env]
withRenames
        [ (Text
"stackLayout", Text
"stack:layout")
        , (Text
"stackDump", Text
"stack:dump")
        , (Text
"frameBase", Text
"frame-base")
        , (Text
"ctrlSp", Text
"ctrl-sp")
        , (Text
"stackRoot", Text
"stack-root")
        ]
        [ Text
-> Text
-> (StackView (Wasm32Isa w w) w -> [w])
-> View (StateEnv (Wasm32St w))
forall {w} {a}.
(FiniteBits w, ByteSize w, Default w, Hashable w, Read w,
 WordParts w, FromSign w, Bounded w, Integral a, Integral w, Show a,
 Show w) =>
Text
-> Text
-> (StackView (Wasm32Isa w w) w -> [a])
-> View (StateEnv (Wasm32St w))
values Text
"stack" Text
"Operand stack of the current frame, top first: `a:b:c`." StackView (Wasm32Isa w w) w -> [w]
forall isa w. (ByteSize isa, IsWord w) => StackView isa w -> [w]
stackWords
        , Text
-> Text
-> (StackView (Wasm32Isa w w) w -> [w])
-> View (StateEnv (Wasm32St w))
forall {w} {a}.
(FiniteBits w, ByteSize w, Default w, Hashable w, Read w,
 WordParts w, FromSign w, Bounded w, Integral a, Integral w, Show a,
 Show w) =>
Text
-> Text
-> (StackView (Wasm32Isa w w) w -> [a])
-> View (StateEnv (Wasm32St w))
values Text
"locals" Text
"Locals of the current frame, `$0` first." StackView (Wasm32Isa w w) w -> [w]
forall isa w. (ByteSize isa, IsWord w) => StackView isa w -> [w]
localWords
        , Text
-> Text
-> (HashMap Text w
    -> StackView (Wasm32Isa w w) w -> LayoutFormat w -> Text)
-> View (StateEnv (Wasm32St w))
forall {w} {w}.
(FiniteBits w, ByteSize w, Default w, Hashable w, Read w,
 WordParts w, FromSign w, Bounded w, Integral w, Integral w, Show w,
 Show w) =>
Text
-> Text
-> (HashMap Text w
    -> StackView (Wasm32Isa w w) w -> LayoutFormat w -> Text)
-> View (StateEnv (Wasm32St w))
layout
            Text
"stack:layout"
            Text
"Call frames, outermost first: locals, open scopes, operands; `<frames>` keeps only the innermost ones."
            HashMap Text w
-> StackView (Wasm32Isa w w) w -> LayoutFormat w -> Text
forall isa w.
(ByteSize isa, IsWord w) =>
HashMap Text w -> StackView isa w -> LayoutFormat w -> Text
renderStackLayout
        , Text
-> Text
-> (HashMap Text w
    -> StackView (Wasm32Isa w w) w -> LayoutFormat w -> Text)
-> View (StateEnv (Wasm32St w))
forall {w} {w}.
(FiniteBits w, ByteSize w, Default w, Hashable w, Read w,
 WordParts w, FromSign w, Bounded w, Integral w, Integral w, Show w,
 Show w) =>
Text
-> Text
-> (HashMap Text w
    -> StackView (Wasm32Isa w w) w -> LayoutFormat w -> Text)
-> View (StateEnv (Wasm32St w))
layout
            Text
"stack:dump"
            Text
"Stack memory word by word, by address, with pointer tags; `<frames>` keeps only the innermost frames."
            HashMap Text w
-> StackView (Wasm32Isa w w) w -> LayoutFormat w -> Text
forall isa w.
(ByteSize isa, IsWord w, Show isa) =>
HashMap Text w -> StackView isa w -> LayoutFormat w -> Text
renderStackDump
        , Text
-> Text
-> (StateEnv (Wasm32St w) -> Int)
-> View (StateEnv (Wasm32St w))
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"sp" Text
"Address of the topmost operand." (Wasm32St w -> Int
forall w. Wasm32St w -> Int
sp (Wasm32St w -> Int)
-> (StateEnv (Wasm32St w) -> Wasm32St w)
-> StateEnv (Wasm32St w)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (Wasm32St w) -> Wasm32St w
forall st. StateEnv st -> st
seState)
        , Text
-> Text
-> (StateEnv (Wasm32St w) -> Int)
-> View (StateEnv (Wasm32St w))
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"frame-base" Text
"Address of local 0 of the current frame." (Wasm32St w -> Int
forall w. Wasm32St w -> Int
frameBase (Wasm32St w -> Int)
-> (StateEnv (Wasm32St w) -> Wasm32St w)
-> StateEnv (Wasm32St w)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (Wasm32St w) -> Wasm32St w
forall st. StateEnv st -> st
seState)
        , Text
-> Text
-> (StateEnv (Wasm32St w) -> Int)
-> View (StateEnv (Wasm32St w))
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"ctrl-sp" Text
"Top of the control stack." (Wasm32St w -> Int
forall w. Wasm32St w -> Int
ctrlSp (Wasm32St w -> Int)
-> (StateEnv (Wasm32St w) -> Wasm32St w)
-> StateEnv (Wasm32St w)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (Wasm32St w) -> Wasm32St w
forall st. StateEnv st -> st
seState)
        , Text
-> Text
-> (StateEnv (Wasm32St w) -> Int)
-> View (StateEnv (Wasm32St w))
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"stack-root" Text
"Where both stacks start, set by `sp.init`." (Wasm32St w -> Int
forall w. Wasm32St w -> Int
stackRoot (Wasm32St w -> Int)
-> (StateEnv (Wasm32St w) -> Wasm32St w)
-> StateEnv (Wasm32St w)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateEnv (Wasm32St w) -> Wasm32St w
forall st. StateEnv st -> st
seState)
        , Spec Format
-> Text
-> (StateEnv (Wasm32St w) -> Format -> Text)
-> View (StateEnv (Wasm32St w))
forall a env. Spec a -> Text -> (env -> a -> Text) -> View env
mkView
            (Text -> Spec ()
lit Text
"cache:scan" Spec () -> Spec Format -> Spec Format
forall a b. Spec a -> Spec b -> Spec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Format] -> Format -> Spec Format
format [Format
Dec, Format
Hex] Format
Dec)
            Text
"The last four `else`/`end` scans, most recent first: `start->end`."
            ((StateEnv (Wasm32St w) -> Format -> Text)
 -> View (StateEnv (Wasm32St w)))
-> (StateEnv (Wasm32St w) -> Format -> Text)
-> View (StateEnv (Wasm32St w))
forall a b. (a -> b) -> a -> b
$ \StateEnv{seState :: forall st. StateEnv st -> st
seState = Wasm32St{[(Int, Int)]
scanCache :: [(Int, Int)]
scanCache :: forall w. Wasm32St w -> [(Int, Int)]
scanCache, IoMem (Wasm32Isa w w) w
mem :: forall w. Wasm32St w -> IoMem (Wasm32Isa w w) w
mem :: IoMem (Wasm32Isa w w) w
mem}} Format
fmt ->
                let addr :: Int -> Text
addr = if Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Hex then Int -> Int -> Text
hexAddr (Int -> Int
hexAddrWidth (IoMem (Wasm32Isa w w) w -> Int
forall m isa w. Memory m isa w => m -> Int
memCapacity IoMem (Wasm32Isa w w) w
mem)) else Int -> Text
forall b a. (Show a, IsString b) => a -> b
show
                 in Text -> [Text] -> Text
T.intercalate Text
", " [Int -> Text
addr Int
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"->" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
addr Int
end | (Int
start, Int
end) <- [(Int, Int)]
scanCache]
        , Spec Format
-> Text
-> (StateEnv (Wasm32St w) -> Format -> Text)
-> View (StateEnv (Wasm32St w))
forall a env. Spec a -> Text -> (env -> a -> Text) -> View env
mkView
            (Text -> Spec ()
lit Text
"cache:branch" Spec () -> Spec Format -> Spec Format
forall a b. Spec a -> Spec b -> Spec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Format] -> Format -> Spec Format
format [Format
Dec, Format
Hex] Format
Dec)
            Text
"The last four taken branches, most recent first: `from->to`."
            ((StateEnv (Wasm32St w) -> Format -> Text)
 -> View (StateEnv (Wasm32St w)))
-> (StateEnv (Wasm32St w) -> Format -> Text)
-> View (StateEnv (Wasm32St w))
forall a b. (a -> b) -> a -> b
$ \StateEnv{seState :: forall st. StateEnv st -> st
seState = Wasm32St{[BranchEntry w]
branchCache :: [BranchEntry w]
branchCache :: forall w. Wasm32St w -> [BranchEntry w]
branchCache, IoMem (Wasm32Isa w w) w
mem :: forall w. Wasm32St w -> IoMem (Wasm32Isa w w) w
mem :: IoMem (Wasm32Isa w w) w
mem}} Format
fmt ->
                let addr :: Int -> Text
addr = if Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Hex then Int -> Int -> Text
hexAddr (Int -> Int
hexAddrWidth (IoMem (Wasm32Isa w w) w -> Int
forall m isa w. Memory m isa w => m -> Int
memCapacity IoMem (Wasm32Isa w w) w
mem)) else Int -> Text
forall b a. (Show a, IsString b) => a -> b
show
                 in Text -> [Text] -> Text
T.intercalate Text
", " [Int -> Text
addr Int
beFrom Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"->" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
addr Int
beTo | BranchEntry{Int
beFrom :: Int
beFrom :: forall w. BranchEntry w -> Int
beFrom, Int
beTo :: Int
beTo :: forall w. BranchEntry w -> Int
beTo} <- [BranchEntry w]
branchCache]
        , Spec Format
-> Text
-> (StateEnv (Wasm32St w) -> Format -> Text)
-> View (StateEnv (Wasm32St w))
forall a env. Spec a -> Text -> (env -> a -> Text) -> View env
mkView
            (Text -> Spec ()
lit Text
"stack:tos-regs" Spec () -> Spec Format -> Spec Format
forall a b. Spec a -> Spec b -> Spec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Format] -> Format -> Spec Format
format [Format
Dec, Format
Hex] Format
Dec)
            Text
"The top-of-stack registers, the last pushed first: `slot=value`."
            ((StateEnv (Wasm32St w) -> Format -> Text)
 -> View (StateEnv (Wasm32St w)))
-> (StateEnv (Wasm32St w) -> Format -> Text)
-> View (StateEnv (Wasm32St w))
forall a b. (a -> b) -> a -> b
$ \StateEnv{seState :: forall st. StateEnv st -> st
seState = Wasm32St{[(Int, w)]
tosRegs :: [(Int, w)]
tosRegs :: forall w. Wasm32St w -> [(Int, w)]
tosRegs, IoMem (Wasm32Isa w w) w
mem :: forall w. Wasm32St w -> IoMem (Wasm32Isa w w) w
mem :: IoMem (Wasm32Isa w w) w
mem}} Format
fmt ->
                let slot :: Int -> Text
slot = if Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Hex then Int -> Int -> Text
hexAddr (Int -> Int
hexAddrWidth (IoMem (Wasm32Isa w w) w -> Int
forall m isa w. Memory m isa w => m -> Int
memCapacity IoMem (Wasm32Isa w w) w
mem)) else Int -> Text
forall b a. (Show a, IsString b) => a -> b
show
                    value :: w -> Text
value = if Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Hex then [Char] -> Text
forall a. ToText a => a -> Text
toText ([Char] -> Text) -> (w -> [Char]) -> w -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> [Char]
forall {a}. Integral a => a -> [Char]
word32ToHex else w -> Text
forall b a. (Show a, IsString b) => a -> b
show
                 in Text -> [Text] -> Text
T.intercalate Text
", " [Int -> Text
slot Int
addr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> w -> Text
value w
v | (Int
addr, w
v) <- [(Int, w)]
tosRegs]
        ]
    where
        values :: Text
-> Text
-> (StackView (Wasm32Isa w w) w -> [a])
-> View (StateEnv (Wasm32St w))
values Text
name Text
doc StackView (Wasm32Isa w w) w -> [a]
f = Spec Format
-> Text
-> (StateEnv (Wasm32St w) -> Format -> Text)
-> View (StateEnv (Wasm32St w))
forall a env. Spec a -> Text -> (env -> a -> Text) -> View env
mkView (Text -> Spec ()
lit Text
name Spec () -> Spec Format -> Spec Format
forall a b. Spec a -> Spec b -> Spec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Format] -> Format -> Spec Format
format [Format
Dec, Format
Hex] Format
Dec) Text
doc ((StateEnv (Wasm32St w) -> Format -> Text)
 -> View (StateEnv (Wasm32St w)))
-> (StateEnv (Wasm32St w) -> Format -> Text)
-> View (StateEnv (Wasm32St w))
forall a b. (a -> b) -> a -> b
$ \StateEnv{Wasm32St w
seState :: forall st. StateEnv st -> st
seState :: Wasm32St w
seState} Format
fmt ->
            Format -> [a] -> Text
forall a. (Integral a, Show a) => Format -> [a] -> Text
showValues Format
fmt (StackView (Wasm32Isa w w) w -> [a]
f (Wasm32St w -> StackView (Wasm32Isa w w) w
forall w. IsWord w => Wasm32St w -> StackView (Wasm32Isa w w) w
stackView Wasm32St w
seState))
        layout :: Text
-> Text
-> (HashMap Text w
    -> StackView (Wasm32Isa w w) w -> LayoutFormat w -> Text)
-> View (StateEnv (Wasm32St w))
layout Text
name Text
doc HashMap Text w
-> StackView (Wasm32Isa w w) w -> LayoutFormat w -> Text
render = Spec (Format, Maybe Int)
-> Text
-> (StateEnv (Wasm32St w) -> (Format, Maybe Int) -> Text)
-> View (StateEnv (Wasm32St w))
forall a env. Spec a -> Text -> (env -> a -> Text) -> View env
mkView (Text -> Spec ()
lit Text
name Spec () -> Spec (Format, Maybe Int) -> Spec (Format, Maybe Int)
forall a b. Spec a -> Spec b -> Spec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((,) (Format -> Maybe Int -> (Format, Maybe Int))
-> Spec Format -> Spec (Maybe Int -> (Format, Maybe Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Format] -> Format -> Spec Format
format [Format
Dec, Format
Hex] Format
Dec Spec (Maybe Int -> (Format, Maybe Int))
-> Spec (Maybe Int) -> Spec (Format, Maybe Int)
forall a b. Spec (a -> b) -> Spec a -> Spec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Spec (Maybe Int)
optArg Text
"frames")) Text
doc ((StateEnv (Wasm32St w) -> (Format, Maybe Int) -> Text)
 -> View (StateEnv (Wasm32St w)))
-> (StateEnv (Wasm32St w) -> (Format, Maybe Int) -> Text)
-> View (StateEnv (Wasm32St w))
forall a b. (a -> b) -> a -> b
$
            \StateEnv{HashMap Text (WordOf (Wasm32St w))
seLabels :: HashMap Text (WordOf (Wasm32St w))
seLabels :: forall st. StateEnv st -> HashMap Text (WordOf st)
seLabels, Wasm32St w
seState :: forall st. StateEnv st -> st
seState :: Wasm32St w
seState} (Format
fmt, Maybe Int
limit) -> HashMap Text w
-> StackView (Wasm32Isa w w) w -> LayoutFormat w -> Text
render HashMap Text w
HashMap Text (WordOf (Wasm32St w))
seLabels (Wasm32St w -> StackView (Wasm32Isa w w) w
forall w. IsWord w => Wasm32St w -> StackView (Wasm32Isa w w) w
stackView Wasm32St w
seState) (Wasm32St w -> Format -> Maybe Int -> LayoutFormat w
forall {w} {w}.
(FiniteBits w, ByteSize w, Default w, Hashable w, Read w,
 WordParts w, FromSign w, Bounded w, Integral w, Integral w, Show w,
 Show w) =>
Wasm32St w -> Format -> Maybe Int -> LayoutFormat w
layoutFormat Wasm32St w
seState Format
fmt Maybe Int
limit)
        layoutFormat :: Wasm32St w -> Format -> Maybe Int -> LayoutFormat w
layoutFormat Wasm32St{IoMem (Wasm32Isa w w) w
mem :: forall w. Wasm32St w -> IoMem (Wasm32Isa w w) w
mem :: IoMem (Wasm32Isa w w) w
mem} Format
fmt Maybe Int
limit
            | Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Hex =
                LayoutFormat
                    { lfWord :: w -> Text
lfWord = [Char] -> Text
forall a. ToText a => a -> Text
toText ([Char] -> Text) -> (w -> [Char]) -> w -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> [Char]
forall {a}. Integral a => a -> [Char]
word32ToHex
                    , lfAddr :: Int -> Text
lfAddr = Int -> Int -> Text
hexAddr (Int -> Int
hexAddrWidth (IoMem (Wasm32Isa w w) w -> Int
forall m isa w. Memory m isa w => m -> Int
memCapacity IoMem (Wasm32Isa w w) w
mem))
                    , lfFrameLimit :: Maybe Int
lfFrameLimit = Maybe Int
limit
                    }
            | Bool
otherwise = LayoutFormat{lfWord :: w -> Text
lfWord = w -> Text
forall b a. (Show a, IsString b) => a -> b
show, lfAddr :: Int -> Text
lfAddr = Int -> Text
forall b a. (Show a, IsString b) => a -> b
show, lfFrameLimit :: Maybe Int
lfFrameLimit = Maybe Int
limit}

stackView :: (IsWord w) => Wasm32St w -> StackView (Wasm32Isa w w) w
stackView :: forall w. IsWord w => Wasm32St w -> StackView (Wasm32Isa w w) w
stackView st :: Wasm32St w
st@Wasm32St{IoMem (Wasm32Isa w w) w
mem :: forall w. Wasm32St w -> IoMem (Wasm32Isa w w) w
mem :: IoMem (Wasm32Isa w w) w
mem, Int
pc :: forall w. Wasm32St w -> Int
pc :: Int
pc, Int
sp :: forall w. Wasm32St w -> Int
sp :: Int
sp, Int
ctrlSp :: forall w. Wasm32St w -> Int
ctrlSp :: Int
ctrlSp, Int
frameBase :: forall w. Wasm32St w -> Int
frameBase :: Int
frameBase, Int
localCount :: Int
localCount :: forall w. Wasm32St w -> Int
localCount} =
    StackView
        { svMem :: IoMem (Wasm32Isa w w) w
svMem = IoMem (Wasm32Isa w w) w
mem
        , svPc :: Int
svPc = Int
pc
        , svSp :: Int
svSp = Int
sp
        , svFrameBase :: Int
svFrameBase = Int
frameBase
        , svLocalCount :: Int
svLocalCount = Int
localCount
        , svCtrlSp :: Int
svCtrlSp = Int
ctrlSp
        , svScopeAddrs :: [Int]
svScopeAddrs = Wasm32St w -> [Int]
forall w. IsWord w => Wasm32St w -> [Int]
scopeAddrs Wasm32St w
st
        }

data LayoutFormat w = LayoutFormat
    { forall w. LayoutFormat w -> w -> Text
lfWord :: w -> Text
    , forall w. LayoutFormat w -> Int -> Text
lfAddr :: Int -> Text
    , forall w. LayoutFormat w -> Maybe Int
lfFrameLimit :: Maybe Int
    }

data StackView isa w = StackView
    { forall isa w. StackView isa w -> IoMem isa w
svMem :: IoMem isa w
    , forall isa w. StackView isa w -> Int
svPc :: Int
    , forall isa w. StackView isa w -> Int
svSp :: Int
    , forall isa w. StackView isa w -> Int
svFrameBase :: Int
    , forall isa w. StackView isa w -> Int
svLocalCount :: Int
    , forall isa w. StackView isa w -> Int
svCtrlSp :: Int
    , forall isa w. StackView isa w -> [Int]
svScopeAddrs :: [Int]
    }

wordAt :: (ByteSize isa, IsWord w) => IoMem isa w -> Int -> Maybe w
wordAt :: forall isa w.
(ByteSize isa, IsWord w) =>
IoMem isa w -> Int -> Maybe w
wordAt IoMem isa w
mem Int
addr = (Text -> Maybe w)
-> ((IoMem isa w, w) -> Maybe w)
-> Either Text (IoMem isa w, w)
-> Maybe w
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe w -> Text -> Maybe w
forall a b. a -> b -> a
const Maybe w
forall a. Maybe a
Nothing) (w -> Maybe w
forall a. a -> Maybe a
Just (w -> Maybe w)
-> ((IoMem isa w, w) -> w) -> (IoMem isa w, w) -> Maybe w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IoMem isa w, w) -> w
forall a b. (a, b) -> b
snd) (IoMem isa w -> Int -> Either Text (IoMem isa w, w)
forall m isa w. Memory m isa w => m -> Int -> Either Text (m, w)
readWord IoMem isa w
mem Int
addr)

frameStackBase :: forall isa w. (IsWord w) => StackView isa w -> Int
frameStackBase :: forall isa w. IsWord w => StackView isa w -> Int
frameStackBase StackView{Int
svFrameBase :: forall isa w. StackView isa w -> Int
svFrameBase :: Int
svFrameBase, Int
svLocalCount :: forall isa w. StackView isa w -> Int
svLocalCount :: Int
svLocalCount} = Int
svFrameBase Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
svLocalCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* forall t. ByteSizeT t => Int
byteSizeT @w

stackWords :: forall isa w. (ByteSize isa, IsWord w) => StackView isa w -> [w]
stackWords :: forall isa w. (ByteSize isa, IsWord w) => StackView isa w -> [w]
stackWords view :: StackView isa w
view@StackView{IoMem isa w
svMem :: forall isa w. StackView isa w -> IoMem isa w
svMem :: IoMem isa w
svMem, Int
svSp :: forall isa w. StackView isa w -> Int
svSp :: Int
svSp} =
    (Int -> Maybe w) -> [Int] -> [w]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (IoMem isa w -> Int -> Maybe w
forall isa w.
(ByteSize isa, IsWord w) =>
IoMem isa w -> Int -> Maybe w
wordAt IoMem isa w
svMem) [Int
svSp, Int
svSp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step .. StackView isa w -> Int
forall isa w. IsWord w => StackView isa w -> Int
frameStackBase StackView isa w
view]
    where
        step :: Int
step = forall t. ByteSizeT t => Int
byteSizeT @w

localWords :: forall isa w. (ByteSize isa, IsWord w) => StackView isa w -> [w]
localWords :: forall isa w. (ByteSize isa, IsWord w) => StackView isa w -> [w]
localWords view :: StackView isa w
view@StackView{IoMem isa w
svMem :: forall isa w. StackView isa w -> IoMem isa w
svMem :: IoMem isa w
svMem, Int
svFrameBase :: forall isa w. StackView isa w -> Int
svFrameBase :: Int
svFrameBase} =
    (Int -> Maybe w) -> [Int] -> [w]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (IoMem isa w -> Int -> Maybe w
forall isa w.
(ByteSize isa, IsWord w) =>
IoMem isa w -> Int -> Maybe w
wordAt IoMem isa w
svMem) [Int
svFrameBase, Int
svFrameBase Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
step .. StackView isa w -> Int
forall isa w. IsWord w => StackView isa w -> Int
frameStackBase StackView isa w
view Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step]
    where
        step :: Int
step = forall t. ByteSizeT t => Int
byteSizeT @w

data FrameLayout = FrameLayout
    { FrameLayout -> Int
flPc :: Int
    , FrameLayout -> Int
flFrameBase :: Int
    , FrameLayout -> Int
flLocalCount :: Int
    , FrameLayout -> Int
flScanLower :: Int
    , FrameLayout -> [(Int, Int, Scope)]
flControls :: [(Int, Int, Scope)]
    }

walkFrames :: forall isa w. (ByteSize isa, IsWord w) => StackView isa w -> [FrameLayout]
walkFrames :: forall isa w.
(ByteSize isa, IsWord w) =>
StackView isa w -> [FrameLayout]
walkFrames StackView{IoMem isa w
svMem :: forall isa w. StackView isa w -> IoMem isa w
svMem :: IoMem isa w
svMem, Int
svPc :: forall isa w. StackView isa w -> Int
svPc :: Int
svPc, Int
svSp :: forall isa w. StackView isa w -> Int
svSp :: Int
svSp, Int
svFrameBase :: forall isa w. StackView isa w -> Int
svFrameBase :: Int
svFrameBase, Int
svLocalCount :: forall isa w. StackView isa w -> Int
svLocalCount :: Int
svLocalCount, [Int]
svScopeAddrs :: forall isa w. StackView isa w -> [Int]
svScopeAddrs :: [Int]
svScopeAddrs} =
    Int -> Int -> Int -> Int -> [Int] -> [FrameLayout]
go Int
svFrameBase Int
svLocalCount Int
svPc Int
svSp [Int]
svScopeAddrs
    where
        step :: Int
step = forall t. ByteSizeT t => Int
byteSizeT @w

        go :: Int -> Int -> Int -> Int -> [Int] -> [FrameLayout]
go Int
fb Int
lc Int
p Int
scanLower [Int]
addrs =
            let ([(Int, Int, Scope)]
controls, Maybe (Int, Int, Int, [Int])
next) = [Int] -> ([(Int, Int, Scope)], Maybe (Int, Int, Int, [Int]))
collectControls [Int]
addrs
                frame :: FrameLayout
frame =
                    FrameLayout
                        { flPc :: Int
flPc = Int
p
                        , flFrameBase :: Int
flFrameBase = Int
fb
                        , flLocalCount :: Int
flLocalCount = Int
lc
                        , flScanLower :: Int
flScanLower = Int
scanLower
                        , flControls :: [(Int, Int, Scope)]
flControls = ((Int, Int, Scope) -> Int)
-> [(Int, Int, Scope)] -> [(Int, Int, Scope)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(Int
s, Int
_, Scope
_) -> Int
s) [(Int, Int, Scope)]
controls
                        }
             in FrameLayout
frame FrameLayout -> [FrameLayout] -> [FrameLayout]
forall a. a -> [a] -> [a]
: case Maybe (Int, Int, Int, [Int])
next of
                    Maybe (Int, Int, Int, [Int])
Nothing -> []
                    Just (Int
fb', Int
lc', Int
p', [Int]
outer) -> Int -> Int -> Int -> Int -> [Int] -> [FrameLayout]
go Int
fb' Int
lc' Int
p' (Int
fb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step) [Int]
outer

        collectControls :: [Int] -> ([(Int, Int, Scope)], Maybe (Int, Int, Int, [Int]))
collectControls [] = ([], Maybe (Int, Int, Int, [Int])
forall a. Maybe a
Nothing)
        collectControls (Int
addr : [Int]
outer) = case IoMem isa w -> Int -> Maybe Scope
readScopeFrom IoMem isa w
svMem Int
addr of
            Maybe Scope
Nothing -> ([], Maybe (Int, Int, Int, [Int])
forall a. Maybe a
Nothing)
            Just Scope
scope ->
                let span_ :: (Int, Int, Scope)
span_ = (Int
addr, Int
addr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ forall w. IsWord w => Int
scopeRecordBytes @w, Scope
scope)
                 in case Scope
scope of
                        CallScope{Int
csCallerFrameBase :: Int
csCallerFrameBase :: Scope -> Int
csCallerFrameBase, Int
csCallerLocalCount :: Int
csCallerLocalCount :: Scope -> Int
csCallerLocalCount, Int
csReturnPc :: Int
csReturnPc :: Scope -> Int
csReturnPc} ->
                            ([(Int, Int, Scope)
span_], (Int, Int, Int, [Int]) -> Maybe (Int, Int, Int, [Int])
forall a. a -> Maybe a
Just (Int
csCallerFrameBase, Int
csCallerLocalCount, Int
csReturnPc, [Int]
outer))
                        Scope
_ ->
                            let ([(Int, Int, Scope)]
rest, Maybe (Int, Int, Int, [Int])
result) = [Int] -> ([(Int, Int, Scope)], Maybe (Int, Int, Int, [Int]))
collectControls [Int]
outer
                             in ((Int, Int, Scope)
span_ (Int, Int, Scope) -> [(Int, Int, Scope)] -> [(Int, Int, Scope)]
forall a. a -> [a] -> [a]
: [(Int, Int, Scope)]
rest, Maybe (Int, Int, Int, [Int])
result)

        readScopeFrom :: IoMem isa w -> Int -> Maybe Scope
readScopeFrom IoMem isa w
mem Int
addr =
            (Text -> Maybe Scope)
-> (Scope -> Maybe Scope) -> Either Text Scope -> Maybe Scope
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Scope -> Text -> Maybe Scope
forall a b. a -> b -> a
const Maybe Scope
forall a. Maybe a
Nothing) Scope -> Maybe Scope
forall a. a -> Maybe a
Just (Either Text Scope -> Maybe Scope)
-> ([w] -> Either Text Scope) -> [w] -> Maybe Scope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [w] -> Either Text Scope
forall a w. (BitPack a, IsWord w) => [w] -> Either Text a
unpackWords ([w] -> Maybe Scope) -> Maybe [w] -> Maybe Scope
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> Maybe w) -> [Int] -> Maybe [w]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IoMem isa w -> Int -> Maybe w
forall isa w.
(ByteSize isa, IsWord w) =>
IoMem isa w -> Int -> Maybe w
wordAt IoMem isa w
mem) (forall w. IsWord w => Int -> [Int]
scopeWordAddrs @w Int
addr)

keepLast :: Maybe Int -> [a] -> [a]
keepLast :: forall a. Maybe Int -> [a] -> [a]
keepLast Maybe Int
limit [a]
xs = [a] -> (Int -> [a]) -> Maybe Int -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
xs (\Int
n -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)) [a]
xs) Maybe Int
limit

funcNameAt :: (IsWord w) => HashMap Text w -> Int -> Text
funcNameAt :: forall w. IsWord w => HashMap Text w -> Int -> Text
funcNameAt HashMap Text w
labels Int
addr =
    Text -> ((Int, Text) -> Text) -> Maybe (Int, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"?" (Int, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Int, Text) -> Text) -> Maybe (Int, Text) -> Text
forall a b. (a -> b) -> a -> b
$ (Maybe (Int, Text) -> (Text, w) -> Maybe (Int, Text))
-> Maybe (Int, Text) -> [(Text, w)] -> Maybe (Int, Text)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe (Int, Text) -> (Text, w) -> Maybe (Int, Text)
nearer Maybe (Int, Text)
forall a. Maybe a
Nothing ([(Text, w)] -> Maybe (Int, Text))
-> [(Text, w)] -> Maybe (Int, Text)
forall a b. (a -> b) -> a -> b
$ HashMap Text w -> [(Text, w)]
forall t a b. (IsList t, Item t ~ (a, b)) => t -> [(a, b)]
toPairs HashMap Text w
labels
    where
        nearer :: Maybe (Int, Text) -> (Text, w) -> Maybe (Int, Text)
nearer Maybe (Int, Text)
best (Text
label, w
labelAddr)
            | Int
a <- w -> Int
forall a. Enum a => a -> Int
fromEnum w
labelAddr
            , Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
addr
            , Bool -> ((Int, Text) -> Bool) -> Maybe (Int, Text) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
a) (Int -> Bool) -> ((Int, Text) -> Int) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Int
forall a b. (a, b) -> a
fst) Maybe (Int, Text)
best =
                (Int, Text) -> Maybe (Int, Text)
forall a. a -> Maybe a
Just (Int
a, Text
label)
            | Bool
otherwise = Maybe (Int, Text)
best

renderStackLayout ::
    forall isa w.
    (ByteSize isa, IsWord w) =>
    HashMap Text w
    -> StackView isa w
    -> LayoutFormat w
    -> Text
renderStackLayout :: forall isa w.
(ByteSize isa, IsWord w) =>
HashMap Text w -> StackView isa w -> LayoutFormat w -> Text
renderStackLayout HashMap Text w
labels StackView isa w
view LayoutFormat{lfWord :: forall w. LayoutFormat w -> w -> Text
lfWord = w -> Text
showWord, lfAddr :: forall w. LayoutFormat w -> Int -> Text
lfAddr = Int -> Text
showAddr, lfFrameLimit :: forall w. LayoutFormat w -> Maybe Int
lfFrameLimit = Maybe Int
frameLimit} =
    Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
omittedNote [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ((Int, Bool, Maybe FrameLayout, FrameLayout) -> [Text])
-> [(Int, Bool, Maybe FrameLayout, FrameLayout)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Bool, Maybe FrameLayout, FrameLayout) -> [Text]
renderFrame [(Int, Bool, Maybe FrameLayout, FrameLayout)]
kept
    where
        step :: Int
step = forall t. ByteSizeT t => Int
byteSizeT @w
        StackView{IoMem isa w
svMem :: forall isa w. StackView isa w -> IoMem isa w
svMem :: IoMem isa w
svMem, Int
svSp :: forall isa w. StackView isa w -> Int
svSp :: Int
svSp, Int
svFrameBase :: forall isa w. StackView isa w -> Int
svFrameBase :: Int
svFrameBase} = StackView isa w
view

        frames :: [FrameLayout]
frames = [FrameLayout] -> [FrameLayout]
forall a. [a] -> [a]
reverse (StackView isa w -> [FrameLayout]
forall isa w.
(ByteSize isa, IsWord w) =>
StackView isa w -> [FrameLayout]
walkFrames StackView isa w
view)
        liveIndex :: Int
liveIndex = [FrameLayout] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FrameLayout]
frames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

        localsRange :: FrameLayout -> Maybe (Int, Int)
localsRange FrameLayout{Int
flFrameBase :: FrameLayout -> Int
flFrameBase :: Int
flFrameBase, Int
flLocalCount :: FrameLayout -> Int
flLocalCount :: Int
flLocalCount}
            | Int
flLocalCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe (Int, Int)
forall a. Maybe a
Nothing
            | Bool
otherwise = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
flFrameBase Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
flLocalCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
step Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step, Int
flFrameBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step)
        tagged :: [(Int, Bool, Maybe FrameLayout, FrameLayout)]
tagged =
            [ (Int
frameNo, Int
frameNo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
liveIndex, Maybe FrameLayout
caller, FrameLayout
frame)
            | (Int
frameNo, Maybe FrameLayout
caller, FrameLayout
frame) <- [Int]
-> [Maybe FrameLayout]
-> [FrameLayout]
-> [(Int, Maybe FrameLayout, FrameLayout)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0 :: Int ..] (Maybe FrameLayout
forall a. Maybe a
Nothing Maybe FrameLayout -> [Maybe FrameLayout] -> [Maybe FrameLayout]
forall a. a -> [a] -> [a]
: (FrameLayout -> Maybe FrameLayout)
-> [FrameLayout] -> [Maybe FrameLayout]
forall a b. (a -> b) -> [a] -> [b]
map FrameLayout -> Maybe FrameLayout
forall a. a -> Maybe a
Just [FrameLayout]
frames) [FrameLayout]
frames
            ]

        kept :: [(Int, Bool, Maybe FrameLayout, FrameLayout)]
kept = Maybe Int
-> [(Int, Bool, Maybe FrameLayout, FrameLayout)]
-> [(Int, Bool, Maybe FrameLayout, FrameLayout)]
forall a. Maybe Int -> [a] -> [a]
keepLast Maybe Int
frameLimit [(Int, Bool, Maybe FrameLayout, FrameLayout)]
tagged
        omittedNote :: [Text]
omittedNote
            | Int
n <- [(Int, Bool, Maybe FrameLayout, FrameLayout)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Bool, Maybe FrameLayout, FrameLayout)]
tagged Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(Int, Bool, Maybe FrameLayout, FrameLayout)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Bool, Maybe FrameLayout, FrameLayout)]
kept
            , Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
                [[i|  (#{n} earlier frame(s) omitted)|]]
            | Bool
otherwise = []

        renderFrame :: (Int, Bool, Maybe FrameLayout, FrameLayout) -> [Text]
renderFrame (Int
frameNo, Bool
isLive, Maybe FrameLayout
caller, FrameLayout{Int
flPc :: FrameLayout -> Int
flPc :: Int
flPc, Int
flFrameBase :: FrameLayout -> Int
flFrameBase :: Int
flFrameBase, Int
flLocalCount :: FrameLayout -> Int
flLocalCount :: Int
flLocalCount, Int
flScanLower :: FrameLayout -> Int
flScanLower :: Int
flScanLower, [(Int, Int, Scope)]
flControls :: FrameLayout -> [(Int, Int, Scope)]
flControls :: [(Int, Int, Scope)]
flControls}) =
            [Text]
header [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
localsLines [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
controlLines [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
operandLines
            where
                livePointers :: [(Text, Int)]
livePointers =
                    [(Text
"sp", Int
svSp) | Bool
isLive]
                        [(Text, Int)] -> [(Text, Int)] -> [(Text, Int)]
forall a. Semigroup a => a -> a -> a
<> [(Text
"frameBase", Int
svFrameBase) | Bool
isLive, Int
flLocalCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
                pointerTags :: Int -> Text
pointerTags Int
addr = [Text] -> Text
T.concat [[i| [#{name :: Text}]|] | (Text
name, Int
ptr) <- [(Text, Int)]
livePointers, Int
ptr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
addr]
                liveNote :: Text
liveNote = if Bool
isLive then Text
", live" else Text
"" :: Text
                header :: [Text]
header = [[i|\##{frameNo} #{funcNameAt labels flPc} (pc=#{showAddr flPc}#{liveNote})|]]
                opTop :: Int
opTop = Int
flFrameBase Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
flLocalCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
step
                localsLines :: [Text]
localsLines
                    | Int
flLocalCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
                    | Bool
otherwise = Int -> Int -> Text -> (Int -> Text) -> [Text]
indexedSpan (Int
opTop Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step) (Int
flFrameBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step) Text
"locals" Int -> Text
aliasNote

                operandTop :: Int
operandTop = Int
opTop Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step
                operandLines :: [Text]
operandLines
                    | Int
flScanLower Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
operandTop = [[i|  (operands): empty, base=#{showAddr operandTop}|]]
                    | Bool
otherwise = Int -> Int -> Text -> (Int -> Text) -> [Text]
indexedSpan Int
flScanLower Int
operandTop Text
"(operands)" (Text -> Int -> Text
forall a b. a -> b -> a
const Text
"")

                aliasNote :: Int -> Text
aliasNote Int
addr = case Maybe FrameLayout
caller of
                    Just c :: FrameLayout
c@FrameLayout{flFrameBase :: FrameLayout -> Int
flFrameBase = Int
callerBase}
                        | Just (Int
lo, Int
hi) <- FrameLayout -> Maybe (Int, Int)
localsRange FrameLayout
c
                        , Int
addr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lo Bool -> Bool -> Bool
&& Int
addr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hi ->
                            [i| [also \##{frameNo - 1} local #{(callerBase - addr) `div` step}]|]
                    Maybe FrameLayout
_ -> Text
""
                controlLines :: [Text]
controlLines = ((Int, Int, Scope) -> [Text]) -> [(Int, Int, Scope)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Int, Scope) -> [Text]
controlSpan [(Int, Int, Scope)]
flControls
                controlSpan :: (Int, Int, Scope) -> [Text]
controlSpan (Int
lo, Int
hi, Scope
scope) =
                    let (Text
firstLine, [Text]
restLines) = (Int -> Text) -> Scope -> (Text, [Text])
describeScope Int -> Text
showAddr Scope
scope
                     in [i|  mem[#{showAddr lo}..#{showAddr (hi - 1)}]: #{firstLine}|] Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
restLines

                indexedSpan :: Int -> Int -> Text -> (Int -> Text) -> [Text]
indexedSpan Int
lo Int
hi Text
tag Int -> Text
note =
                    [i|  mem[#{showAddr lo}..#{showAddr (hi - 1)}]: #{tag :: Text}|]
                        Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Int -> Int -> Text) -> [Int] -> [Int] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Int -> Text) -> Int -> Int -> Text
indexedWord Int -> Text
note) [Int
0 :: Int ..] [Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
step, Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
step .. Int
lo]
                indexedWord :: (Int -> Text) -> Int -> Int -> Text
indexedWord Int -> Text
note Int
idx Int
addr =
                    [i|    #{showAddr addr}..#{showAddr (addr + step - 1)}: #{maybe "?" showWord (wordAt svMem addr)} (#{idx})#{pointerTags addr}#{note addr :: Text}|]

describeScope :: (Int -> Text) -> Scope -> (Text, [Text])
describeScope :: (Int -> Text) -> Scope -> (Text, [Text])
describeScope Int -> Text
showAddr Scope
scope = case Scope
scope of
    LoopScope{Int
csStart :: Int
csStart :: Scope -> Int
csStart, Int
csEnd :: Int
csEnd :: Scope -> Int
csEnd} ->
        ([i|LoopScope { csStart = #{showAddr csStart}, csEnd = #{showAddr csEnd} }|], [])
    BlockScope{Int
csEnd :: Scope -> Int
csEnd :: Int
csEnd} ->
        ([i|BlockScope { csEnd = #{showAddr csEnd} }|], [])
    CallScope{Int
csCallerFrameBase :: Scope -> Int
csCallerFrameBase :: Int
csCallerFrameBase, Int
csCallerLocalCount :: Scope -> Int
csCallerLocalCount :: Int
csCallerLocalCount, Int
csReturnPc :: Scope -> Int
csReturnPc :: Int
csReturnPc, Int
csResultCount :: Int
csResultCount :: Scope -> Int
csResultCount} ->
        ( Text
"CallScope"
        ,
            [ [i|{ csCallerFrameBase = #{showAddr csCallerFrameBase}|]
            , [i|, csCallerLocalCount = #{csCallerLocalCount}|]
            , [i|, csReturnPc = #{showAddr csReturnPc}|]
            , [i|, csResultCount = #{csResultCount} }|]
            ]
        )

renderStackDump ::
    forall isa w.
    (ByteSize isa, IsWord w, Show isa) =>
    HashMap Text w
    -> StackView isa w
    -> LayoutFormat w
    -> Text
renderStackDump :: forall isa w.
(ByteSize isa, IsWord w, Show isa) =>
HashMap Text w -> StackView isa w -> LayoutFormat w -> Text
renderStackDump HashMap Text w
labels StackView isa w
view LayoutFormat{lfWord :: forall w. LayoutFormat w -> w -> Text
lfWord = w -> Text
showWord, lfAddr :: forall w. LayoutFormat w -> Int -> Text
lfAddr = Int -> Text
showAddr, lfFrameLimit :: forall w. LayoutFormat w -> Maybe Int
lfFrameLimit = Maybe Int
frameLimit} =
    Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Int, [Text])] -> [Text]
fillFrom (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ((Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
svSp (((Int, Int, [Text]) -> Int) -> [(Int, Int, [Text])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, [Text]) -> Int
forall {a} {b} {c}. (a, b, c) -> a
itemLo [(Int, Int, [Text])]
items))) (((Int, Int, [Text]) -> Int)
-> [(Int, Int, [Text])] -> [(Int, Int, [Text])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (Int, Int, [Text]) -> Int
forall {a} {b} {c}. (a, b, c) -> a
itemLo [(Int, Int, [Text])]
items)
    where
        step :: Int
step = forall t. ByteSizeT t => Int
byteSizeT @w
        StackView{IoMem isa w
svMem :: forall isa w. StackView isa w -> IoMem isa w
svMem :: IoMem isa w
svMem, Int
svSp :: forall isa w. StackView isa w -> Int
svSp :: Int
svSp, Int
svFrameBase :: forall isa w. StackView isa w -> Int
svFrameBase :: Int
svFrameBase, Int
svLocalCount :: forall isa w. StackView isa w -> Int
svLocalCount :: Int
svLocalCount, Int
svCtrlSp :: forall isa w. StackView isa w -> Int
svCtrlSp :: Int
svCtrlSp} = StackView isa w
view
        memEnd :: Int
memEnd = IoMem isa w -> Int
forall m isa w. Memory m isa w => m -> Int
memCapacity IoMem isa w
svMem

        frames :: [(Int, FrameLayout)]
frames = [Int] -> [FrameLayout] -> [(Int, FrameLayout)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] ([FrameLayout] -> [FrameLayout]
forall a. [a] -> [a]
reverse (StackView isa w -> [FrameLayout]
forall isa w.
(ByteSize isa, IsWord w) =>
StackView isa w -> [FrameLayout]
walkFrames StackView isa w
view))
        kept :: [(Int, FrameLayout)]
kept = Maybe Int -> [(Int, FrameLayout)] -> [(Int, FrameLayout)]
forall a. Maybe Int -> [a] -> [a]
keepLast Maybe Int
frameLimit [(Int, FrameLayout)]
frames
        omitted :: Int
omitted = [(Int, FrameLayout)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, FrameLayout)]
frames Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(Int, FrameLayout)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, FrameLayout)]
kept

        pointers :: [(Text, Int)]
pointers =
            [(Text
"sp", Int
svSp)]
                [(Text, Int)] -> [(Text, Int)] -> [(Text, Int)]
forall a. Semigroup a => a -> a -> a
<> [(Text
"frameBase", Int
svFrameBase) | Int
svLocalCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
                [(Text, Int)] -> [(Text, Int)] -> [(Text, Int)]
forall a. Semigroup a => a -> a -> a
<> [(Text
"ctrlSp", Int
svCtrlSp)]
        pointerTags :: Int -> Text
pointerTags Int
addr = [Text] -> Text
T.concat [[i| [#{name :: Text}]|] | (Text
name, Int
ptr) <- [(Text, Int)]
pointers, Int
ptr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
addr]
        tagFirst :: Int -> [Text] -> [Text]
tagFirst Int
addr = \case
            Text
line : [Text]
rest -> (Text
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
pointerTags Int
addr) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
rest
            [] -> []

        owner :: (Int, FrameLayout) -> Text
owner (Int
frameNo, FrameLayout{Int
flPc :: FrameLayout -> Int
flPc :: Int
flPc}) = [i|\##{frameNo} #{funcNameAt labels flPc}|] :: Text
        frameLocals :: (Int, FrameLayout) -> [(Int, Text)]
frameLocals frame :: (Int, FrameLayout)
frame@(Int
_, FrameLayout{Int
flFrameBase :: FrameLayout -> Int
flFrameBase :: Int
flFrameBase, Int
flLocalCount :: FrameLayout -> Int
flLocalCount :: Int
flLocalCount}) =
            [(Int
flFrameBase Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
step, [i|#{owner frame} local #{idx}|]) | Int
idx <- [Int
0 .. Int
flLocalCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
        frameOperands :: (Int, FrameLayout) -> [(Int, Text)]
frameOperands frame :: (Int, FrameLayout)
frame@(Int
_, FrameLayout{Int
flFrameBase :: FrameLayout -> Int
flFrameBase :: Int
flFrameBase, Int
flLocalCount :: FrameLayout -> Int
flLocalCount :: Int
flLocalCount, Int
flScanLower :: FrameLayout -> Int
flScanLower :: Int
flScanLower}) =
            (Int -> Int -> (Int, Text)) -> [Int] -> [Int] -> [(Int, Text)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                (\Int
idx Int
addr -> (Int
addr, [i|#{owner frame} operand #{idx}|]))
                [Int
0 :: Int ..]
                [Int
opTop, Int
opTop Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
step .. Int
flScanLower]
            where
                opTop :: Int
opTop = Int
flFrameBase Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
flLocalCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
step
        roles :: IntMap [Text]
        roles :: IntMap [Text]
roles =
            (IntMap [Text] -> (Int, Text) -> IntMap [Text])
-> IntMap [Text] -> [(Int, Text)] -> IntMap [Text]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                (\IntMap [Text]
m (Int
addr, Text
role) -> (Val (IntMap [Text]) -> Val (IntMap [Text]) -> Val (IntMap [Text]))
-> Key (IntMap [Text])
-> Val (IntMap [Text])
-> IntMap [Text]
-> IntMap [Text]
forall t.
DynamicMap t =>
(Val t -> Val t -> Val t) -> Key t -> Val t -> t -> t
insertWith (([Text] -> [Text] -> [Text]) -> [Text] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
(<>)) Int
Key (IntMap [Text])
addr [Text
role] IntMap [Text]
m)
                IntMap [Text]
forall a. Monoid a => a
mempty
                (((Int, FrameLayout) -> [(Int, Text)])
-> [(Int, FrameLayout)] -> [(Int, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int, FrameLayout)
frame -> (Int, FrameLayout) -> [(Int, Text)]
frameLocals (Int, FrameLayout)
frame [(Int, Text)] -> [(Int, Text)] -> [(Int, Text)]
forall a. Semigroup a => a -> a -> a
<> (Int, FrameLayout) -> [(Int, Text)]
frameOperands (Int, FrameLayout)
frame) ([(Int, FrameLayout)] -> [(Int, FrameLayout)]
forall a. [a] -> [a]
reverse [(Int, FrameLayout)]
frames))

        items :: [(Int, Int, [Text])]
items = [[(Int, Int, [Text])]] -> [(Int, Int, [Text])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([Int], [[(Int, Int, [Text])]]) -> [[(Int, Int, [Text])]]
forall a b. (a, b) -> b
snd (([Int] -> (Int, FrameLayout) -> ([Int], [(Int, Int, [Text])]))
-> [Int] -> [(Int, FrameLayout)] -> ([Int], [[(Int, Int, [Text])]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL [Int] -> (Int, FrameLayout) -> ([Int], [(Int, Int, [Text])])
frameItems [] ([(Int, FrameLayout)] -> [(Int, FrameLayout)]
forall a. [a] -> [a]
reverse [(Int, FrameLayout)]
kept))) [(Int, Int, [Text])]
-> [(Int, Int, [Text])] -> [(Int, Int, [Text])]
forall a. Semigroup a => a -> a -> a
<> [(Int, Int, [Text])]
recordItems [(Int, Int, [Text])]
-> [(Int, Int, [Text])] -> [(Int, Int, [Text])]
forall a. Semigroup a => a -> a -> a
<> [(Int, Int, [Text])]
omittedItem
        itemLo :: (a, b, c) -> a
itemLo (a
lo, b
_, c
_) = a
lo
        frameItems :: [Int] -> (Int, FrameLayout) -> ([Int], [(Int, Int, [Text])])
frameItems [Int]
shown (Int, FrameLayout)
frame =
            let fresh :: [(Int, Text)] -> [(Int, Text)]
fresh = ((Int, Text) -> Bool) -> [(Int, Text)] -> [(Int, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> [Int] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [Int]
shown) (Int -> Bool) -> ((Int, Text) -> Int) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Int
forall a b. (a, b) -> a
fst)
                locals :: [(Int, Text)]
locals = ((Int, Text) -> Int) -> [(Int, Text)] -> [(Int, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (Int, Text) -> Int
forall a b. (a, b) -> a
fst ([(Int, Text)] -> [(Int, Text)]
fresh ((Int, FrameLayout) -> [(Int, Text)]
frameLocals (Int, FrameLayout)
frame))
                operands :: [(Int, Text)]
operands = [(Int, Text)] -> [(Int, Text)]
fresh ((Int, FrameLayout) -> [(Int, Text)]
frameOperands (Int, FrameLayout)
frame)
             in ( ((Int, Text) -> Int) -> [(Int, Text)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> Int
forall a b. (a, b) -> a
fst ([(Int, Text)]
locals [(Int, Text)] -> [(Int, Text)] -> [(Int, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Int, Text)]
operands) [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int]
shown
                , (Int, FrameLayout) -> [Int] -> [(Int, Int, [Text])]
localsItem (Int, FrameLayout)
frame (((Int, Text) -> Int) -> [(Int, Text)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> Int
forall a b. (a, b) -> a
fst [(Int, Text)]
locals) [(Int, Int, [Text])]
-> [(Int, Int, [Text])] -> [(Int, Int, [Text])]
forall a. Semigroup a => a -> a -> a
<> [(Int
addr, Int
addr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step, [Int -> Text
wordLine Int
addr]) | (Int
addr, Text
_) <- [(Int, Text)]
operands]
                )
        localsItem :: (Int, FrameLayout) -> [Int] -> [(Int, Int, [Text])]
localsItem (Int, FrameLayout)
_ [] = []
        localsItem (Int, FrameLayout)
frame addrs :: [Int]
addrs@(Int
lo : [Int]
_) =
            let hi :: Int
hi = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
lo [Int]
addrs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step
             in [(Int
lo, Int
hi, [i|mem[#{showAddr lo}..#{showAddr (hi - 1)}]: #{owner frame} locals|] Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
wordLine) [Int]
addrs)]
        wordLine :: Int -> Text
wordLine Int
addr =
            let value :: Text
value = Text -> (w -> Text) -> Maybe w -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"?" w -> Text
showWord (IoMem isa w -> Int -> Maybe w
forall isa w.
(ByteSize isa, IsWord w) =>
IoMem isa w -> Int -> Maybe w
wordAt IoMem isa w
svMem Int
addr)
                owners :: Text
owners = Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (IntMap [Text]
roles IntMap [Text] -> Key (IntMap [Text]) -> Maybe (Val (IntMap [Text]))
forall t. StaticMap t => t -> Key t -> Maybe (Val t)
!? Int
Key (IntMap [Text])
addr))
             in [i|mem[#{showAddr addr}..#{showAddr (addr + step - 1)}]: #{value}  #{owners}#{pointerTags addr}|]
        recordItems :: [(Int, Int, [Text])]
recordItems =
            [ ( Int
lo
              , Int
hi
              , [i|mem[#{showAddr lo}..#{showAddr (hi - 1)}]: #{firstLine}  #{owner frame}#{pointerTags lo}|]
                    Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
restLines
              )
            | frame :: (Int, FrameLayout)
frame@(Int
_, FrameLayout{[(Int, Int, Scope)]
flControls :: FrameLayout -> [(Int, Int, Scope)]
flControls :: [(Int, Int, Scope)]
flControls}) <- [(Int, FrameLayout)]
kept
            , (Int
lo, Int
hi, Scope
scope) <- [(Int, Int, Scope)]
flControls
            , let (Text
firstLine, [Text]
restLines) = (Int -> Text) -> Scope -> (Text, [Text])
describeScope Int -> Text
showAddr Scope
scope
            ]
        omittedItem :: [(Int, Int, [Text])]
omittedItem = case [(Int, FrameLayout)]
kept of
            (Int
_, FrameLayout{Int
flFrameBase :: FrameLayout -> Int
flFrameBase :: Int
flFrameBase, flControls :: FrameLayout -> [(Int, Int, Scope)]
flControls = (Int
callLo, Int
_, Scope
_) : [(Int, Int, Scope)]
_}) : [(Int, FrameLayout)]
_
                | Int
omitted Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
                    let lo :: Int
lo = Int
flFrameBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step
                     in [(Int
lo, Int
callLo, [[i|mem[#{showAddr lo}..#{showAddr (callLo - 1)}]: (#{omitted} earlier frame(s) omitted)|]])]
            [(Int, FrameLayout)]
_ -> []

        fillFrom :: Int -> [(Int, Int, [Text])] -> [Text]
fillFrom Int
cursor [] = Int -> Int -> [Text]
raw Int
cursor Int
memEnd
        fillFrom Int
cursor ((Int
lo, Int
hi, [Text]
itemLines) : [(Int, Int, [Text])]
rest) =
            Int -> Int -> [Text]
raw Int
cursor Int
lo [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
itemLines [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Int -> [(Int, Int, [Text])] -> [Text]
fillFrom (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
cursor Int
hi) [(Int, Int, [Text])]
rest

        raw :: Int -> Int -> [Text]
raw Int
lo Int
hi =
            [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ Int -> [Text] -> [Text]
tagFirst Int
a ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Bool
-> (Int -> Text) -> HashMap Text w -> IntMap (Cell isa w) -> Text
forall w isa.
(ByteSize isa, IsWord w, Show isa) =>
Bool
-> (Int -> Text) -> HashMap Text w -> IntMap (Cell isa w) -> Text
prettyDump Bool
True Int -> Text
showAddr HashMap Text w
labels (IntMap (Cell isa w) -> Text) -> IntMap (Cell isa w) -> Text
forall a b. (a -> b) -> a -> b
$ [Item (IntMap (Cell isa w))] -> IntMap (Cell isa w)
forall l. IsList l => [Item l] -> l
fromList ([Item (IntMap (Cell isa w))] -> IntMap (Cell isa w))
-> [Item (IntMap (Cell isa w))] -> IntMap (Cell isa w)
forall a b. (a -> b) -> a -> b
$ [Int] -> IntMap (Cell isa w) -> [(Int, Cell isa w)]
forall isa w. [Int] -> IntMap (Cell isa w) -> [(Int, Cell isa w)]
sliceMem [Int
a .. Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] (IoMem isa w -> IntMap (Cell isa w)
forall m isa w. Memory m isa w => m -> IntMap (Cell isa w)
dumpCells IoMem isa w
svMem)
                | let lo' :: Int
lo' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
lo
                      hi' :: Int
hi' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
memEnd Int
hi
                      bounds :: [Int]
bounds = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortNub ([Int
lo', Int
hi'] [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int
p | (Text
_, Int
p) <- [(Text, Int)]
pointers, Int
lo' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p, Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hi'])
                , Int
lo' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hi'
                , (Int
a, Int
b) <- [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
bounds (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
bounds)
                ]