{-# OPTIONS_GHC -Wno-missing-signatures #-}

module Wrench.Report (
    ReportSlice (..),
    ReportConf (..),
    Report,
    compileReports,
    prepareReport,
    renderIsaView,
    sharedViews,
    isaViews,
    ReportViews,
    valueView,
    flagView,
    showValue,
    showValues,
) where

import Data.Aeson (FromJSON (..), Value (..), genericParseJSON, rejectUnknownFields)
import Data.Aeson.Casing (aesonDrop, snakeCase)
import Data.IntMap.Strict qualified as IM
import Data.Map.Strict qualified as M
import Data.Text qualified as T
import Numeric (showHex)
import Relude
import Relude.Extra
import Wrench.Machine.Memory
import Wrench.Machine.Types
import Wrench.Report.View
import Wrench.Translator (TranslatorResult (..))

data ReportConf = ReportConf
    { ReportConf -> Maybe Text
rcName :: Maybe Text
    -- ^ Optional name of the report.
    -- Example: Just "My Report"
    , ReportConf -> ReportSlice
rcSlice :: ReportSlice
    -- ^ Specifies which part of the report to select.
    -- Example: HeadSlice 10
    , ReportConf -> Maybe Text
rcAssert :: Maybe Text
    -- ^ Optional assertion string to compare the report against.
    -- Example: Just "Expected output"
    , ReportConf -> Maybe Text
rcView :: Maybe Text
    }
    deriving ((forall x. ReportConf -> Rep ReportConf x)
-> (forall x. Rep ReportConf x -> ReportConf) -> Generic ReportConf
forall x. Rep ReportConf x -> ReportConf
forall x. ReportConf -> Rep ReportConf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReportConf -> Rep ReportConf x
from :: forall x. ReportConf -> Rep ReportConf x
$cto :: forall x. Rep ReportConf x -> ReportConf
to :: forall x. Rep ReportConf x -> ReportConf
Generic, Int -> ReportConf -> ShowS
[ReportConf] -> ShowS
ReportConf -> String
(Int -> ReportConf -> ShowS)
-> (ReportConf -> String)
-> ([ReportConf] -> ShowS)
-> Show ReportConf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportConf -> ShowS
showsPrec :: Int -> ReportConf -> ShowS
$cshow :: ReportConf -> String
show :: ReportConf -> String
$cshowList :: [ReportConf] -> ShowS
showList :: [ReportConf] -> ShowS
Show)

instance FromJSON ReportConf where
    parseJSON :: Value -> Parser ReportConf
parseJSON = Options -> Value -> Parser ReportConf
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ReportConf)
-> Options -> Value -> Parser ReportConf
forall a b. (a -> b) -> a -> b
$ (Int -> ShowS -> Options
aesonDrop Int
2 ShowS
snakeCase){rejectUnknownFields = True}

-- | What a shared view sees: the ISA's 'StateEnv' plus the record and the run.
data ReportEnv st = ReportEnv
    { forall st. ReportEnv st -> StateEnv st
reState :: StateEnv st
    , forall st. ReportEnv st -> DumpStats
reDumpStats :: DumpStats
    , forall st. ReportEnv st -> Int
reInstrCount :: Int
    , forall st. ReportEnv st -> Maybe (IsaOf st)
rePrevInstr :: Maybe (IsaOf st)
    , forall st. ReportEnv st -> AccessCount
reAccesses :: AccessCount
    -- ^ Made by the instruction that produced this record.
    , forall st. ReportEnv st -> Text
reProfile :: Text
    -- ^ The whole run's profile table, built only if asked.
    }

type ReportViews st =
    ( ByteSize (IsaOf st)
    , Inspectable st
    , IsWord (WordOf st)
    , Memory (MemOf st) (IsaOf st) (WordOf st)
    , Show (IsaOf st)
    )

-- | The ISA's own views, its stats among them.
isaViews :: forall st. (Inspectable st) => [View (StateEnv st)]
isaViews :: forall st. Inspectable st => [View (StateEnv st)]
isaViews = forall st. Inspectable st => [View (StateEnv st)]
views @st [View (StateEnv st)]
-> [View (StateEnv st)] -> [View (StateEnv st)]
forall a. Semigroup a => a -> a -> a
<> (Stat (StateEnv st) -> View (StateEnv st))
-> [Stat (StateEnv st)] -> [View (StateEnv st)]
forall a b. (a -> b) -> [a] -> [b]
map Stat (StateEnv st) -> View (StateEnv st)
forall env. Stat env -> View env
statView (forall st. Inspectable st => [Stat (StateEnv st)]
isaStats @st)

-- | Every view a report on this ISA can use.
reportViews :: forall st. (ReportViews st) => [View (ReportEnv st)]
reportViews :: forall st. ReportViews st => [View (ReportEnv st)]
reportViews = (View (StateEnv st) -> View (ReportEnv st))
-> [View (StateEnv st)] -> [View (ReportEnv st)]
forall a b. (a -> b) -> [a] -> [b]
map ((ReportEnv st -> StateEnv st)
-> View (StateEnv st) -> View (ReportEnv st)
forall b a. (b -> a) -> View a -> View b
contramapView ReportEnv st -> StateEnv st
forall st. ReportEnv st -> StateEnv st
reState) (forall st. Inspectable st => [View (StateEnv st)]
isaViews @st) [View (ReportEnv st)]
-> [View (ReportEnv st)] -> [View (ReportEnv st)]
forall a. Semigroup a => a -> a -> a
<> [View (ReportEnv st)]
forall st. ReportViews st => [View (ReportEnv st)]
sharedViews

-- | The views every ISA has.
sharedViews :: forall st. (ReportViews st) => [View (ReportEnv st)]
sharedViews :: forall st. ReportViews st => [View (ReportEnv st)]
sharedViews =
    [(Text, Text)] -> [View (ReportEnv st)] -> [View (ReportEnv st)]
forall env. [(Text, Text)] -> [View env] -> [View env]
withRenames
        [ (Text
"memAccesses", Text
"mem:accesses")
        , (Text
"memReads", Text
"mem:reads")
        , (Text
"memWrites", Text
"mem:writes")
        , (Text
"memAccessesTotal", Text
"mem:accesses-total")
        , (Text
"memReadsTotal", Text
"mem:reads-total")
        , (Text
"memWritesTotal", Text
"mem:writes-total")
        , (Text
"memory:table", Text
"mem:table")
        , (Text
"memory", Text
"mem:dump")
        , (Text
"mem:per-instruction", Text
"profile")
        ]
        [ Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"pc" Text
"Program counter." (st -> Int
forall st. Inspectable st => st -> Int
programCounter (st -> Int) -> (ReportEnv st -> st) -> ReportEnv st -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> st
forall {c}. ReportEnv c -> c
current)
        , Text -> Text -> (ReportEnv st -> Text) -> View (ReportEnv st)
forall env. Text -> Text -> (env -> Text) -> View env
flagView Text
"pc:label" Text
"`@label` if the program counter is at a label, otherwise empty." ReportEnv st -> Text
forall {st}.
(Eq (WordOf st), Enum (WordOf st), Inspectable st) =>
ReportEnv st -> Text
pcLabel
        , Text -> Text -> (ReportEnv st -> Text) -> View (ReportEnv st)
forall env. Text -> Text -> (env -> Text) -> View env
flagView Text
"instruction:prev" Text
"The instruction that produced this state, `-` for the initial state." ((ReportEnv st -> Text) -> View (ReportEnv st))
-> (ReportEnv st -> Text) -> View (ReportEnv st)
forall a b. (a -> b) -> a -> b
$
            Text -> (IsaOf st -> Text) -> Maybe (IsaOf st) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"-" IsaOf st -> Text
forall b a. (Show a, IsString b) => a -> b
show (Maybe (IsaOf st) -> Text)
-> (ReportEnv st -> Maybe (IsaOf st)) -> ReportEnv st -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> Maybe (IsaOf st)
forall st. ReportEnv st -> Maybe (IsaOf st)
rePrevInstr
        , Text -> Text -> (ReportEnv st -> Text) -> View (ReportEnv st)
forall env. Text -> Text -> (env -> Text) -> View env
flagView Text
"instruction:next" Text
"The instruction to execute next, `-` once halted." (st -> Text
forall {st} {a} {b} {w}.
(Inspectable st, IsString a, Show b, Memory (MemOf st) b w) =>
st -> a
nextInstruction (st -> Text) -> (ReportEnv st -> st) -> ReportEnv st -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> st
forall {c}. ReportEnv c -> c
current)
        , Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"sim:instruction-count" Text
"Instructions executed so far." ReportEnv st -> Int
forall st. ReportEnv st -> Int
reInstrCount
        , Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView
            Text
"mem:accesses"
            Text
"Memory accesses of the instruction that produced this state, its fetch included."
            (AccessCount -> Int
acTotal (AccessCount -> Int)
-> (ReportEnv st -> AccessCount) -> ReportEnv st -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> AccessCount
forall st. ReportEnv st -> AccessCount
reAccesses)
        , Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"mem:reads" Text
"Reads among `mem:accesses`; a fetch is a read." (AccessCount -> Int
acReads (AccessCount -> Int)
-> (ReportEnv st -> AccessCount) -> ReportEnv st -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> AccessCount
forall st. ReportEnv st -> AccessCount
reAccesses)
        , Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"mem:writes" Text
"Writes among `mem:accesses`." (AccessCount -> Int
acWrites (AccessCount -> Int)
-> (ReportEnv st -> AccessCount) -> ReportEnv st -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> AccessCount
forall st. ReportEnv st -> AccessCount
reAccesses)
        , Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"mem:accesses-total" Text
"Memory accesses of the run so far." (AccessCount -> Int
acTotal (AccessCount -> Int)
-> (ReportEnv st -> AccessCount) -> ReportEnv st -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> AccessCount
runTotal)
        , Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"mem:reads-total" Text
"Reads of the run so far." (AccessCount -> Int
acReads (AccessCount -> Int)
-> (ReportEnv st -> AccessCount) -> ReportEnv st -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> AccessCount
runTotal)
        , Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"mem:writes-total" Text
"Writes of the run so far." (AccessCount -> Int
acWrites (AccessCount -> Int)
-> (ReportEnv st -> AccessCount) -> ReportEnv st -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> AccessCount
runTotal)
        , Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"layout:sections-size" Text
"Bytes in all sections." (DumpStats -> Int
dsSectionsTotalBytes (DumpStats -> Int)
-> (ReportEnv st -> DumpStats) -> ReportEnv st -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> DumpStats
forall st. ReportEnv st -> DumpStats
reDumpStats)
        , Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"layout:text-sections-size" Text
"Bytes in `.text` sections." (DumpStats -> Int
dsTextSectionsBytes (DumpStats -> Int)
-> (ReportEnv st -> DumpStats) -> ReportEnv st -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> DumpStats
forall st. ReportEnv st -> DumpStats
reDumpStats)
        , Text -> Text -> (ReportEnv st -> Int) -> View (ReportEnv st)
forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
"layout:data-sections-size" Text
"Bytes in `.data` sections." (DumpStats -> Int
dsDataSectionsBytes (DumpStats -> Int)
-> (ReportEnv st -> DumpStats) -> ReportEnv st -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> DumpStats
forall st. ReportEnv st -> DumpStats
reDumpStats)
        , Text -> Text -> (ReportEnv st -> Intervals) -> View (ReportEnv st)
forall {t}. Text -> Text -> (t -> Intervals) -> View t
ranges Text
"layout:text-ranges" Text
"Address ranges of `.text` sections." (DumpStats -> Intervals
dsTextIntervals (DumpStats -> Intervals)
-> (ReportEnv st -> DumpStats) -> ReportEnv st -> Intervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> DumpStats
forall st. ReportEnv st -> DumpStats
reDumpStats)
        , Text -> Text -> (ReportEnv st -> Intervals) -> View (ReportEnv st)
forall {t}. Text -> Text -> (t -> Intervals) -> View t
ranges Text
"layout:data-ranges" Text
"Address ranges of `.data` sections." (DumpStats -> Intervals
dsDataIntervals (DumpStats -> Intervals)
-> (ReportEnv st -> DumpStats) -> ReportEnv st -> Intervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> DumpStats
forall st. ReportEnv st -> DumpStats
reDumpStats)
        , Text -> Text -> (ReportEnv st -> Intervals) -> View (ReportEnv st)
forall {t}. Text -> Text -> (t -> Intervals) -> View t
ranges Text
"mem:instr-ranges" Text
"Address ranges the run fetched instructions from." (AccessLog -> Intervals
alInstr (AccessLog -> Intervals)
-> (ReportEnv st -> AccessLog) -> ReportEnv st -> Intervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> AccessLog
finalLog)
        , Text -> Text -> (ReportEnv st -> Intervals) -> View (ReportEnv st)
forall {t}. Text -> Text -> (t -> Intervals) -> View t
ranges Text
"mem:data-ranges" Text
"Address ranges the run read or wrote data at." (AccessLog -> Intervals
alData (AccessLog -> Intervals)
-> (ReportEnv st -> AccessLog) -> ReportEnv st -> Intervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> AccessLog
finalLog)
        , Text -> Text -> (ReportEnv st -> Intervals) -> View (ReportEnv st)
forall {t}. Text -> Text -> (t -> Intervals) -> View t
ranges Text
"mem:io-ranges" Text
"Memory-mapped IO addresses the run accessed." (AccessLog -> Intervals
alIo (AccessLog -> Intervals)
-> (ReportEnv st -> AccessLog) -> ReportEnv st -> Intervals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> AccessLog
finalLog)
        , Text -> Text -> (ReportEnv st -> Text) -> View (ReportEnv st)
forall env. Text -> Text -> (env -> Text) -> View env
flagView Text
"mem:table" Text
"Address-space table: sections, IO, free spans and their access coverage." ((ReportEnv st -> Text) -> View (ReportEnv st))
-> (ReportEnv st -> Text) -> View (ReportEnv st)
forall a b. (a -> b) -> a -> b
$ \ReportEnv st
e ->
            DumpStats -> MemOf st -> Text
forall m isa w.
(IsWord w, Memory m isa w) =>
DumpStats -> m -> Text
renderMemoryTable (ReportEnv st -> DumpStats
forall st. ReportEnv st -> DumpStats
reDumpStats ReportEnv st
e) (st -> MemOf st
forall st. Inspectable st => st -> MemOf st
memoryDump (ReportEnv st -> st
forall {c}. ReportEnv c -> c
final ReportEnv st
e))
        , Text -> Text -> (ReportEnv st -> Text) -> View (ReportEnv st)
forall env. Text -> Text -> (env -> Text) -> View env
flagView
            Text
"profile"
            Text
"How often each instruction ran, with its reads and writes, over the whole run."
            ReportEnv st -> Text
forall st. ReportEnv st -> Text
reProfile
        , Spec (Int, Int)
-> Text
-> (CheckEnv -> (Int, Int) -> Either Text ())
-> (ReportEnv st -> (Int, Int) -> Text)
-> View (ReportEnv st)
forall a env.
Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (env -> a -> Text)
-> View env
checkedView
            (Text -> Spec ()
lit Text
"mem:dump" Spec () -> Spec (Int, Int) -> Spec (Int, Int)
forall a b. Spec a -> Spec b -> Spec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((,) (Int -> Int -> (Int, Int)) -> Spec Int -> Spec (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Spec Int
arg Text
"from" Spec (Int -> (Int, Int)) -> Spec Int -> Spec (Int, 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 Int
arg Text
"to"))
            Text
"Memory dump from `<from>` to `<to>`, inclusive."
            CheckEnv -> (Int, Int) -> Either Text ()
forall {a}.
(Semigroup a, IsString a) =>
CheckEnv -> (Int, Int) -> Either a ()
checkRange
            (\ReportEnv st
e (Int
from, Int
to) -> st -> Int -> Int -> Text
forall st. ReportViews st => st -> Int -> Int -> Text
viewMemory (ReportEnv st -> st
forall {c}. ReportEnv c -> c
current ReportEnv st
e) Int
from Int
to)
        , Spec (Int, Format)
-> Text
-> (CheckEnv -> (Int, Format) -> Either Text ())
-> (ReportEnv st -> (Int, Format) -> Text)
-> View (ReportEnv st)
forall a env.
Spec a
-> Text
-> (CheckEnv -> a -> Either Text ())
-> (env -> a -> Text)
-> View env
checkedView
            (Text -> Spec ()
lit Text
"io" Spec () -> Spec (Int, Format) -> Spec (Int, Format)
forall a b. Spec a -> Spec b -> Spec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((,) (Int -> Format -> (Int, Format))
-> Spec Int -> Spec (Format -> (Int, Format))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Spec Int
arg Text
"addr" Spec (Format -> (Int, Format)) -> Spec Format -> Spec (Int, Format)
forall a b. Spec (a -> b) -> Spec a -> Spec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Format] -> Format -> Spec Format
format [Format
Dec, Format
Hex, Format
Sym] Format
Dec))
            Text
"IO port at `<addr>`: `input >>> output` so far; `sym` shows characters."
            (\CheckEnv
env (Int
addr, Format
_) -> CheckEnv -> Int -> Either Text ()
checkPort CheckEnv
env Int
addr)
            (\ReportEnv st
e (Int
addr, Format
fmt) -> Format -> Int -> st -> Text
forall st.
(Inspectable st, IsWord (WordOf st)) =>
Format -> Int -> st -> Text
viewIO Format
fmt Int
addr (ReportEnv st -> st
forall {c}. ReportEnv c -> c
current ReportEnv st
e))
        , Text -> Text -> (ReportEnv st -> Text) -> View (ReportEnv st)
forall env. Text -> Text -> (env -> Text) -> View env
flagView Text
"isa-specific" Text
"The ISA's run-wide stats, one `name: value` per line; empty if it has none." ((ReportEnv st -> Text) -> View (ReportEnv st))
-> (ReportEnv st -> Text) -> View (ReportEnv st)
forall a b. (a -> b) -> a -> b
$
            StateEnv st -> Text
isaSpecific (StateEnv st -> Text)
-> (ReportEnv st -> StateEnv st) -> ReportEnv st -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> StateEnv st
forall st. ReportEnv st -> StateEnv st
reState
        ]
    where
        current :: ReportEnv c -> c
current = StateEnv c -> c
forall st. StateEnv st -> st
seState (StateEnv c -> c)
-> (ReportEnv c -> StateEnv c) -> ReportEnv c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv c -> StateEnv c
forall st. ReportEnv st -> StateEnv st
reState
        final :: ReportEnv c -> c
final = StateEnv c -> c
forall st. StateEnv st -> st
seFinal (StateEnv c -> c)
-> (ReportEnv c -> StateEnv c) -> ReportEnv c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv c -> StateEnv c
forall st. ReportEnv st -> StateEnv st
reState
        finalLog :: ReportEnv st -> AccessLog
finalLog = MemOf st -> AccessLog
forall m isa w. Memory m isa w => m -> AccessLog
accessLog (MemOf st -> AccessLog)
-> (ReportEnv st -> MemOf st) -> ReportEnv st -> AccessLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> MemOf st
forall st. Inspectable st => st -> MemOf st
memoryDump (st -> MemOf st)
-> (ReportEnv st -> st) -> ReportEnv st -> MemOf st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> st
forall {c}. ReportEnv c -> c
final
        runTotal :: ReportEnv st -> AccessCount
runTotal = MemOf st -> AccessCount
forall m isa w. Memory m isa w => m -> AccessCount
memAccessCount (MemOf st -> AccessCount)
-> (ReportEnv st -> MemOf st) -> ReportEnv st -> AccessCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> MemOf st
forall st. Inspectable st => st -> MemOf st
memoryDump (st -> MemOf st)
-> (ReportEnv st -> st) -> ReportEnv st -> MemOf st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportEnv st -> st
forall {c}. ReportEnv c -> c
current
        ranges :: Text -> Text -> (t -> Intervals) -> View t
ranges Text
name Text
doc t -> Intervals
f = Spec Format -> Text -> (t -> Format -> Text) -> View t
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
Hex) Text
doc ((t -> Format -> Text) -> View t)
-> (t -> Format -> Text) -> View t
forall a b. (a -> b) -> a -> b
$ \t
e Format
fmt ->
            (if Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Hex then Intervals -> Text
renderIntervalsHex else Intervals -> Text
renderIntervals) (t -> Intervals
f t
e)
        pcLabel :: ReportEnv st -> Text
pcLabel ReportEnv{reState :: forall st. ReportEnv st -> StateEnv st
reState = StateEnv{HashMap Text (WordOf st)
seLabels :: HashMap Text (WordOf st)
seLabels :: forall st. StateEnv st -> HashMap Text (WordOf st)
seLabels, st
seState :: forall st. StateEnv st -> st
seState :: st
seState}} =
            case [Text
l | (Text
l, WordOf st
a) <- HashMap Text (WordOf st) -> [(Text, WordOf st)]
forall t a b. (IsList t, Item t ~ (a, b)) => t -> [(a, b)]
toPairs HashMap Text (WordOf st)
seLabels, WordOf st
a WordOf st -> WordOf st -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> WordOf st
forall a. Enum a => Int -> a
toEnum (st -> Int
forall st. Inspectable st => st -> Int
programCounter st
seState)] of
                Text
l : [Text]
_ -> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l
                [] -> Text
""
        nextInstruction :: st -> a
nextInstruction st
st
            | st -> Bool
forall st. Inspectable st => st -> Bool
isHalted st
st = a
"-"
            | Bool
otherwise = (Text -> a)
-> ((MemOf st, b) -> a) -> Either Text (MemOf st, b) -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (a -> Text -> a
forall a b. a -> b -> a
const a
"-") (b -> a
forall b a. (Show a, IsString b) => a -> b
show (b -> a) -> ((MemOf st, b) -> b) -> (MemOf st, b) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MemOf st, b) -> b
forall a b. (a, b) -> b
snd) (MemOf st -> Int -> Either Text (MemOf st, b)
forall m isa w. Memory m isa w => m -> Int -> Either Text (m, isa)
readInstruction (st -> MemOf st
forall st. Inspectable st => st -> MemOf st
memoryDump st
st) (st -> Int
forall st. Inspectable st => st -> Int
programCounter st
st))
        isaSpecific :: StateEnv st -> Text
isaSpecific StateEnv st
env =
            let width :: Int
width = (Stat (StateEnv st) -> Int -> Int)
-> Int -> [Stat (StateEnv st)] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int)
-> (Stat (StateEnv st) -> Int) -> Stat (StateEnv st) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int)
-> (Stat (StateEnv st) -> Text) -> Stat (StateEnv st) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stat (StateEnv st) -> Text
forall env. Stat env -> Text
statName) Int
0 (forall st. Inspectable st => [Stat (StateEnv st)]
isaStats @st) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
             in Text -> [Text] -> Text
T.intercalate
                    Text
"\n"
                    [Int -> Char -> Text -> Text
T.justifyLeft Int
width Char
' ' (Text
statName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StateEnv st -> Text
statRender StateEnv st
env | Stat{Text
statName :: forall env. Stat env -> Text
statName :: Text
statName, StateEnv st -> Text
statRender :: StateEnv st -> Text
statRender :: forall env. Stat env -> env -> Text
statRender} <- forall st. Inspectable st => [Stat (StateEnv st)]
isaStats @st]
        checkRange :: CheckEnv -> (Int, Int) -> Either a ()
checkRange CheckEnv{Int
ceMemorySize :: Int
ceMemorySize :: CheckEnv -> Int
ceMemorySize} (Int
from, Int
to)
            | Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
to Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ceMemorySize =
                a -> Either a ()
forall a b. a -> Either a b
Left (a -> Either a ()) -> a -> Either a ()
forall a b. (a -> b) -> a -> b
$ a
"range " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> a
forall b a. (Show a, IsString b) => a -> b
show Int
from a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".." a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> a
forall b a. (Show a, IsString b) => a -> b
show Int
to a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" is outside memory 0.." a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> a
forall b a. (Show a, IsString b) => a -> b
show (Int
ceMemorySize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            | Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
to = a -> Either a ()
forall a b. a -> Either a b
Left (a -> Either a ()) -> a -> Either a ()
forall a b. (a -> b) -> a -> b
$ a
"range " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> a
forall b a. (Show a, IsString b) => a -> b
show Int
from a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
".." a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> a
forall b a. (Show a, IsString b) => a -> b
show Int
to a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" is empty: <from> is after <to>"
            | Bool
otherwise = () -> Either a ()
forall a b. b -> Either a b
Right ()
        checkPort :: CheckEnv -> Int -> Either Text ()
checkPort CheckEnv{[Int]
ceIoPorts :: [Int]
ceIoPorts :: CheckEnv -> [Int]
ceIoPorts} Int
addr
            | Int
addr Int -> [Int] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Int]
ceIoPorts = () -> Either Text ()
forall a b. b -> Either a b
Right ()
            | Bool
otherwise =
                Text -> Either Text ()
forall a b. a -> Either a b
Left (Text -> Either Text ()) -> Text -> Either Text ()
forall a b. (a -> b) -> a -> b
$
                    Text
"no IO port at "
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall {a}. Integral a => a -> Text
hex Int
addr
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case [Int]
ceIoPorts of
                            [] -> Text
", memory_mapped_io is empty"
                            [Int]
ports -> Text
", configured: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall {a}. Integral a => a -> Text
hex ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
ports))
        hex :: a -> Text
hex a
a = Text
"0x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText (a -> ShowS
forall a. Integral a => a -> ShowS
showHex a
a String
"")

-- | A register-like value: @dec@ by default, or @hex@.
valueView :: (Integral a, Show a) => Text -> Text -> (env -> a) -> View env
valueView :: forall a env.
(Integral a, Show a) =>
Text -> Text -> (env -> a) -> View env
valueView Text
name Text
doc env -> a
f = Spec Format -> Text -> (env -> Format -> Text) -> View env
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 ((env -> Format -> Text) -> View env)
-> (env -> Format -> Text) -> View env
forall a b. (a -> b) -> a -> b
$ \env
e Format
fmt -> Format -> a -> Text
forall a. (Integral a, Show a) => Format -> a -> Text
showValue Format
fmt (env -> a
f env
e)

-- | A view without arguments or format.
flagView :: Text -> Text -> (env -> Text) -> View env
flagView :: forall env. Text -> Text -> (env -> Text) -> View env
flagView Text
name Text
doc env -> Text
f = Spec () -> Text -> (env -> () -> Text) -> View env
forall a env. Spec a -> Text -> (env -> a -> Text) -> View env
mkView (Text -> Spec ()
lit Text
name) Text
doc (\env
e () -> env -> Text
f env
e)

showValue :: (Integral a, Show a) => Format -> a -> Text
showValue :: forall a. (Integral a, Show a) => Format -> a -> Text
showValue Format
Hex = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall {a}. Integral a => a -> String
word32ToHex
showValue Format
_ = a -> Text
forall b a. (Show a, IsString b) => a -> b
show

-- | Values joined top first, @a:b:c@, as stacks are shown.
showValues :: (Integral a, Show a) => Format -> [a] -> Text
showValues :: forall a. (Integral a, Show a) => Format -> [a] -> Text
showValues Format
fmt = Text -> [Text] -> Text
T.intercalate Text
":" ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Format -> a -> Text
forall a. (Integral a, Show a) => Format -> a -> Text
showValue Format
fmt)

-- | A report with its view template compiled against the ISA's views.
data Report st = Report
    { forall st. Report st -> ReportConf
rConf :: ReportConf
    , forall st. Report st -> Maybe (Template (ReportEnv st))
rTemplate :: Maybe (Template (ReportEnv st))
    }

-- | Compile every report before the simulation runs, so a mistake fails
-- the same way in every ISA, naming the report and the key, and rendering
-- never meets a key it cannot resolve.
compileReports :: forall st. (ReportViews st) => CheckEnv -> [ReportConf] -> Either Text ([Text], [Report st])
compileReports :: forall st.
ReportViews st =>
CheckEnv -> [ReportConf] -> Either Text ([Text], [Report st])
compileReports CheckEnv
checkEnv [ReportConf]
confs =
    case [Either [Text] ([Text], Report st)]
-> ([[Text]], [([Text], Report st)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((Int -> ReportConf -> Either [Text] ([Text], Report st))
-> [Int] -> [ReportConf] -> [Either [Text] ([Text], Report st)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ReportConf -> Either [Text] ([Text], Report st)
compile [Int
1 :: Int ..] [ReportConf]
confs) of
        ([], [([Text], Report st)]
compiled) -> ([Text], [Report st]) -> Either Text ([Text], [Report st])
forall a b. b -> Either a b
Right ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub ((([Text], Report st) -> [Text]) -> [([Text], Report st)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Text], Report st) -> [Text]
forall a b. (a, b) -> a
fst [([Text], Report st)]
compiled), (([Text], Report st) -> Report st)
-> [([Text], Report st)] -> [Report st]
forall a b. (a -> b) -> [a] -> [b]
map ([Text], Report st) -> Report st
forall a b. (a, b) -> b
snd [([Text], Report st)]
compiled)
        ([[Text]]
errs, [([Text], Report st)]
_) -> Text -> Either Text ([Text], [Report st])
forall a b. a -> Either a b
Left (Text -> Either Text ([Text], [Report st]))
-> Text -> Either Text ([Text], [Report st])
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub ([[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text]]
errs))
    where
        compile :: Int -> ReportConf -> Either [Text] ([Text], Report st)
compile Int
i rc :: ReportConf
rc@ReportConf{Maybe Text
rcName :: ReportConf -> Maybe Text
rcName :: Maybe Text
rcName, Maybe Text
rcView :: ReportConf -> Maybe Text
rcView :: Maybe Text
rcView} =
            let named :: [Text] -> [Text]
named = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"report " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
i) Text -> Text
forall b a. (Show a, IsString b) => a -> b
show Maybe Text
rcName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
             in case Maybe Text
rcView of
                    Maybe Text
Nothing -> ([Text], Report st) -> Either [Text] ([Text], Report st)
forall a b. b -> Either a b
Right ([], ReportConf -> Maybe (Template (ReportEnv st)) -> Report st
forall st.
ReportConf -> Maybe (Template (ReportEnv st)) -> Report st
Report ReportConf
rc Maybe (Template (ReportEnv st))
forall a. Maybe a
Nothing)
                    Just Text
text ->
                        ([Text] -> [Text])
-> (([Text], Template (ReportEnv st)) -> ([Text], Report st))
-> Either [Text] ([Text], Template (ReportEnv st))
-> Either [Text] ([Text], Report st)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Text] -> [Text]
named (([Text] -> [Text])
-> (Template (ReportEnv st) -> Report st)
-> ([Text], Template (ReportEnv st))
-> ([Text], Report st)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Text] -> [Text]
named (ReportConf -> Maybe (Template (ReportEnv st)) -> Report st
forall st.
ReportConf -> Maybe (Template (ReportEnv st)) -> Report st
Report ReportConf
rc (Maybe (Template (ReportEnv st)) -> Report st)
-> (Template (ReportEnv st) -> Maybe (Template (ReportEnv st)))
-> Template (ReportEnv st)
-> Report st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template (ReportEnv st) -> Maybe (Template (ReportEnv st))
forall a. a -> Maybe a
Just)) (Either [Text] ([Text], Template (ReportEnv st))
 -> Either [Text] ([Text], Report st))
-> Either [Text] ([Text], Template (ReportEnv st))
-> Either [Text] ([Text], Report st)
forall a b. (a -> b) -> a -> b
$
                            CheckEnv
-> [View (ReportEnv st)]
-> Text
-> Either [Text] ([Text], Template (ReportEnv st))
forall env.
CheckEnv
-> [View env] -> Text -> Either [Text] ([Text], Template env)
compileTemplate CheckEnv
checkEnv (forall st. ReportViews st => [View (ReportEnv st)]
reportViews @st) Text
text

-- | Render one of the ISA's own views of a state.
renderIsaView :: forall st. (Inspectable st) => HashMap Text (WordOf st) -> st -> Text -> Either Text Text
renderIsaView :: forall st.
Inspectable st =>
HashMap Text (WordOf st) -> st -> Text -> Either Text Text
renderIsaView HashMap Text (WordOf st)
labels st
st Text
key = do
    (_, template) <- ([Text] -> Text)
-> Either [Text] ([Text], Template (StateEnv st))
-> Either Text ([Text], Template (StateEnv st))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> [Text] -> Text
T.intercalate Text
"\n") (Either [Text] ([Text], Template (StateEnv st))
 -> Either Text ([Text], Template (StateEnv st)))
-> Either [Text] ([Text], Template (StateEnv st))
-> Either Text ([Text], Template (StateEnv st))
forall a b. (a -> b) -> a -> b
$ CheckEnv
-> [View (StateEnv st)]
-> Text
-> Either [Text] ([Text], Template (StateEnv st))
forall env.
CheckEnv
-> [View env] -> Text -> Either [Text] ([Text], Template env)
compileTemplate CheckEnv
unchecked (forall st. Inspectable st => [View (StateEnv st)]
isaViews @st) (Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}")
    return $ renderTemplate template StateEnv{seLabels = labels, seState = st, seFinal = st}
    where
        unchecked :: CheckEnv
unchecked = CheckEnv{ceMemorySize :: Int
ceMemorySize = Int
forall a. Bounded a => a
maxBound, ceIoPorts :: [Int]
ceIoPorts = []}

prepareReport ::
    forall st mem.
    (ReportViews st) =>
    TranslatorResult mem (WordOf st)
    -> Bool
    -> st
    -> [Trace st (IsaOf st)]
    -> Report st
    -> (Bool, Text)
prepareReport :: forall st mem.
ReportViews st =>
TranslatorResult mem (WordOf st)
-> Bool -> st -> [Trace st (IsaOf st)] -> Report st -> (Bool, Text)
prepareReport
    TranslatorResult{HashMap Text (WordOf st)
labels :: HashMap Text (WordOf st)
labels :: forall mem w. TranslatorResult mem w -> HashMap Text w
labels, DumpStats
dumpStats :: DumpStats
dumpStats :: forall mem w. TranslatorResult mem w -> DumpStats
dumpStats}
    Bool
verbose
    st
finalState
    [Trace st (IsaOf st)]
records
    Report{rConf :: forall st. Report st -> ReportConf
rConf = rc :: ReportConf
rc@ReportConf{Maybe Text
rcName :: ReportConf -> Maybe Text
rcName :: Maybe Text
rcName, ReportSlice
rcSlice :: ReportConf -> ReportSlice
rcSlice :: ReportSlice
rcSlice, Maybe Text
rcAssert :: ReportConf -> Maybe Text
rcAssert :: Maybe Text
rcAssert}, Maybe (Template (ReportEnv st))
rTemplate :: forall st. Report st -> Maybe (Template (ReportEnv st))
rTemplate :: Maybe (Template (ReportEnv st))
rTemplate} =
        let header :: Text
header = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
"# " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
rcName
            details :: Text
details = if Bool
verbose then ReportConf -> Text
forall b a. (Show a, IsString b) => a -> b
show ReportConf
rc else Text
""
            deltas :: [(AccessCount, Trace st (IsaOf st))]
deltas = [Trace st (IsaOf st)] -> [(AccessCount, Trace st (IsaOf st))]
forall st.
(Inspectable st, Memory (MemOf st) (IsaOf st) (WordOf st)) =>
[Trace st (IsaOf st)] -> [(AccessCount, Trace st (IsaOf st))]
withAccessDeltas [Trace st (IsaOf st)]
records
            sliced :: [(AccessCount, Trace st (IsaOf st))]
sliced = ReportSlice
-> [(AccessCount, Trace st (IsaOf st))]
-> [(AccessCount, Trace st (IsaOf st))]
forall {a}. ReportSlice -> [a] -> [a]
selectSlice ReportSlice
rcSlice [(AccessCount, Trace st (IsaOf st))]
deltas
            profile :: Text
profile = HashMap Text (WordOf st)
-> st -> [(AccessCount, Trace st (IsaOf st))] -> Text
forall st.
ReportViews st =>
HashMap Text (WordOf st)
-> st -> [(AccessCount, Trace st (IsaOf st))] -> Text
renderProfile HashMap Text (WordOf st)
labels st
finalState [(AccessCount, Trace st (IsaOf st))]
deltas
            stateViews :: Text
stateViews = case Maybe (Template (ReportEnv st))
rTemplate of
                Maybe (Template (ReportEnv st))
Nothing -> Text
""
                Just Template (ReportEnv st)
template ->
                    [Text] -> Text
T.concat
                        ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
                        ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((AccessCount, Trace st (IsaOf st)) -> Text)
-> [(AccessCount, Trace st (IsaOf st))] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map
                            ( \(AccessCount
accesses, Trace st (IsaOf st)
record) -> case Trace st (IsaOf st)
record of
                                TState{Int
tInstructionCount :: Int
tInstructionCount :: forall st isa. Trace st isa -> Int
tInstructionCount, Maybe (IsaOf st)
tPrevInstruction :: Maybe (IsaOf st)
tPrevInstruction :: forall st isa. Trace st isa -> Maybe isa
tPrevInstruction, st
tState :: st
tState :: forall st isa. Trace st isa -> st
tState} ->
                                    Template (ReportEnv st) -> ReportEnv st -> Text
forall env. Template env -> env -> Text
renderTemplate
                                        Template (ReportEnv st)
template
                                        ReportEnv
                                            { reState :: StateEnv st
reState = StateEnv{seLabels :: HashMap Text (WordOf st)
seLabels = HashMap Text (WordOf st)
labels, seState :: st
seState = st
tState, seFinal :: st
seFinal = st
finalState}
                                            , reDumpStats :: DumpStats
reDumpStats = DumpStats
dumpStats
                                            , reInstrCount :: Int
reInstrCount = Int
tInstructionCount
                                            , rePrevInstr :: Maybe (IsaOf st)
rePrevInstr = Maybe (IsaOf st)
tPrevInstruction
                                            , reAccesses :: AccessCount
reAccesses = AccessCount
accesses
                                            , reProfile :: Text
reProfile = Text
profile
                                            }
                                (TError Text
err) -> Text
"ERROR: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                                (TWarn Text
warn) -> Text
"WARN: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
warn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                            )
                            [(AccessCount, Trace st (IsaOf st))]
sliced

            assertReport :: Text
assertReport =
                let actual :: Text
actual = Text -> Text
nospaces Text
stateViews
                    expect :: Text
expect = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
nospaces Maybe Text
rcAssert
                 in if Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
rcAssert Bool -> Bool -> Bool
|| Text
actual Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expect
                        then Text
""
                        else Text
"ASSERTION FAIL, expect:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expect
         in ( Text -> Bool
T.null Text
assertReport
            , [Text] -> Text
T.unlines
                ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip
                ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text
header, Text
details, Text
stateViews, Text
assertReport]
            )
        where
            nospaces :: Text -> Text
nospaces = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip

-----------------------------------------------------------

-- | Specifies which part of the report to select.
data ReportSlice
    = -- | Select the first 'n' records.
      HeadSlice Int
    | -- | Select all records.
      AllSlice
    | -- | Select the last 'n' records.
      TailSlice Int
    | -- | Select only the last record.
      LastSlice
    deriving (Int -> ReportSlice -> ShowS
[ReportSlice] -> ShowS
ReportSlice -> String
(Int -> ReportSlice -> ShowS)
-> (ReportSlice -> String)
-> ([ReportSlice] -> ShowS)
-> Show ReportSlice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportSlice -> ShowS
showsPrec :: Int -> ReportSlice -> ShowS
$cshow :: ReportSlice -> String
show :: ReportSlice -> String
$cshowList :: [ReportSlice] -> ShowS
showList :: [ReportSlice] -> ShowS
Show)

instance FromJSON ReportSlice where
    parseJSON :: Value -> Parser ReportSlice
parseJSON (Array Array
xs) | [String Text
"head", Number Scientific
n] <- Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
xs = ReportSlice -> Parser ReportSlice
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReportSlice -> Parser ReportSlice)
-> ReportSlice -> Parser ReportSlice
forall a b. (a -> b) -> a -> b
$ Int -> ReportSlice
HeadSlice (Int -> ReportSlice) -> Int -> ReportSlice
forall a b. (a -> b) -> a -> b
$ Scientific -> Int
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n
    parseJSON (String Text
"all") = ReportSlice -> Parser ReportSlice
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ReportSlice
AllSlice
    parseJSON (Array Array
xs) | [String Text
"tail", Number Scientific
n] <- Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
xs = ReportSlice -> Parser ReportSlice
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReportSlice -> Parser ReportSlice)
-> ReportSlice -> Parser ReportSlice
forall a b. (a -> b) -> a -> b
$ Int -> ReportSlice
TailSlice (Int -> ReportSlice) -> Int -> ReportSlice
forall a b. (a -> b) -> a -> b
$ Scientific -> Int
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n
    parseJSON (String Text
"last") = ReportSlice -> Parser ReportSlice
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ReportSlice
LastSlice
    parseJSON Value
_ = String -> Parser ReportSlice
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid slice format, expect: [\"head\", n], \"all\", [\"tail\", n], \"last\""

-- | Pair each state record with the accesses the instruction that produced
-- it made. One record per step, so consecutive totals differ by one
-- instruction's worth. Before slicing, so a slice still gets real deltas.
withAccessDeltas ::
    forall st.
    (Inspectable st, Memory (MemOf st) (IsaOf st) (WordOf st)) =>
    [Trace st (IsaOf st)]
    -> [(AccessCount, Trace st (IsaOf st))]
withAccessDeltas :: forall st.
(Inspectable st, Memory (MemOf st) (IsaOf st) (WordOf st)) =>
[Trace st (IsaOf st)] -> [(AccessCount, Trace st (IsaOf st))]
withAccessDeltas = AccessCount
-> [Trace st (IsaOf st)] -> [(AccessCount, Trace st (IsaOf st))]
forall {st} {isa} {w} {isa}.
(Memory (MemOf st) isa w, Inspectable st) =>
AccessCount -> [Trace st isa] -> [(AccessCount, Trace st isa)]
go AccessCount
emptyAccessCount
    where
        go :: AccessCount -> [Trace st isa] -> [(AccessCount, Trace st isa)]
go AccessCount
_ [] = []
        go AccessCount
before (Trace st isa
record : [Trace st isa]
rest) = case Trace st isa
record of
            TState{st
tState :: forall st isa. Trace st isa -> st
tState :: st
tState} ->
                let after :: AccessCount
after = MemOf st -> AccessCount
forall m isa w. Memory m isa w => m -> AccessCount
memAccessCount (st -> MemOf st
forall st. Inspectable st => st -> MemOf st
memoryDump st
tState)
                 in (AccessCount -> AccessCount -> AccessCount
acSince AccessCount
before AccessCount
after, Trace st isa
record) (AccessCount, Trace st isa)
-> [(AccessCount, Trace st isa)] -> [(AccessCount, Trace st isa)]
forall a. a -> [a] -> [a]
: AccessCount -> [Trace st isa] -> [(AccessCount, Trace st isa)]
go AccessCount
after [Trace st isa]
rest
            Trace st isa
_ -> (AccessCount
emptyAccessCount, Trace st isa
record) (AccessCount, Trace st isa)
-> [(AccessCount, Trace st isa)] -> [(AccessCount, Trace st isa)]
forall a. a -> [a] -> [a]
: AccessCount -> [Trace st isa] -> [(AccessCount, Trace st isa)]
go AccessCount
before [Trace st isa]
rest

data ProfileEntry = ProfileEntry
    { ProfileEntry -> Text
peInstruction :: Text
    , ProfileEntry -> Map (Int, Int) Int
peRuns :: Map (Int, Int) Int
    }

buildProfile ::
    (Inspectable st, Show (IsaOf st)) =>
    [(AccessCount, Trace st (IsaOf st))]
    -> IntMap ProfileEntry
buildProfile :: forall st.
(Inspectable st, Show (IsaOf st)) =>
[(AccessCount, Trace st (IsaOf st))] -> IntMap ProfileEntry
buildProfile = Maybe Int
-> IntMap ProfileEntry
-> [(AccessCount, Trace st (IsaOf st))]
-> IntMap ProfileEntry
forall {a} {st}.
(Show a, Inspectable st) =>
Maybe Int
-> IntMap ProfileEntry
-> [(AccessCount, Trace st a)]
-> IntMap ProfileEntry
go Maybe Int
forall a. Maybe a
Nothing IntMap ProfileEntry
forall a. IntMap a
IM.empty
    where
        go :: Maybe Int
-> IntMap ProfileEntry
-> [(AccessCount, Trace st a)]
-> IntMap ProfileEntry
go Maybe Int
_ IntMap ProfileEntry
acc [] = IntMap ProfileEntry
acc
        go Maybe Int
prevPc IntMap ProfileEntry
acc ((AccessCount{Int
acReads :: AccessCount -> Int
acReads :: Int
acReads, Int
acWrites :: AccessCount -> Int
acWrites :: Int
acWrites}, Trace st a
record) : [(AccessCount, Trace st a)]
rest) = case Trace st a
record of
            TState{Maybe a
tPrevInstruction :: forall st isa. Trace st isa -> Maybe isa
tPrevInstruction :: Maybe a
tPrevInstruction, st
tState :: forall st isa. Trace st isa -> st
tState :: st
tState} ->
                let acc' :: IntMap ProfileEntry
acc' = case (Maybe Int
prevPc, Maybe a
tPrevInstruction) of
                        (Just Int
pc, Just a
instr) ->
                            (ProfileEntry -> ProfileEntry -> ProfileEntry)
-> Int
-> ProfileEntry
-> IntMap ProfileEntry
-> IntMap ProfileEntry
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith ProfileEntry -> ProfileEntry -> ProfileEntry
merge Int
pc (Text -> Map (Int, Int) Int -> ProfileEntry
ProfileEntry (a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
instr) (OneItem (Map (Int, Int) Int) -> Map (Int, Int) Int
forall x. One x => OneItem x -> x
one ((Int
acReads, Int
acWrites), Int
1))) IntMap ProfileEntry
acc
                        (Maybe Int, Maybe a)
_ -> IntMap ProfileEntry
acc
                 in Maybe Int
-> IntMap ProfileEntry
-> [(AccessCount, Trace st a)]
-> IntMap ProfileEntry
go (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ st -> Int
forall st. Inspectable st => st -> Int
programCounter st
tState) IntMap ProfileEntry
acc' [(AccessCount, Trace st a)]
rest
            Trace st a
_ -> Maybe Int
-> IntMap ProfileEntry
-> [(AccessCount, Trace st a)]
-> IntMap ProfileEntry
go Maybe Int
prevPc IntMap ProfileEntry
acc [(AccessCount, Trace st a)]
rest
        merge :: ProfileEntry -> ProfileEntry -> ProfileEntry
merge ProfileEntry
new ProfileEntry
old = ProfileEntry
old{peRuns = M.unionWith (+) (peRuns old) (peRuns new)}

renderProfile ::
    (ReportViews st) =>
    HashMap Text (WordOf st)
    -> st
    -> [(AccessCount, Trace st (IsaOf st))]
    -> Text
renderProfile :: forall st.
ReportViews st =>
HashMap Text (WordOf st)
-> st -> [(AccessCount, Trace st (IsaOf st))] -> Text
renderProfile HashMap Text (WordOf st)
labels st
finalState [(AccessCount, Trace st (IsaOf st))]
deltas =
    let width :: Int
width = Int -> Int
hexAddrWidth (MemOf st -> Int
forall m isa w. Memory m isa w => m -> Int
memCapacity (st -> MemOf st
forall st. Inspectable st => st -> MemOf st
memoryDump st
finalState))
        labelsAt :: Int -> [Text]
labelsAt Int
pc = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text
l | (Text
l, WordOf st
a) <- HashMap Text (WordOf st) -> [(Text, WordOf st)]
forall t a b. (IsList t, Item t ~ (a, b)) => t -> [(a, b)]
toPairs HashMap Text (WordOf st)
labels, WordOf st
a WordOf st -> WordOf st -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> WordOf st
forall a. Enum a => Int -> a
toEnum Int
pc]
        headerRow :: (Text, Text, Text, Text, Text)
headerRow = (Text
"Address", Text
"Exec", Text
"Read", Text
"Write", Text
"Instruction")
        ditto :: (Text, Text)
ditto = (Text
"\"", Text
"\"")
        rows :: [(Text, Text, Text, Text, Text)]
rows =
            [ (Text
addr, Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
n, Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
r, Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
w, Text
instr)
            | (Int
pc, ProfileEntry{Text
peInstruction :: ProfileEntry -> Text
peInstruction :: Text
peInstruction, Map (Int, Int) Int
peRuns :: ProfileEntry -> Map (Int, Int) Int
peRuns :: Map (Int, Int) Int
peRuns}) <- IntMap ProfileEntry -> [(Int, ProfileEntry)]
forall a. IntMap a -> [(Int, a)]
IM.toAscList ([(AccessCount, Trace st (IsaOf st))] -> IntMap ProfileEntry
forall st.
(Inspectable st, Show (IsaOf st)) =>
[(AccessCount, Trace st (IsaOf st))] -> IntMap ProfileEntry
buildProfile [(AccessCount, Trace st (IsaOf st))]
deltas)
            , let named :: (Text, Text)
named = (Int -> Int -> Text
hexAddr Int
width Int
pc, [Text] -> Text
T.unwords (Text
peInstruction 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
<>) (Int -> [Text]
labelsAt Int
pc)))
            , ((Text
addr, Text
instr), ((Int
r, Int
w), Int
n)) <- [(Text, Text)]
-> [((Int, Int), Int)] -> [((Text, Text), ((Int, Int), Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Text, Text)
named (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: (Text, Text) -> [(Text, Text)]
forall a. a -> [a]
repeat (Text, Text)
ditto) (Map (Int, Int) Int -> [((Int, Int), Int)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map (Int, Int) Int
peRuns)
            ]
        allRows :: [(Text, Text, Text, Text, Text)]
allRows = (Text, Text, Text, Text, Text)
headerRow (Text, Text, Text, Text, Text)
-> [(Text, Text, Text, Text, Text)]
-> [(Text, Text, Text, Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text, Text, Text, Text)]
rows
        colWidth :: ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (Text, Text, Text, Text, Text) -> Text
f = ((Text, Text, Text, Text, Text) -> Int -> Int)
-> Int -> [(Text, Text, Text, Text, Text)] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int)
-> ((Text, Text, Text, Text, Text) -> Int)
-> (Text, Text, Text, Text, Text)
-> Int
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int)
-> ((Text, Text, Text, Text, Text) -> Text)
-> (Text, Text, Text, Text, Text)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text, Text, Text, Text) -> Text
f) Int
0 [(Text, Text, Text, Text, Text)]
allRows
        wAddr :: Int
wAddr = ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (\(Text
a, Text
_, Text
_, Text
_, Text
_) -> Text
a)
        wExec :: Int
wExec = ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (\(Text
_, Text
e, Text
_, Text
_, Text
_) -> Text
e)
        wRead :: Int
wRead = ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (\(Text
_, Text
_, Text
r, Text
_, Text
_) -> Text
r)
        wWrite :: Int
wWrite = ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (\(Text
_, Text
_, Text
_, Text
w, Text
_) -> Text
w)
        padR :: Int -> Text -> Text
padR Int
n Text
s = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) Text
" "
        padL :: Int -> Text -> Text
padL Int
n Text
s = Int -> Text -> Text
T.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
        renderRow :: (Text, Text, Text, Text, Text) -> Text
renderRow (Text
a, Text
e, Text
r, Text
w, Text
i) =
            Text -> [Text] -> Text
T.intercalate Text
"  " [Int -> Text -> Text
padR Int
wAddr Text
a, Int -> Text -> Text
padL Int
wExec Text
e, Int -> Text -> Text
padL Int
wRead Text
r, Int -> Text -> Text
padL Int
wWrite Text
w, Text
i]
     in Text -> [Text] -> Text
T.intercalate Text
"\n" (((Text, Text, Text, Text, Text) -> Text)
-> [(Text, Text, Text, Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text, Text, Text, Text) -> Text
renderRow [(Text, Text, Text, Text, Text)]
allRows)

selectSlice :: ReportSlice -> [a] -> [a]
selectSlice (HeadSlice Int
n) = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n
selectSlice ReportSlice
AllSlice = [a] -> [a]
forall a. a -> a
id
selectSlice (TailSlice Int
n) = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse
selectSlice ReportSlice
LastSlice = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
1 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

-----------------------------------------------------------

-- | Render a full address-space table: one row per declared section, IO
--   cluster, or @x@ (anything else) span. Auto-sized columns, hex addresses
--   widened to fit @memory_size@.
renderMemoryTable ::
    forall m isa w.
    (IsWord w, Memory m isa w) =>
    DumpStats
    -> m
    -> Text
renderMemoryTable :: forall m isa w.
(IsWord w, Memory m isa w) =>
DumpStats -> m -> Text
renderMemoryTable DumpStats
dumpStats m
mem =
    let memSize :: Int
memSize = m -> Int
forall m isa w. Memory m isa w => m -> Int
memCapacity m
mem
        ports :: [Int]
ports = m -> [Int]
forall m isa w. Memory m isa w => m -> [Int]
ioPorts m
mem
        wordSize :: Int
wordSize = forall t. ByteSizeT t => Int
byteSizeT @w
        AccessLog{Intervals
alInstr :: AccessLog -> Intervals
alInstr :: Intervals
alInstr, Intervals
alData :: AccessLog -> Intervals
alData :: Intervals
alData, Intervals
alIo :: AccessLog -> Intervals
alIo :: Intervals
alIo} = m -> AccessLog
forall m isa w. Memory m isa w => m -> AccessLog
accessLog m
mem
        DumpStats{Intervals
dsTextIntervals :: DumpStats -> Intervals
dsTextIntervals :: Intervals
dsTextIntervals, Intervals
dsDataIntervals :: DumpStats -> Intervals
dsDataIntervals :: Intervals
dsDataIntervals} = DumpStats
dumpStats
        ioIntervals :: Intervals
ioIntervals = (Int -> Intervals -> Intervals) -> Intervals -> [Int] -> Intervals
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Intervals -> Intervals
`recordRange` Int
wordSize) Intervals
emptyIntervals [Int]
ports
        accessedAll :: Intervals
accessedAll = Intervals
alInstr Intervals -> Intervals -> Intervals
`intervalsUnion` Intervals
alData Intervals -> Intervals -> Intervals
`intervalsUnion` Intervals
alIo

        -- Declared section rows: one per text/data/io cluster (in-section
        -- coverage is shown via multi-cluster Accessed in the row).
        textRows :: [(Text, Int, Int)]
textRows = [(Text
"text", Int
lo, Int
hi) | (Int
lo, Int
hi) <- Intervals -> [(Int, Int)]
intervalsToList Intervals
dsTextIntervals]
        dataRows :: [(Text, Int, Int)]
dataRows = [(Text
"data", Int
lo, Int
hi) | (Int
lo, Int
hi) <- Intervals -> [(Int, Int)]
intervalsToList Intervals
dsDataIntervals]
        ioRows :: [(Text, Int, Int)]
ioRows = [(Text
"io", Int
lo, Int
hi) | (Int
lo, Int
hi) <- Intervals -> [(Int, Int)]
intervalsToList Intervals
ioIntervals]

        -- Free rows: complement of (text ∪ data ∪ io) within [0, memSize-1],
        -- split further at access boundaries (so the stack gets its own row).
        sectionsAll :: Intervals
sectionsAll = Intervals
dsTextIntervals Intervals -> Intervals -> Intervals
`intervalsUnion` Intervals
dsDataIntervals Intervals -> Intervals -> Intervals
`intervalsUnion` Intervals
ioIntervals
        boundedMem :: Intervals
boundedMem = Int -> Int -> Intervals
intervalsRange Int
0 (Int
memSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        freeRegions :: Intervals
freeRegions = Intervals
boundedMem Intervals -> Intervals -> Intervals
`intervalsDifference` Intervals
sectionsAll
        freeRows :: [(Text, Int, Int)]
freeRows = ((Int, Int) -> [(Text, Int, Int)])
-> [(Int, Int)] -> [(Text, Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Int -> Int -> [(Text, Int, Int)])
-> (Int, Int) -> [(Text, Int, Int)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Intervals -> Int -> Int -> [(Text, Int, Int)]
splitByAccess Intervals
accessedAll)) (Intervals -> [(Int, Int)]
intervalsToList Intervals
freeRegions)

        spans :: [(Text, Int, Int)]
spans = ((Text, Int, Int) -> Int)
-> [(Text, Int, Int)] -> [(Text, Int, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(Text
_, Int
lo, Int
_) -> Int
lo) ([(Text, Int, Int)]
textRows [(Text, Int, Int)] -> [(Text, Int, Int)] -> [(Text, Int, Int)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Int, Int)]
dataRows [(Text, Int, Int)] -> [(Text, Int, Int)] -> [(Text, Int, Int)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Int, Int)]
ioRows [(Text, Int, Int)] -> [(Text, Int, Int)] -> [(Text, Int, Int)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Int, Int)]
freeRows)

        hexW :: Int
hexW = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
3 (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
memSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) String
""))
        addrStr :: Int -> Text
addrStr Int
a =
            let h :: String
h = Int -> ShowS
forall a. Integral a => a -> ShowS
showHex Int
a String
""
             in Text
"0x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
hexW Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
h) Char
'0') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
h

        formatRange :: Int -> Int -> Text
formatRange Int
lo Int
hi = Int -> Text
addrStr Int
lo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
addrStr Int
hi

        renderAccessed :: Intervals -> Text
renderAccessed Intervals
intervals = case Intervals -> [(Int, Int)]
intervalsToList Intervals
intervals of
            [] -> Text
"-"
            [(Int, Int)]
pairs -> Text -> [Text] -> Text
T.intercalate Text
", " [Int -> Int -> Text
formatRange Int
lo Int
hi | (Int
lo, Int
hi) <- [(Int, Int)]
pairs]

        buildRow :: (Text, Int, Int) -> (Text, Text, Text, Text, Text)
buildRow (Text
kind, Int
lo, Int
hi) =
            let bytes :: Int
bytes = Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                accessedHere :: Intervals
accessedHere = Intervals
accessedAll Intervals -> Intervals -> Intervals
`intervalsIntersect` Int -> Int -> Intervals
intervalsRange Int
lo Int
hi
                accessedBytes :: Int
accessedBytes = Intervals -> Int
intervalsSize Intervals
accessedHere
                cov :: Int
                cov :: Int
cov = if Int
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then (Int
accessedBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bytes else Int
0
             in ( Text
kind
                , Int -> Int -> Text
formatRange Int
lo Int
hi
                , Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
bytes
                , Intervals -> Text
renderAccessed Intervals
accessedHere
                , Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
cov Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
                )

        headerRow :: (Text, Text, Text, Text, Text)
        headerRow :: (Text, Text, Text, Text, Text)
headerRow = (Text
"Kind", Text
"Range", Text
"Bytes", Text
"Accessed", Text
"Coverage")
        allRows :: [(Text, Text, Text, Text, Text)]
allRows = (Text, Text, Text, Text, Text)
headerRow (Text, Text, Text, Text, Text)
-> [(Text, Text, Text, Text, Text)]
-> [(Text, Text, Text, Text, Text)]
forall a. a -> [a] -> [a]
: ((Text, Int, Int) -> (Text, Text, Text, Text, Text))
-> [(Text, Int, Int)] -> [(Text, Text, Text, Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Int, Int) -> (Text, Text, Text, Text, Text)
buildRow [(Text, Int, Int)]
spans

        colWidth :: ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (Text, Text, Text, Text, Text) -> Text
f = ((Text, Text, Text, Text, Text) -> Int -> Int)
-> Int -> [(Text, Text, Text, Text, Text)] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int)
-> ((Text, Text, Text, Text, Text) -> Int)
-> (Text, Text, Text, Text, Text)
-> Int
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int)
-> ((Text, Text, Text, Text, Text) -> Text)
-> (Text, Text, Text, Text, Text)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text, Text, Text, Text) -> Text
f) Int
0 [(Text, Text, Text, Text, Text)]
allRows
        wKind :: Int
wKind = ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (\(Text
k, Text
_, Text
_, Text
_, Text
_) -> Text
k)
        wRange :: Int
wRange = ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (\(Text
_, Text
r, Text
_, Text
_, Text
_) -> Text
r)
        wBytes :: Int
wBytes = ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (\(Text
_, Text
_, Text
b, Text
_, Text
_) -> Text
b)
        wAcc :: Int
wAcc = ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (\(Text
_, Text
_, Text
_, Text
a, Text
_) -> Text
a)
        wCov :: Int
wCov = ((Text, Text, Text, Text, Text) -> Text) -> Int
colWidth (\(Text
_, Text
_, Text
_, Text
_, Text
c) -> Text
c)

        padR :: Int -> Text -> Text
padR Int
n Text
s = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) Text
" "
        padL :: Int -> Text -> Text
padL Int
n Text
s = Int -> Text -> Text
T.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

        renderRow :: (Text, Text, Text, Text, Text) -> Text
renderRow (Text
k, Text
r, Text
b, Text
a, Text
c) =
            Text -> [Text] -> Text
T.intercalate Text
"  " [Int -> Text -> Text
padR Int
wKind Text
k, Int -> Text -> Text
padR Int
wRange Text
r, Int -> Text -> Text
padL Int
wBytes Text
b, Int -> Text -> Text
padR Int
wAcc Text
a, Int -> Text -> Text
padL Int
wCov Text
c]
     in Text -> [Text] -> Text
T.intercalate Text
"\n" (((Text, Text, Text, Text, Text) -> Text)
-> [(Text, Text, Text, Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text, Text, Text, Text) -> Text
renderRow [(Text, Text, Text, Text, Text)]
allRows)

-- | Split a free range @[lo, hi]@ at access boundaries — each accessed cluster
--   and each unaccessed gap becomes its own @x@ row.
splitByAccess :: Intervals -> Int -> Int -> [(Text, Int, Int)]
splitByAccess :: Intervals -> Int -> Int -> [(Text, Int, Int)]
splitByAccess Intervals
accessedAll Int
lo Int
hi =
    let inRange :: [(Int, Int)]
inRange = Intervals -> [(Int, Int)]
intervalsToList (Intervals
accessedAll Intervals -> Intervals -> Intervals
`intervalsIntersect` Int -> Int -> Intervals
intervalsRange Int
lo Int
hi)
        go :: Int -> [(Int, Int)] -> [(Text, Int, Int)]
go Int
cursor [] = [(Text
"x", Int
cursor, Int
hi) | Int
cursor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hi]
        go Int
cursor ((Int
alo, Int
ahi) : [(Int, Int)]
rest)
            | Int
cursor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
alo = (Text
"x", Int
cursor, Int
alo Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Text, Int, Int) -> [(Text, Int, Int)] -> [(Text, Int, Int)]
forall a. a -> [a] -> [a]
: (Text
"x", Int
alo, Int
ahi) (Text, Int, Int) -> [(Text, Int, Int)] -> [(Text, Int, Int)]
forall a. a -> [a] -> [a]
: Int -> [(Int, Int)] -> [(Text, Int, Int)]
go (Int
ahi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(Int, Int)]
rest
            | Bool
otherwise = (Text
"x", Int
alo, Int
ahi) (Text, Int, Int) -> [(Text, Int, Int)] -> [(Text, Int, Int)]
forall a. a -> [a] -> [a]
: Int -> [(Int, Int)] -> [(Text, Int, Int)]
go (Int
ahi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(Int, Int)]
rest
     in Int -> [(Int, Int)] -> [(Text, Int, Int)]
go Int
lo [(Int, Int)]
inRange

viewMemory :: forall st. (ReportViews st) => st -> Int -> Int -> Text
viewMemory :: forall st. ReportViews st => st -> Int -> Int -> Text
viewMemory st
st Int
from Int
to =
    Text -> Text
forall a. ToText a => a -> Text
toText
        (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Bool
-> (Int -> Text)
-> HashMap Text (WordOf st)
-> IntMap (Cell (IsaOf st) (WordOf st))
-> 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 -> Int -> Text
hexAddr (Int -> Int
hexAddrWidth (MemOf st -> Int
forall m isa w. Memory m isa w => m -> Int
memCapacity MemOf st
mem))) HashMap Text (WordOf st)
forall a. Monoid a => a
mempty
        (IntMap (Cell (IsaOf st) (WordOf st)) -> Text)
-> IntMap (Cell (IsaOf st) (WordOf st)) -> Text
forall a b. (a -> b) -> a -> b
$ [Item (IntMap (Cell (IsaOf st) (WordOf st)))]
-> IntMap (Cell (IsaOf st) (WordOf st))
forall l. IsList l => [Item l] -> l
fromList
        ([Item (IntMap (Cell (IsaOf st) (WordOf st)))]
 -> IntMap (Cell (IsaOf st) (WordOf st)))
-> [Item (IntMap (Cell (IsaOf st) (WordOf st)))]
-> IntMap (Cell (IsaOf st) (WordOf st))
forall a b. (a -> b) -> a -> b
$ [Int]
-> IntMap (Cell (IsaOf st) (WordOf st))
-> [(Int, Cell (IsaOf st) (WordOf st))]
forall isa w. [Int] -> IntMap (Cell isa w) -> [(Int, Cell isa w)]
sliceMem [Int
from .. Int
to] (MemOf st -> IntMap (Cell (IsaOf st) (WordOf st))
forall m isa w. Memory m isa w => m -> IntMap (Cell isa w)
dumpCells MemOf st
mem)
    where
        mem :: MemOf st
mem = st -> MemOf st
forall st. Inspectable st => st -> MemOf st
memoryDump st
st

-- | The port was checked against the configuration when the template was
-- compiled, and ports come only from there.
viewIO :: (Inspectable st, IsWord (WordOf st)) => Format -> Int -> st -> Text
viewIO :: forall st.
(Inspectable st, IsWord (WordOf st)) =>
Format -> Int -> st -> Text
viewIO Format
fmt Int
addr st
st = Text
-> (([WordOf st], [WordOf st]) -> Text)
-> Maybe ([WordOf st], [WordOf st])
-> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"-" ([WordOf st], [WordOf st]) -> Text
render (st -> IntMap ([WordOf st], [WordOf st])
forall st.
Inspectable st =>
st -> IntMap ([WordOf st], [WordOf st])
ioStreams st
st IntMap ([WordOf st], [WordOf st])
-> Key (IntMap ([WordOf st], [WordOf st]))
-> Maybe (Val (IntMap ([WordOf st], [WordOf st])))
forall t. StaticMap t => t -> Key t -> Maybe (Val t)
!? Int
Key (IntMap ([WordOf st], [WordOf st]))
addr)
    where
        render :: ([WordOf st], [WordOf st]) -> Text
render ([WordOf st]
is, [WordOf st]
os) = case Format
fmt of
            Format
Hex -> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> Text
forall b a. (Show a, IsString b) => a -> b
show ((WordOf st -> String) -> [WordOf st] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map WordOf st -> String
forall {a}. Integral a => a -> String
word32ToHex [WordOf st]
is) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" >>> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [String] -> Text
forall b a. (Show a, IsString b) => a -> b
show ((WordOf st -> String) -> [WordOf st] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map WordOf st -> String
forall {a}. Integral a => a -> String
word32ToHex ([WordOf st] -> [WordOf st]
forall a. [a] -> [a]
reverse [WordOf st]
os))
            Format
Sym -> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\\NUL" Text
"\\0" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall b a. (Show a, IsString b) => a -> b
show ((WordOf st -> Char) -> [WordOf st] -> String
forall a b. (a -> b) -> [a] -> [b]
map WordOf st -> Char
forall {a}. Enum a => a -> Char
sym [WordOf st]
is) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" >>> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall b a. (Show a, IsString b) => a -> b
show ((WordOf st -> Char) -> [WordOf st] -> String
forall a b. (a -> b) -> [a] -> [b]
map WordOf st -> Char
forall {a}. Enum a => a -> Char
sym ([WordOf st] -> [WordOf st]
forall a. [a] -> [a]
reverse [WordOf st]
os))
            Format
_ -> [WordOf st] -> Text
forall b a. (Show a, IsString b) => a -> b
show [WordOf st]
is Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" >>> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [WordOf st] -> Text
forall b a. (Show a, IsString b) => a -> b
show ([WordOf st] -> [WordOf st]
forall a. [a] -> [a]
reverse [WordOf st]
os)
        sym :: a -> Char
sym a
w = case a -> Int
forall a. Enum a => a -> Int
fromEnum a
w of
            Int
0 -> Char
'\0'
            Int
10 -> Char
'\n'
            Int
x | Int
32 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
126 -> Int -> Char
chr Int
x
            Int
_ -> Char
'?'