{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}

module Unison.Runtime.MCode
  ( Args' (..),
    Args (..),
    RefNums (..),
    MLit (..),
    GInstr (..),
    Instr,
    RInstr,
    GSection (.., MatchT, MatchW),
    RSection,
    Section,
    GComb (..),
    Comb,
    RComb (..),
    pattern RCombIx,
    pattern RCombRef,
    rCombToComb,
    GCombs,
    Combs,
    RCombs,
    CombIx (..),
    GRef (..),
    RRef,
    Ref,
    UPrim1 (..),
    UPrim2 (..),
    BPrim1 (..),
    BPrim2 (..),
    GBranch (..),
    Branch,
    RBranch,
    bcount,
    ucount,
    emitCombs,
    emitComb,
    resolveCombs,
    emptyRNs,
    argsToLists,
    combRef,
    rCombRef,
    combDeps,
    combTypes,
    prettyCombs,
    prettyComb,
  )
where

import Data.Bifunctor (bimap, first)
import Data.Bits (shiftL, shiftR, (.|.))
import Data.Coerce
import Data.Functor ((<&>))
import Data.List (partition)
import Data.Map.Strict qualified as M
import Data.Primitive.ByteArray
import Data.Primitive.PrimArray
import Data.Word (Word16, Word64)
import GHC.Stack (HasCallStack)
import Unison.ABT.Normalized (pattern TAbss)
import Unison.Reference (Reference)
import Unison.Referent (Referent)
import Unison.Runtime.ANF
  ( ANormal,
    Branched (..),
    CTag,
    Direction (..),
    Func (..),
    Mem (..),
    SuperGroup (..),
    SuperNormal (..),
    internalBug,
    packTags,
    pattern TApp,
    pattern TBLit,
    pattern TFOp,
    pattern TFrc,
    pattern THnd,
    pattern TLets,
    pattern TLit,
    pattern TMatch,
    pattern TName,
    pattern TPrm,
    pattern TShift,
    pattern TVar,
  )
import Unison.Runtime.ANF qualified as ANF
import Unison.Runtime.Builtin.Types (builtinTypeNumbering)
import Unison.Util.EnumContainers as EC
import Unison.Util.Text (Text)
import Unison.Var (Var)

-- This outlines some of the ideas/features in this core
-- language, and how they may be used to implement features of
-- the surface language.

-----------------------
-- Delimited control --
-----------------------

-- There is native support for delimited control operations in
-- the core language. This means we can:
--   1. delimit a block of code with an integer tagged prompt,
--      which corresponds to pushing a frame onto the
--      continuation with said tag
--   2. capture a portion of the continuation up to a particular
--      tag frame and turn it into a value, which _removes_ the
--      tag frame from the continuation in the process
--   3. push such a captured value back onto the continuation

-- TBD: Since the captured continuations in _delimited_ control
-- are (in this case impure) functions, it may make sense to make
-- the representation of functions support these captured
-- continuations directly.

-- The obvious use case of this feature is effects and handlers.
-- Delimiting a block with a prompt is part of installing a
-- handler for said block at least naively. The other part is
-- establishing the code that should be executed for each
-- operation to be handled.

-- It's important (I believe) in #2 that the prompt be removed
-- from the continuation by a control effect. The captured
-- continuation not being automatically delimited corresponds to
-- a shallow handler's obligation to re-establish the handling of
-- a re-invoked computation if it wishes to do so. The delimiter
-- being removed from the capturing code's continuation
-- corresponds to a handler being allowed to yield effects from
-- the same siganture that it is handling.

-- In special cases, it should be possible to omit use of control
-- effects in handlers. At the least, if a handler case resumes
-- the computation in tail position, it should be unnecessary to
-- capture the continuation at all. If all cases act this way, we
-- don't need a delimiter, because we will never capture.

-- TBD: it may make more sense to have prompt pushing be part of
-- some other construct, due to A-normal forms of the code.

-----------------------------
-- Unboxed sum-of-products --
-----------------------------

-- It is not usually stated this way, but one of the core
-- features of the STG machine is that functions/closures can
-- return unboxed sum-of-products types. This is actually the way
-- _all_ data types work in STG. The discriminee of a case
-- statement must eventually return by pushing several values
-- onto the stack (the product part) and specifying which branch
-- to return to (the sum part).

-- The way heap allocated data is produced is that an
-- intermediate frame may be in the continuation that grabs this
-- information from the local storage and puts it into the heap.
-- If this frame were omitted, only the unboxed component would
-- be left. Also, in STG, the heap allocated data is just a means
-- of reconstructing its unboxed analogue. Evaluating a heap
-- allocated data type value just results in pushing its stored
-- fields back on the stack, and immediately returning the tag.

-- The portion of this with the heap allocation frame omitted
-- seems to be a natural match for the case analysis portion of
-- handlers. A naive implementation of an effect algebra is as
-- the data type of the polynomial functor generated by the
-- signature, and handling corresponds to case analysis. However,
-- in a real implementation, we don't want a heap allocated
-- representation of this algebra, because its purpose is control
-- flow. Each operation will be handled once as it occurs, and we
-- won't save work by remembering some reified representation of
-- which operations were used.

-- Since handlers in unison are written as functions, it seems to
-- make sense to define a calling convention for unboxed
-- sum-of-products as arguments. Variable numbers of stack
-- positions could be pushed for such arguments, with tags
-- specifying which case is being provided.

-- TBD: sum arguments to a function correspond to a product of
-- functions, so it's possible that the calling convention for
-- these functions should be similar to returning to a case,
-- where we push arguments and then select which of several
-- pieces of code to jump to. This view also seems relevant to
-- the optimized implementation of certain forms of handler,
-- where we want effects to just directly select some code to
-- execute based on state that has been threaded to that point.

-- One thing to note: it probably does not make sense to
-- completely divide returns into unboxed returns and allocation
-- frames. The reason this works in STG is laziness. Naming a
-- computation with `let` does not do any evaluation, but it does
-- allocate space for its (boxed) result. The only thing that
-- _does_ demand evaluation is case analysis. So, if a value with
-- sum type is being evaluated, we know it must be about to be
-- unpacked, and it makes little sense to pack it on the stack,
-- though we can build a closure version of it in the writeback
-- location established by `let`.

-- By contrast, in unison a `let` of a sum type evaluates it
-- immediately, even if no one is analyzing it. So we might waste
-- work rearranging the stack with the unpacked contents when we
-- only needed the closure version to begin with. Instead, we
-- gain the ability to make the unpacking operation use no stack,
-- because we know what we are unpacking must be a value. Turning
-- boxed function calls into unboxed versions thus seems like a
-- situational optimization, rather than a universal calling
-- convention.

-------------------------------
-- Delimited Dynamic Binding --
-------------------------------

-- There is a final component to the implementation of ability
-- handlers in this runtime system, and that is dynamically
-- scoped variables associated to each prompt. Each prompt
-- corresponds to an ability signature, and `reset` to a handler
-- for said signature, but we need storage space for the code
-- installed by said handler. It is possible to implement
-- dynamically scoped variables entirely with delimited
-- continuations, but it is more efficient to keep track of the
-- storage directly when manipulating the continuations.

-- The dynamic scoping---and how it interacts with
-- continuations---corresponds to the nested structure of
-- handlers. Installing a handler establishes a variable scope,
-- shadowing outer scopes for the same prompt. Shifting, however,
-- can exit these scopes dynamically. So, for instance, if we
-- have a structure like:

--    reset 0 $ ...
--      reset 1 $ ...
--        reset 0 $ ...
--          shift 1 <E>

-- We have nested scopes 0>1>0, with the second 0 shadowing the
-- first. However, when we shift to 1, the inner 0 scope is
-- captured into the continuation, and uses of the 0 ability in
-- <E> will be handled by the outer handler until it is shadowed
-- again (and the captured continuation will re-establish the
-- shadowing).

-- Mutation of the variables is possible, but mutation only
-- affects the current scope. Essentially, the dynamic scoping is
-- of mutable references, and when scope changes, we switch
-- between different references, and the mutation of each
-- reference does not affect the others. The purpose of the
-- mutation is to enable more efficient implementation of
-- certain recursive, 'deep' handlers, since those can operate
-- more like stateful code than control operators.

data Args'
  = Arg1 !Int
  | Arg2 !Int !Int
  | -- frame index of each argument to the function
    ArgN {-# UNPACK #-} !(PrimArray Int)
  | ArgR !Int !Int
  deriving (Int -> Args' -> ShowS
[Args'] -> ShowS
Args' -> [Char]
(Int -> Args' -> ShowS)
-> (Args' -> [Char]) -> ([Args'] -> ShowS) -> Show Args'
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Args' -> ShowS
showsPrec :: Int -> Args' -> ShowS
$cshow :: Args' -> [Char]
show :: Args' -> [Char]
$cshowList :: [Args'] -> ShowS
showList :: [Args'] -> ShowS
Show)

data Args
  = ZArgs
  | UArg1 !Int
  | UArg2 !Int !Int
  | BArg1 !Int
  | BArg2 !Int !Int
  | DArg2 !Int !Int
  | UArgR !Int !Int
  | BArgR !Int !Int
  | DArgR !Int !Int !Int !Int
  | BArgN !(PrimArray Int)
  | UArgN !(PrimArray Int)
  | DArgN !(PrimArray Int) !(PrimArray Int)
  | DArgV !Int !Int
  deriving (Int -> Args -> ShowS
[Args] -> ShowS
Args -> [Char]
(Int -> Args -> ShowS)
-> (Args -> [Char]) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Args -> ShowS
showsPrec :: Int -> Args -> ShowS
$cshow :: Args -> [Char]
show :: Args -> [Char]
$cshowList :: [Args] -> ShowS
showList :: [Args] -> ShowS
Show, Args -> Args -> Bool
(Args -> Args -> Bool) -> (Args -> Args -> Bool) -> Eq Args
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Args -> Args -> Bool
== :: Args -> Args -> Bool
$c/= :: Args -> Args -> Bool
/= :: Args -> Args -> Bool
Eq, Eq Args
Eq Args =>
(Args -> Args -> Ordering)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Args)
-> (Args -> Args -> Args)
-> Ord Args
Args -> Args -> Bool
Args -> Args -> Ordering
Args -> Args -> Args
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Args -> Args -> Ordering
compare :: Args -> Args -> Ordering
$c< :: Args -> Args -> Bool
< :: Args -> Args -> Bool
$c<= :: Args -> Args -> Bool
<= :: Args -> Args -> Bool
$c> :: Args -> Args -> Bool
> :: Args -> Args -> Bool
$c>= :: Args -> Args -> Bool
>= :: Args -> Args -> Bool
$cmax :: Args -> Args -> Args
max :: Args -> Args -> Args
$cmin :: Args -> Args -> Args
min :: Args -> Args -> Args
Ord)

argsToLists :: Args -> ([Int], [Int])
argsToLists :: Args -> ([Int], [Int])
argsToLists Args
ZArgs = ([], [])
argsToLists (UArg1 Int
i) = ([Int
i], [])
argsToLists (UArg2 Int
i Int
j) = ([Int
i, Int
j], [])
argsToLists (BArg1 Int
i) = ([], [Int
i])
argsToLists (BArg2 Int
i Int
j) = ([], [Int
i, Int
j])
argsToLists (DArg2 Int
i Int
j) = ([Int
i], [Int
j])
argsToLists (UArgR Int
i Int
l) = (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
l [Int
i ..], [])
argsToLists (BArgR Int
i Int
l) = ([], Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
l [Int
i ..])
argsToLists (DArgR Int
ui Int
ul Int
bi Int
bl) = (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
ul [Int
ui ..], Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
bl [Int
bi ..])
argsToLists (BArgN PrimArray Int
bs) = ([], PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
bs)
argsToLists (UArgN PrimArray Int
us) = (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
us, [])
argsToLists (DArgN PrimArray Int
us PrimArray Int
bs) = (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
us, PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
bs)
argsToLists (DArgV Int
_ Int
_) = [Char] -> ([Int], [Int])
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"argsToLists: DArgV"

ucount, bcount :: Args -> Int
ucount :: Args -> Int
ucount (UArg1 Int
_) = Int
1
ucount (UArg2 Int
_ Int
_) = Int
2
ucount (DArg2 Int
_ Int
_) = Int
1
ucount (UArgR Int
_ Int
l) = Int
l
ucount (DArgR Int
_ Int
l Int
_ Int
_) = Int
l
ucount Args
_ = Int
0
{-# INLINE ucount #-}
bcount :: Args -> Int
bcount (BArg1 Int
_) = Int
1
bcount (BArg2 Int
_ Int
_) = Int
2
bcount (DArg2 Int
_ Int
_) = Int
1
bcount (BArgR Int
_ Int
l) = Int
l
bcount (DArgR Int
_ Int
_ Int
_ Int
l) = Int
l
bcount (BArgN PrimArray Int
a) = PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Int
a
bcount Args
_ = Int
0
{-# INLINE bcount #-}

data UPrim1
  = -- integral
    DECI
  | INCI
  | NEGI
  | SGNI -- decrement,increment,negate,signum
  | LZRO
  | TZRO
  | COMN
  | POPC -- leading/trailingZeroes,complement
  -- floating
  | ABSF
  | EXPF
  | LOGF
  | SQRT -- abs,exp,log,sqrt
  | COSF
  | ACOS
  | COSH
  | ACSH -- cos,acos,cosh,acosh
  | SINF
  | ASIN
  | SINH
  | ASNH -- sin,asin,sinh,asinh
  | TANF
  | ATAN
  | TANH
  | ATNH -- tan,atan,tanh,atanh
  | ITOF
  | NTOF
  | CEIL
  | FLOR -- intToFloat,natToFloat,ceiling,floor
  | TRNF
  | RNDF -- truncate,round
  deriving (Int -> UPrim1 -> ShowS
[UPrim1] -> ShowS
UPrim1 -> [Char]
(Int -> UPrim1 -> ShowS)
-> (UPrim1 -> [Char]) -> ([UPrim1] -> ShowS) -> Show UPrim1
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UPrim1 -> ShowS
showsPrec :: Int -> UPrim1 -> ShowS
$cshow :: UPrim1 -> [Char]
show :: UPrim1 -> [Char]
$cshowList :: [UPrim1] -> ShowS
showList :: [UPrim1] -> ShowS
Show, UPrim1 -> UPrim1 -> Bool
(UPrim1 -> UPrim1 -> Bool)
-> (UPrim1 -> UPrim1 -> Bool) -> Eq UPrim1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UPrim1 -> UPrim1 -> Bool
== :: UPrim1 -> UPrim1 -> Bool
$c/= :: UPrim1 -> UPrim1 -> Bool
/= :: UPrim1 -> UPrim1 -> Bool
Eq, Eq UPrim1
Eq UPrim1 =>
(UPrim1 -> UPrim1 -> Ordering)
-> (UPrim1 -> UPrim1 -> Bool)
-> (UPrim1 -> UPrim1 -> Bool)
-> (UPrim1 -> UPrim1 -> Bool)
-> (UPrim1 -> UPrim1 -> Bool)
-> (UPrim1 -> UPrim1 -> UPrim1)
-> (UPrim1 -> UPrim1 -> UPrim1)
-> Ord UPrim1
UPrim1 -> UPrim1 -> Bool
UPrim1 -> UPrim1 -> Ordering
UPrim1 -> UPrim1 -> UPrim1
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UPrim1 -> UPrim1 -> Ordering
compare :: UPrim1 -> UPrim1 -> Ordering
$c< :: UPrim1 -> UPrim1 -> Bool
< :: UPrim1 -> UPrim1 -> Bool
$c<= :: UPrim1 -> UPrim1 -> Bool
<= :: UPrim1 -> UPrim1 -> Bool
$c> :: UPrim1 -> UPrim1 -> Bool
> :: UPrim1 -> UPrim1 -> Bool
$c>= :: UPrim1 -> UPrim1 -> Bool
>= :: UPrim1 -> UPrim1 -> Bool
$cmax :: UPrim1 -> UPrim1 -> UPrim1
max :: UPrim1 -> UPrim1 -> UPrim1
$cmin :: UPrim1 -> UPrim1 -> UPrim1
min :: UPrim1 -> UPrim1 -> UPrim1
Ord)

data UPrim2
  = -- integral
    ADDI
  | SUBI
  | MULI
  | DIVI
  | MODI -- +,-,*,/,mod
  | DIVN
  | MODN
  | SHLI
  | SHRI
  | SHRN
  | POWI -- shiftl,shiftr,shiftr,pow
  | EQLI
  | LEQI
  | LEQN -- ==,<=,<=
  | ANDN
  | IORN
  | XORN -- and,or,xor
  -- floating
  | EQLF
  | LEQF -- ==,<=
  | ADDF
  | SUBF
  | MULF
  | DIVF
  | ATN2 -- +,-,*,/,atan2
  | POWF
  | LOGB
  | MAXF
  | MINF -- pow,low,max,min
  deriving (Int -> UPrim2 -> ShowS
[UPrim2] -> ShowS
UPrim2 -> [Char]
(Int -> UPrim2 -> ShowS)
-> (UPrim2 -> [Char]) -> ([UPrim2] -> ShowS) -> Show UPrim2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UPrim2 -> ShowS
showsPrec :: Int -> UPrim2 -> ShowS
$cshow :: UPrim2 -> [Char]
show :: UPrim2 -> [Char]
$cshowList :: [UPrim2] -> ShowS
showList :: [UPrim2] -> ShowS
Show, UPrim2 -> UPrim2 -> Bool
(UPrim2 -> UPrim2 -> Bool)
-> (UPrim2 -> UPrim2 -> Bool) -> Eq UPrim2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UPrim2 -> UPrim2 -> Bool
== :: UPrim2 -> UPrim2 -> Bool
$c/= :: UPrim2 -> UPrim2 -> Bool
/= :: UPrim2 -> UPrim2 -> Bool
Eq, Eq UPrim2
Eq UPrim2 =>
(UPrim2 -> UPrim2 -> Ordering)
-> (UPrim2 -> UPrim2 -> Bool)
-> (UPrim2 -> UPrim2 -> Bool)
-> (UPrim2 -> UPrim2 -> Bool)
-> (UPrim2 -> UPrim2 -> Bool)
-> (UPrim2 -> UPrim2 -> UPrim2)
-> (UPrim2 -> UPrim2 -> UPrim2)
-> Ord UPrim2
UPrim2 -> UPrim2 -> Bool
UPrim2 -> UPrim2 -> Ordering
UPrim2 -> UPrim2 -> UPrim2
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UPrim2 -> UPrim2 -> Ordering
compare :: UPrim2 -> UPrim2 -> Ordering
$c< :: UPrim2 -> UPrim2 -> Bool
< :: UPrim2 -> UPrim2 -> Bool
$c<= :: UPrim2 -> UPrim2 -> Bool
<= :: UPrim2 -> UPrim2 -> Bool
$c> :: UPrim2 -> UPrim2 -> Bool
> :: UPrim2 -> UPrim2 -> Bool
$c>= :: UPrim2 -> UPrim2 -> Bool
>= :: UPrim2 -> UPrim2 -> Bool
$cmax :: UPrim2 -> UPrim2 -> UPrim2
max :: UPrim2 -> UPrim2 -> UPrim2
$cmin :: UPrim2 -> UPrim2 -> UPrim2
min :: UPrim2 -> UPrim2 -> UPrim2
Ord)

data BPrim1
  = -- text
    SIZT
  | USNC
  | UCNS -- size,unsnoc,uncons
  | ITOT
  | NTOT
  | FTOT -- intToText,natToText,floatToText
  | TTOI
  | TTON
  | TTOF -- textToInt,textToNat,textToFloat
  | PAKT
  | UPKT -- pack,unpack
  -- sequence
  | VWLS
  | VWRS
  | SIZS -- viewl,viewr,size
  | PAKB
  | UPKB
  | SIZB -- pack,unpack,size
  | FLTB -- flatten
  -- code
  | MISS
  | CACH
  | LKUP
  | LOAD -- isMissing,cache_,lookup,load
  | CVLD -- validate
  | VALU
  | TLTT -- value, Term.Link.toText
  -- debug
  | DBTX -- debug text
  | SDBL -- sandbox link list
  deriving (Int -> BPrim1 -> ShowS
[BPrim1] -> ShowS
BPrim1 -> [Char]
(Int -> BPrim1 -> ShowS)
-> (BPrim1 -> [Char]) -> ([BPrim1] -> ShowS) -> Show BPrim1
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BPrim1 -> ShowS
showsPrec :: Int -> BPrim1 -> ShowS
$cshow :: BPrim1 -> [Char]
show :: BPrim1 -> [Char]
$cshowList :: [BPrim1] -> ShowS
showList :: [BPrim1] -> ShowS
Show, BPrim1 -> BPrim1 -> Bool
(BPrim1 -> BPrim1 -> Bool)
-> (BPrim1 -> BPrim1 -> Bool) -> Eq BPrim1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BPrim1 -> BPrim1 -> Bool
== :: BPrim1 -> BPrim1 -> Bool
$c/= :: BPrim1 -> BPrim1 -> Bool
/= :: BPrim1 -> BPrim1 -> Bool
Eq, Eq BPrim1
Eq BPrim1 =>
(BPrim1 -> BPrim1 -> Ordering)
-> (BPrim1 -> BPrim1 -> Bool)
-> (BPrim1 -> BPrim1 -> Bool)
-> (BPrim1 -> BPrim1 -> Bool)
-> (BPrim1 -> BPrim1 -> Bool)
-> (BPrim1 -> BPrim1 -> BPrim1)
-> (BPrim1 -> BPrim1 -> BPrim1)
-> Ord BPrim1
BPrim1 -> BPrim1 -> Bool
BPrim1 -> BPrim1 -> Ordering
BPrim1 -> BPrim1 -> BPrim1
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BPrim1 -> BPrim1 -> Ordering
compare :: BPrim1 -> BPrim1 -> Ordering
$c< :: BPrim1 -> BPrim1 -> Bool
< :: BPrim1 -> BPrim1 -> Bool
$c<= :: BPrim1 -> BPrim1 -> Bool
<= :: BPrim1 -> BPrim1 -> Bool
$c> :: BPrim1 -> BPrim1 -> Bool
> :: BPrim1 -> BPrim1 -> Bool
$c>= :: BPrim1 -> BPrim1 -> Bool
>= :: BPrim1 -> BPrim1 -> Bool
$cmax :: BPrim1 -> BPrim1 -> BPrim1
max :: BPrim1 -> BPrim1 -> BPrim1
$cmin :: BPrim1 -> BPrim1 -> BPrim1
min :: BPrim1 -> BPrim1 -> BPrim1
Ord)

data BPrim2
  = -- universal
    EQLU
  | CMPU -- ==,compare
  -- text
  | DRPT
  | CATT
  | TAKT -- drop,append,take
  | IXOT -- indexof
  | EQLT
  | LEQT
  | LEST -- ==,<=,<
  -- sequence
  | DRPS
  | CATS
  | TAKS -- drop,append,take
  | CONS
  | SNOC
  | IDXS -- cons,snoc,index
  | SPLL
  | SPLR -- splitLeft,splitRight
  -- bytes
  | TAKB
  | DRPB
  | IDXB
  | CATB -- take,drop,index,append
  | IXOB -- indexof
  -- general
  | THRO -- throw
  | TRCE -- trace
  -- code
  | SDBX -- sandbox
  | SDBV -- sandbox Value
  deriving (Int -> BPrim2 -> ShowS
[BPrim2] -> ShowS
BPrim2 -> [Char]
(Int -> BPrim2 -> ShowS)
-> (BPrim2 -> [Char]) -> ([BPrim2] -> ShowS) -> Show BPrim2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BPrim2 -> ShowS
showsPrec :: Int -> BPrim2 -> ShowS
$cshow :: BPrim2 -> [Char]
show :: BPrim2 -> [Char]
$cshowList :: [BPrim2] -> ShowS
showList :: [BPrim2] -> ShowS
Show, BPrim2 -> BPrim2 -> Bool
(BPrim2 -> BPrim2 -> Bool)
-> (BPrim2 -> BPrim2 -> Bool) -> Eq BPrim2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BPrim2 -> BPrim2 -> Bool
== :: BPrim2 -> BPrim2 -> Bool
$c/= :: BPrim2 -> BPrim2 -> Bool
/= :: BPrim2 -> BPrim2 -> Bool
Eq, Eq BPrim2
Eq BPrim2 =>
(BPrim2 -> BPrim2 -> Ordering)
-> (BPrim2 -> BPrim2 -> Bool)
-> (BPrim2 -> BPrim2 -> Bool)
-> (BPrim2 -> BPrim2 -> Bool)
-> (BPrim2 -> BPrim2 -> Bool)
-> (BPrim2 -> BPrim2 -> BPrim2)
-> (BPrim2 -> BPrim2 -> BPrim2)
-> Ord BPrim2
BPrim2 -> BPrim2 -> Bool
BPrim2 -> BPrim2 -> Ordering
BPrim2 -> BPrim2 -> BPrim2
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BPrim2 -> BPrim2 -> Ordering
compare :: BPrim2 -> BPrim2 -> Ordering
$c< :: BPrim2 -> BPrim2 -> Bool
< :: BPrim2 -> BPrim2 -> Bool
$c<= :: BPrim2 -> BPrim2 -> Bool
<= :: BPrim2 -> BPrim2 -> Bool
$c> :: BPrim2 -> BPrim2 -> Bool
> :: BPrim2 -> BPrim2 -> Bool
$c>= :: BPrim2 -> BPrim2 -> Bool
>= :: BPrim2 -> BPrim2 -> Bool
$cmax :: BPrim2 -> BPrim2 -> BPrim2
max :: BPrim2 -> BPrim2 -> BPrim2
$cmin :: BPrim2 -> BPrim2 -> BPrim2
min :: BPrim2 -> BPrim2 -> BPrim2
Ord)

data MLit
  = MI !Int
  | MD !Double
  | MT !Text
  | MM !Referent
  | MY !Reference
  deriving (Int -> MLit -> ShowS
[MLit] -> ShowS
MLit -> [Char]
(Int -> MLit -> ShowS)
-> (MLit -> [Char]) -> ([MLit] -> ShowS) -> Show MLit
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLit -> ShowS
showsPrec :: Int -> MLit -> ShowS
$cshow :: MLit -> [Char]
show :: MLit -> [Char]
$cshowList :: [MLit] -> ShowS
showList :: [MLit] -> ShowS
Show, MLit -> MLit -> Bool
(MLit -> MLit -> Bool) -> (MLit -> MLit -> Bool) -> Eq MLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLit -> MLit -> Bool
== :: MLit -> MLit -> Bool
$c/= :: MLit -> MLit -> Bool
/= :: MLit -> MLit -> Bool
Eq, Eq MLit
Eq MLit =>
(MLit -> MLit -> Ordering)
-> (MLit -> MLit -> Bool)
-> (MLit -> MLit -> Bool)
-> (MLit -> MLit -> Bool)
-> (MLit -> MLit -> Bool)
-> (MLit -> MLit -> MLit)
-> (MLit -> MLit -> MLit)
-> Ord MLit
MLit -> MLit -> Bool
MLit -> MLit -> Ordering
MLit -> MLit -> MLit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MLit -> MLit -> Ordering
compare :: MLit -> MLit -> Ordering
$c< :: MLit -> MLit -> Bool
< :: MLit -> MLit -> Bool
$c<= :: MLit -> MLit -> Bool
<= :: MLit -> MLit -> Bool
$c> :: MLit -> MLit -> Bool
> :: MLit -> MLit -> Bool
$c>= :: MLit -> MLit -> Bool
>= :: MLit -> MLit -> Bool
$cmax :: MLit -> MLit -> MLit
max :: MLit -> MLit -> MLit
$cmin :: MLit -> MLit -> MLit
min :: MLit -> MLit -> MLit
Ord)

type Instr = GInstr CombIx

type RInstr = GInstr RComb

-- Instructions for manipulating the data stack in the main portion of
-- a block
data GInstr comb
  = -- 1-argument unboxed primitive operations
    UPrim1
      !UPrim1 -- primitive instruction
      !Int -- index of prim argument
  | -- 2-argument unboxed primitive operations
    UPrim2
      !UPrim2 -- primitive instruction
      !Int -- index of first prim argument
      !Int -- index of second prim argument
  | -- 1-argument primitive operations that may involve boxed values
    BPrim1
      !BPrim1
      !Int
  | -- 2-argument primitive operations that may involve boxed values
    BPrim2
      !BPrim2
      !Int
      !Int
  | -- Call out to a Haskell function. This is considerably slower
    -- for very simple operations, hence the primops.
    ForeignCall
      !Bool -- catch exceptions
      !Word64 -- FFI call
      !Args -- arguments
  | -- Set the value of a dynamic reference
    SetDyn
      !Word64 -- the prompt tag of the reference
      !Int -- the stack index of the closure to store
  | -- Capture the continuation up to a given marker.
    Capture !Word64 -- the prompt tag
  | -- This is essentially the opposite of `Call`. Pack a given
    -- statically known function into a closure with arguments.
    -- No stack is necessary, because no nested evaluation happens,
    -- so the instruction directly takes a follow-up.
    Name !(GRef comb) !Args
  | -- Dump some debugging information about the machine state to
    -- the screen.
    Info !String -- prefix for output
  | -- Pack a data type value into a closure and place it
    -- on the stack.
    Pack
      !Reference -- data type reference
      !Word64 -- tag
      !Args -- arguments to pack
  | -- Unpack the contents of a data type onto the stack
    Unpack
      !(Maybe Reference) -- debug reference
      !Int -- stack index of data to unpack
  | -- Push a particular value onto the appropriate stack
    Lit !MLit -- value to push onto the stack
  | -- Push a particular value directly onto the boxed stack
    BLit !Reference !Word64 {- packed type tag for the ref -} !MLit
  | -- Print a value on the unboxed stack
    Print !Int -- index of the primitive value to print
  | -- Put a delimiter on the continuation
    Reset !(EnumSet Word64) -- prompt ids
  | -- Fork thread evaluating delayed computation on boxed stack
    Fork !Int
  | -- Atomic transaction evaluating delayed computation on boxed stack
    Atomically !Int
  | -- Build a sequence consisting of a variable number of arguments
    Seq !Args
  | -- Force a delayed expression, catching any runtime exceptions involved
    TryForce !Int
  deriving stock (Int -> GInstr comb -> ShowS
[GInstr comb] -> ShowS
GInstr comb -> [Char]
(Int -> GInstr comb -> ShowS)
-> (GInstr comb -> [Char])
-> ([GInstr comb] -> ShowS)
-> Show (GInstr comb)
forall comb. Show comb => Int -> GInstr comb -> ShowS
forall comb. Show comb => [GInstr comb] -> ShowS
forall comb. Show comb => GInstr comb -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall comb. Show comb => Int -> GInstr comb -> ShowS
showsPrec :: Int -> GInstr comb -> ShowS
$cshow :: forall comb. Show comb => GInstr comb -> [Char]
show :: GInstr comb -> [Char]
$cshowList :: forall comb. Show comb => [GInstr comb] -> ShowS
showList :: [GInstr comb] -> ShowS
Show, GInstr comb -> GInstr comb -> Bool
(GInstr comb -> GInstr comb -> Bool)
-> (GInstr comb -> GInstr comb -> Bool) -> Eq (GInstr comb)
forall comb. Eq comb => GInstr comb -> GInstr comb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall comb. Eq comb => GInstr comb -> GInstr comb -> Bool
== :: GInstr comb -> GInstr comb -> Bool
$c/= :: forall comb. Eq comb => GInstr comb -> GInstr comb -> Bool
/= :: GInstr comb -> GInstr comb -> Bool
Eq, Eq (GInstr comb)
Eq (GInstr comb) =>
(GInstr comb -> GInstr comb -> Ordering)
-> (GInstr comb -> GInstr comb -> Bool)
-> (GInstr comb -> GInstr comb -> Bool)
-> (GInstr comb -> GInstr comb -> Bool)
-> (GInstr comb -> GInstr comb -> Bool)
-> (GInstr comb -> GInstr comb -> GInstr comb)
-> (GInstr comb -> GInstr comb -> GInstr comb)
-> Ord (GInstr comb)
GInstr comb -> GInstr comb -> Bool
GInstr comb -> GInstr comb -> Ordering
GInstr comb -> GInstr comb -> GInstr comb
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall comb. Ord comb => Eq (GInstr comb)
forall comb. Ord comb => GInstr comb -> GInstr comb -> Bool
forall comb. Ord comb => GInstr comb -> GInstr comb -> Ordering
forall comb. Ord comb => GInstr comb -> GInstr comb -> GInstr comb
$ccompare :: forall comb. Ord comb => GInstr comb -> GInstr comb -> Ordering
compare :: GInstr comb -> GInstr comb -> Ordering
$c< :: forall comb. Ord comb => GInstr comb -> GInstr comb -> Bool
< :: GInstr comb -> GInstr comb -> Bool
$c<= :: forall comb. Ord comb => GInstr comb -> GInstr comb -> Bool
<= :: GInstr comb -> GInstr comb -> Bool
$c> :: forall comb. Ord comb => GInstr comb -> GInstr comb -> Bool
> :: GInstr comb -> GInstr comb -> Bool
$c>= :: forall comb. Ord comb => GInstr comb -> GInstr comb -> Bool
>= :: GInstr comb -> GInstr comb -> Bool
$cmax :: forall comb. Ord comb => GInstr comb -> GInstr comb -> GInstr comb
max :: GInstr comb -> GInstr comb -> GInstr comb
$cmin :: forall comb. Ord comb => GInstr comb -> GInstr comb -> GInstr comb
min :: GInstr comb -> GInstr comb -> GInstr comb
Ord, (forall a b. (a -> b) -> GInstr a -> GInstr b)
-> (forall a b. a -> GInstr b -> GInstr a) -> Functor GInstr
forall a b. a -> GInstr b -> GInstr a
forall a b. (a -> b) -> GInstr a -> GInstr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GInstr a -> GInstr b
fmap :: forall a b. (a -> b) -> GInstr a -> GInstr b
$c<$ :: forall a b. a -> GInstr b -> GInstr a
<$ :: forall a b. a -> GInstr b -> GInstr a
Functor, (forall m. Monoid m => GInstr m -> m)
-> (forall m a. Monoid m => (a -> m) -> GInstr a -> m)
-> (forall m a. Monoid m => (a -> m) -> GInstr a -> m)
-> (forall a b. (a -> b -> b) -> b -> GInstr a -> b)
-> (forall a b. (a -> b -> b) -> b -> GInstr a -> b)
-> (forall b a. (b -> a -> b) -> b -> GInstr a -> b)
-> (forall b a. (b -> a -> b) -> b -> GInstr a -> b)
-> (forall a. (a -> a -> a) -> GInstr a -> a)
-> (forall a. (a -> a -> a) -> GInstr a -> a)
-> (forall a. GInstr a -> [a])
-> (forall a. GInstr a -> Bool)
-> (forall a. GInstr a -> Int)
-> (forall a. Eq a => a -> GInstr a -> Bool)
-> (forall a. Ord a => GInstr a -> a)
-> (forall a. Ord a => GInstr a -> a)
-> (forall a. Num a => GInstr a -> a)
-> (forall a. Num a => GInstr a -> a)
-> Foldable GInstr
forall a. Eq a => a -> GInstr a -> Bool
forall a. Num a => GInstr a -> a
forall a. Ord a => GInstr a -> a
forall m. Monoid m => GInstr m -> m
forall a. GInstr a -> Bool
forall a. GInstr a -> Int
forall a. GInstr a -> [a]
forall a. (a -> a -> a) -> GInstr a -> a
forall m a. Monoid m => (a -> m) -> GInstr a -> m
forall b a. (b -> a -> b) -> b -> GInstr a -> b
forall a b. (a -> b -> b) -> b -> GInstr a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GInstr m -> m
fold :: forall m. Monoid m => GInstr m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GInstr a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GInstr a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GInstr a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GInstr a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GInstr a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GInstr a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GInstr a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GInstr a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GInstr a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GInstr a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GInstr a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GInstr a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GInstr a -> a
foldr1 :: forall a. (a -> a -> a) -> GInstr a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GInstr a -> a
foldl1 :: forall a. (a -> a -> a) -> GInstr a -> a
$ctoList :: forall a. GInstr a -> [a]
toList :: forall a. GInstr a -> [a]
$cnull :: forall a. GInstr a -> Bool
null :: forall a. GInstr a -> Bool
$clength :: forall a. GInstr a -> Int
length :: forall a. GInstr a -> Int
$celem :: forall a. Eq a => a -> GInstr a -> Bool
elem :: forall a. Eq a => a -> GInstr a -> Bool
$cmaximum :: forall a. Ord a => GInstr a -> a
maximum :: forall a. Ord a => GInstr a -> a
$cminimum :: forall a. Ord a => GInstr a -> a
minimum :: forall a. Ord a => GInstr a -> a
$csum :: forall a. Num a => GInstr a -> a
sum :: forall a. Num a => GInstr a -> a
$cproduct :: forall a. Num a => GInstr a -> a
product :: forall a. Num a => GInstr a -> a
Foldable, Functor GInstr
Foldable GInstr
(Functor GInstr, Foldable GInstr) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> GInstr a -> f (GInstr b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GInstr (f a) -> f (GInstr a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GInstr a -> m (GInstr b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GInstr (m a) -> m (GInstr a))
-> Traversable GInstr
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GInstr (m a) -> m (GInstr a)
forall (f :: * -> *) a.
Applicative f =>
GInstr (f a) -> f (GInstr a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GInstr a -> m (GInstr b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GInstr a -> f (GInstr b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GInstr a -> f (GInstr b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GInstr a -> f (GInstr b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GInstr (f a) -> f (GInstr a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GInstr (f a) -> f (GInstr a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GInstr a -> m (GInstr b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GInstr a -> m (GInstr b)
$csequence :: forall (m :: * -> *) a. Monad m => GInstr (m a) -> m (GInstr a)
sequence :: forall (m :: * -> *) a. Monad m => GInstr (m a) -> m (GInstr a)
Traversable)

type Section = GSection CombIx

type RSection = GSection RComb

data GSection comb
  = -- Apply a function to arguments. This is the 'slow path', and
    -- handles applying functions from arbitrary sources. This
    -- requires checks to determine what exactly should happen.
    App
      !Bool -- skip argument check for known calling convention
      !(GRef comb) -- function to call
      !Args -- arguments
  | -- This is the 'fast path', for when we statically know we're
    -- making an exactly saturated call to a statically known
    -- function. This allows skipping various checks that can cost
    -- time in very tight loops. This also allows skipping the
    -- stack check if we know that the current stack allowance is
    -- sufficient for where we're jumping to.
    Call
      !Bool -- skip stack check
      !comb -- global function reference
      !Args -- arguments
  | -- Jump to a captured continuation value.
    Jump
      !Int -- index of captured continuation
      !Args -- arguments to send to continuation
  | -- Branch on the value in the unboxed data stack
    Match
      !Int -- index of unboxed item to match on
      !(GBranch comb) -- branches
  | -- Yield control to the current continuation, with arguments
    Yield !Args -- values to yield
  | -- Prefix an instruction onto a section
    Ins !(GInstr comb) !(GSection comb)
  | -- Sequence two sections. The second is pushed as a return
    -- point for the results of the first. Stack modifications in
    -- the first are lost on return to the second.
    Let !(GSection comb) !comb
  | -- Throw an exception with the given message
    Die String
  | -- Immediately stop a thread of interpretation. This is more of
    -- a debugging tool than a proper operation to target.
    Exit
  | -- Branch on a data type without dumping the tag onto the unboxed
    -- stack.
    DMatch
      !(Maybe Reference) -- expected data type
      !Int -- index of data item on boxed stack
      !(GBranch comb) -- branches
  | -- Branch on a numeric type without dumping it to the stack
    NMatch
      !(Maybe Reference) -- expected data type
      !Int -- index of data item on boxed stack
      !(GBranch comb) -- branches
  | -- Branch on a request representation without dumping the tag
    -- portion to the unboxed stack.
    RMatch
      !Int -- index of request item on the boxed stack
      !(GSection comb) -- pure case
      !(EnumMap Word64 (GBranch comb)) -- effect cases
  deriving stock (Int -> GSection comb -> ShowS
[GSection comb] -> ShowS
GSection comb -> [Char]
(Int -> GSection comb -> ShowS)
-> (GSection comb -> [Char])
-> ([GSection comb] -> ShowS)
-> Show (GSection comb)
forall comb. Show comb => Int -> GSection comb -> ShowS
forall comb. Show comb => [GSection comb] -> ShowS
forall comb. Show comb => GSection comb -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall comb. Show comb => Int -> GSection comb -> ShowS
showsPrec :: Int -> GSection comb -> ShowS
$cshow :: forall comb. Show comb => GSection comb -> [Char]
show :: GSection comb -> [Char]
$cshowList :: forall comb. Show comb => [GSection comb] -> ShowS
showList :: [GSection comb] -> ShowS
Show, GSection comb -> GSection comb -> Bool
(GSection comb -> GSection comb -> Bool)
-> (GSection comb -> GSection comb -> Bool) -> Eq (GSection comb)
forall comb. Eq comb => GSection comb -> GSection comb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall comb. Eq comb => GSection comb -> GSection comb -> Bool
== :: GSection comb -> GSection comb -> Bool
$c/= :: forall comb. Eq comb => GSection comb -> GSection comb -> Bool
/= :: GSection comb -> GSection comb -> Bool
Eq, Eq (GSection comb)
Eq (GSection comb) =>
(GSection comb -> GSection comb -> Ordering)
-> (GSection comb -> GSection comb -> Bool)
-> (GSection comb -> GSection comb -> Bool)
-> (GSection comb -> GSection comb -> Bool)
-> (GSection comb -> GSection comb -> Bool)
-> (GSection comb -> GSection comb -> GSection comb)
-> (GSection comb -> GSection comb -> GSection comb)
-> Ord (GSection comb)
GSection comb -> GSection comb -> Bool
GSection comb -> GSection comb -> Ordering
GSection comb -> GSection comb -> GSection comb
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall comb. Ord comb => Eq (GSection comb)
forall comb. Ord comb => GSection comb -> GSection comb -> Bool
forall comb. Ord comb => GSection comb -> GSection comb -> Ordering
forall comb.
Ord comb =>
GSection comb -> GSection comb -> GSection comb
$ccompare :: forall comb. Ord comb => GSection comb -> GSection comb -> Ordering
compare :: GSection comb -> GSection comb -> Ordering
$c< :: forall comb. Ord comb => GSection comb -> GSection comb -> Bool
< :: GSection comb -> GSection comb -> Bool
$c<= :: forall comb. Ord comb => GSection comb -> GSection comb -> Bool
<= :: GSection comb -> GSection comb -> Bool
$c> :: forall comb. Ord comb => GSection comb -> GSection comb -> Bool
> :: GSection comb -> GSection comb -> Bool
$c>= :: forall comb. Ord comb => GSection comb -> GSection comb -> Bool
>= :: GSection comb -> GSection comb -> Bool
$cmax :: forall comb.
Ord comb =>
GSection comb -> GSection comb -> GSection comb
max :: GSection comb -> GSection comb -> GSection comb
$cmin :: forall comb.
Ord comb =>
GSection comb -> GSection comb -> GSection comb
min :: GSection comb -> GSection comb -> GSection comb
Ord, (forall a b. (a -> b) -> GSection a -> GSection b)
-> (forall a b. a -> GSection b -> GSection a) -> Functor GSection
forall a b. a -> GSection b -> GSection a
forall a b. (a -> b) -> GSection a -> GSection b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GSection a -> GSection b
fmap :: forall a b. (a -> b) -> GSection a -> GSection b
$c<$ :: forall a b. a -> GSection b -> GSection a
<$ :: forall a b. a -> GSection b -> GSection a
Functor, (forall m. Monoid m => GSection m -> m)
-> (forall m a. Monoid m => (a -> m) -> GSection a -> m)
-> (forall m a. Monoid m => (a -> m) -> GSection a -> m)
-> (forall a b. (a -> b -> b) -> b -> GSection a -> b)
-> (forall a b. (a -> b -> b) -> b -> GSection a -> b)
-> (forall b a. (b -> a -> b) -> b -> GSection a -> b)
-> (forall b a. (b -> a -> b) -> b -> GSection a -> b)
-> (forall a. (a -> a -> a) -> GSection a -> a)
-> (forall a. (a -> a -> a) -> GSection a -> a)
-> (forall a. GSection a -> [a])
-> (forall a. GSection a -> Bool)
-> (forall a. GSection a -> Int)
-> (forall a. Eq a => a -> GSection a -> Bool)
-> (forall a. Ord a => GSection a -> a)
-> (forall a. Ord a => GSection a -> a)
-> (forall a. Num a => GSection a -> a)
-> (forall a. Num a => GSection a -> a)
-> Foldable GSection
forall a. Eq a => a -> GSection a -> Bool
forall a. Num a => GSection a -> a
forall a. Ord a => GSection a -> a
forall m. Monoid m => GSection m -> m
forall a. GSection a -> Bool
forall a. GSection a -> Int
forall a. GSection a -> [a]
forall a. (a -> a -> a) -> GSection a -> a
forall m a. Monoid m => (a -> m) -> GSection a -> m
forall b a. (b -> a -> b) -> b -> GSection a -> b
forall a b. (a -> b -> b) -> b -> GSection a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GSection m -> m
fold :: forall m. Monoid m => GSection m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GSection a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GSection a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GSection a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GSection a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GSection a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GSection a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GSection a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GSection a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GSection a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GSection a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GSection a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GSection a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GSection a -> a
foldr1 :: forall a. (a -> a -> a) -> GSection a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GSection a -> a
foldl1 :: forall a. (a -> a -> a) -> GSection a -> a
$ctoList :: forall a. GSection a -> [a]
toList :: forall a. GSection a -> [a]
$cnull :: forall a. GSection a -> Bool
null :: forall a. GSection a -> Bool
$clength :: forall a. GSection a -> Int
length :: forall a. GSection a -> Int
$celem :: forall a. Eq a => a -> GSection a -> Bool
elem :: forall a. Eq a => a -> GSection a -> Bool
$cmaximum :: forall a. Ord a => GSection a -> a
maximum :: forall a. Ord a => GSection a -> a
$cminimum :: forall a. Ord a => GSection a -> a
minimum :: forall a. Ord a => GSection a -> a
$csum :: forall a. Num a => GSection a -> a
sum :: forall a. Num a => GSection a -> a
$cproduct :: forall a. Num a => GSection a -> a
product :: forall a. Num a => GSection a -> a
Foldable, Functor GSection
Foldable GSection
(Functor GSection, Foldable GSection) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> GSection a -> f (GSection b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GSection (f a) -> f (GSection a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GSection a -> m (GSection b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GSection (m a) -> m (GSection a))
-> Traversable GSection
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GSection (m a) -> m (GSection a)
forall (f :: * -> *) a.
Applicative f =>
GSection (f a) -> f (GSection a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GSection a -> m (GSection b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GSection a -> f (GSection b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GSection a -> f (GSection b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GSection a -> f (GSection b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GSection (f a) -> f (GSection a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GSection (f a) -> f (GSection a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GSection a -> m (GSection b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GSection a -> m (GSection b)
$csequence :: forall (m :: * -> *) a. Monad m => GSection (m a) -> m (GSection a)
sequence :: forall (m :: * -> *) a. Monad m => GSection (m a) -> m (GSection a)
Traversable)

data CombIx
  = CIx
      !Reference -- top reference
      !Word64 -- top level
      !Word64 -- section
  deriving (CombIx -> CombIx -> Bool
(CombIx -> CombIx -> Bool)
-> (CombIx -> CombIx -> Bool) -> Eq CombIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CombIx -> CombIx -> Bool
== :: CombIx -> CombIx -> Bool
$c/= :: CombIx -> CombIx -> Bool
/= :: CombIx -> CombIx -> Bool
Eq, Eq CombIx
Eq CombIx =>
(CombIx -> CombIx -> Ordering)
-> (CombIx -> CombIx -> Bool)
-> (CombIx -> CombIx -> Bool)
-> (CombIx -> CombIx -> Bool)
-> (CombIx -> CombIx -> Bool)
-> (CombIx -> CombIx -> CombIx)
-> (CombIx -> CombIx -> CombIx)
-> Ord CombIx
CombIx -> CombIx -> Bool
CombIx -> CombIx -> Ordering
CombIx -> CombIx -> CombIx
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CombIx -> CombIx -> Ordering
compare :: CombIx -> CombIx -> Ordering
$c< :: CombIx -> CombIx -> Bool
< :: CombIx -> CombIx -> Bool
$c<= :: CombIx -> CombIx -> Bool
<= :: CombIx -> CombIx -> Bool
$c> :: CombIx -> CombIx -> Bool
> :: CombIx -> CombIx -> Bool
$c>= :: CombIx -> CombIx -> Bool
>= :: CombIx -> CombIx -> Bool
$cmax :: CombIx -> CombIx -> CombIx
max :: CombIx -> CombIx -> CombIx
$cmin :: CombIx -> CombIx -> CombIx
min :: CombIx -> CombIx -> CombIx
Ord, Int -> CombIx -> ShowS
[CombIx] -> ShowS
CombIx -> [Char]
(Int -> CombIx -> ShowS)
-> (CombIx -> [Char]) -> ([CombIx] -> ShowS) -> Show CombIx
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CombIx -> ShowS
showsPrec :: Int -> CombIx -> ShowS
$cshow :: CombIx -> [Char]
show :: CombIx -> [Char]
$cshowList :: [CombIx] -> ShowS
showList :: [CombIx] -> ShowS
Show)

combRef :: CombIx -> Reference
combRef :: CombIx -> Reference
combRef (CIx Reference
r Word64
_ Word64
_) = Reference
r

rCombRef :: RComb -> Reference
rCombRef :: RComb -> Reference
rCombRef (RComb CombIx
cix GComb RComb
_) = CombIx -> Reference
combRef CombIx
cix

data RefNums = RN
  { RefNums -> Reference -> Word64
dnum :: Reference -> Word64,
    RefNums -> Reference -> Word64
cnum :: Reference -> Word64
  }

emptyRNs :: RefNums
emptyRNs :: RefNums
emptyRNs = (Reference -> Word64) -> (Reference -> Word64) -> RefNums
RN Reference -> Word64
forall {p} {a}. p -> a
mt Reference -> Word64
forall {p} {a}. p -> a
mt
  where
    mt :: p -> a
mt p
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"RefNums: empty"

type Comb = GComb CombIx

data GComb comb
  = Lam
      !Int -- Number of unboxed arguments
      !Int -- Number of boxed arguments
      !Int -- Maximum needed unboxed frame size
      !Int -- Maximum needed boxed frame size
      !(GSection comb) -- Entry
  deriving stock (Int -> GComb comb -> ShowS
[GComb comb] -> ShowS
GComb comb -> [Char]
(Int -> GComb comb -> ShowS)
-> (GComb comb -> [Char])
-> ([GComb comb] -> ShowS)
-> Show (GComb comb)
forall comb. Show comb => Int -> GComb comb -> ShowS
forall comb. Show comb => [GComb comb] -> ShowS
forall comb. Show comb => GComb comb -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall comb. Show comb => Int -> GComb comb -> ShowS
showsPrec :: Int -> GComb comb -> ShowS
$cshow :: forall comb. Show comb => GComb comb -> [Char]
show :: GComb comb -> [Char]
$cshowList :: forall comb. Show comb => [GComb comb] -> ShowS
showList :: [GComb comb] -> ShowS
Show, GComb comb -> GComb comb -> Bool
(GComb comb -> GComb comb -> Bool)
-> (GComb comb -> GComb comb -> Bool) -> Eq (GComb comb)
forall comb. Eq comb => GComb comb -> GComb comb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall comb. Eq comb => GComb comb -> GComb comb -> Bool
== :: GComb comb -> GComb comb -> Bool
$c/= :: forall comb. Eq comb => GComb comb -> GComb comb -> Bool
/= :: GComb comb -> GComb comb -> Bool
Eq, Eq (GComb comb)
Eq (GComb comb) =>
(GComb comb -> GComb comb -> Ordering)
-> (GComb comb -> GComb comb -> Bool)
-> (GComb comb -> GComb comb -> Bool)
-> (GComb comb -> GComb comb -> Bool)
-> (GComb comb -> GComb comb -> Bool)
-> (GComb comb -> GComb comb -> GComb comb)
-> (GComb comb -> GComb comb -> GComb comb)
-> Ord (GComb comb)
GComb comb -> GComb comb -> Bool
GComb comb -> GComb comb -> Ordering
GComb comb -> GComb comb -> GComb comb
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall comb. Ord comb => Eq (GComb comb)
forall comb. Ord comb => GComb comb -> GComb comb -> Bool
forall comb. Ord comb => GComb comb -> GComb comb -> Ordering
forall comb. Ord comb => GComb comb -> GComb comb -> GComb comb
$ccompare :: forall comb. Ord comb => GComb comb -> GComb comb -> Ordering
compare :: GComb comb -> GComb comb -> Ordering
$c< :: forall comb. Ord comb => GComb comb -> GComb comb -> Bool
< :: GComb comb -> GComb comb -> Bool
$c<= :: forall comb. Ord comb => GComb comb -> GComb comb -> Bool
<= :: GComb comb -> GComb comb -> Bool
$c> :: forall comb. Ord comb => GComb comb -> GComb comb -> Bool
> :: GComb comb -> GComb comb -> Bool
$c>= :: forall comb. Ord comb => GComb comb -> GComb comb -> Bool
>= :: GComb comb -> GComb comb -> Bool
$cmax :: forall comb. Ord comb => GComb comb -> GComb comb -> GComb comb
max :: GComb comb -> GComb comb -> GComb comb
$cmin :: forall comb. Ord comb => GComb comb -> GComb comb -> GComb comb
min :: GComb comb -> GComb comb -> GComb comb
Ord, (forall a b. (a -> b) -> GComb a -> GComb b)
-> (forall a b. a -> GComb b -> GComb a) -> Functor GComb
forall a b. a -> GComb b -> GComb a
forall a b. (a -> b) -> GComb a -> GComb b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GComb a -> GComb b
fmap :: forall a b. (a -> b) -> GComb a -> GComb b
$c<$ :: forall a b. a -> GComb b -> GComb a
<$ :: forall a b. a -> GComb b -> GComb a
Functor, (forall m. Monoid m => GComb m -> m)
-> (forall m a. Monoid m => (a -> m) -> GComb a -> m)
-> (forall m a. Monoid m => (a -> m) -> GComb a -> m)
-> (forall a b. (a -> b -> b) -> b -> GComb a -> b)
-> (forall a b. (a -> b -> b) -> b -> GComb a -> b)
-> (forall b a. (b -> a -> b) -> b -> GComb a -> b)
-> (forall b a. (b -> a -> b) -> b -> GComb a -> b)
-> (forall a. (a -> a -> a) -> GComb a -> a)
-> (forall a. (a -> a -> a) -> GComb a -> a)
-> (forall a. GComb a -> [a])
-> (forall a. GComb a -> Bool)
-> (forall a. GComb a -> Int)
-> (forall a. Eq a => a -> GComb a -> Bool)
-> (forall a. Ord a => GComb a -> a)
-> (forall a. Ord a => GComb a -> a)
-> (forall a. Num a => GComb a -> a)
-> (forall a. Num a => GComb a -> a)
-> Foldable GComb
forall a. Eq a => a -> GComb a -> Bool
forall a. Num a => GComb a -> a
forall a. Ord a => GComb a -> a
forall m. Monoid m => GComb m -> m
forall a. GComb a -> Bool
forall a. GComb a -> Int
forall a. GComb a -> [a]
forall a. (a -> a -> a) -> GComb a -> a
forall m a. Monoid m => (a -> m) -> GComb a -> m
forall b a. (b -> a -> b) -> b -> GComb a -> b
forall a b. (a -> b -> b) -> b -> GComb a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GComb m -> m
fold :: forall m. Monoid m => GComb m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GComb a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GComb a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GComb a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GComb a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GComb a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GComb a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GComb a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GComb a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GComb a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GComb a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GComb a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GComb a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GComb a -> a
foldr1 :: forall a. (a -> a -> a) -> GComb a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GComb a -> a
foldl1 :: forall a. (a -> a -> a) -> GComb a -> a
$ctoList :: forall a. GComb a -> [a]
toList :: forall a. GComb a -> [a]
$cnull :: forall a. GComb a -> Bool
null :: forall a. GComb a -> Bool
$clength :: forall a. GComb a -> Int
length :: forall a. GComb a -> Int
$celem :: forall a. Eq a => a -> GComb a -> Bool
elem :: forall a. Eq a => a -> GComb a -> Bool
$cmaximum :: forall a. Ord a => GComb a -> a
maximum :: forall a. Ord a => GComb a -> a
$cminimum :: forall a. Ord a => GComb a -> a
minimum :: forall a. Ord a => GComb a -> a
$csum :: forall a. Num a => GComb a -> a
sum :: forall a. Num a => GComb a -> a
$cproduct :: forall a. Num a => GComb a -> a
product :: forall a. Num a => GComb a -> a
Foldable, Functor GComb
Foldable GComb
(Functor GComb, Foldable GComb) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> GComb a -> f (GComb b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GComb (f a) -> f (GComb a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GComb a -> m (GComb b))
-> (forall (m :: * -> *) a. Monad m => GComb (m a) -> m (GComb a))
-> Traversable GComb
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GComb (m a) -> m (GComb a)
forall (f :: * -> *) a. Applicative f => GComb (f a) -> f (GComb a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb a -> m (GComb b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb a -> f (GComb b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb a -> f (GComb b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb a -> f (GComb b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => GComb (f a) -> f (GComb a)
sequenceA :: forall (f :: * -> *) a. Applicative f => GComb (f a) -> f (GComb a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb a -> m (GComb b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb a -> m (GComb b)
$csequence :: forall (m :: * -> *) a. Monad m => GComb (m a) -> m (GComb a)
sequence :: forall (m :: * -> *) a. Monad m => GComb (m a) -> m (GComb a)
Traversable)

type Combs = GCombs CombIx

type RCombs = GCombs RComb

-- | Extract the CombIx from an RComb.
pattern RCombIx :: CombIx -> RComb
pattern $mRCombIx :: forall {r}. RComb -> (CombIx -> r) -> ((# #) -> r) -> r
RCombIx r <- (rCombIx -> r)

{-# COMPLETE RCombIx #-}

-- | Extract the Reference from an RComb.
pattern RCombRef :: Reference -> RComb
pattern $mRCombRef :: forall {r}. RComb -> (Reference -> r) -> ((# #) -> r) -> r
RCombRef r <- (combRef . rCombIx -> r)

{-# COMPLETE RCombRef #-}

-- | The fixed point of a GComb where all references to a Comb are themselves Combs.
data RComb = RComb
  { RComb -> CombIx
rCombIx :: !CombIx,
    RComb -> GComb RComb
unRComb :: (GComb RComb {- Possibly recursive comb, keep it lazy or risk blowing up -})
  }

-- Eq and Ord instances on the CombIx to avoid infinite recursion when
-- comparing self-recursive functions.
instance Eq RComb where
  RComb CombIx
r1 GComb RComb
_ == :: RComb -> RComb -> Bool
== RComb CombIx
r2 GComb RComb
_ = CombIx
r1 CombIx -> CombIx -> Bool
forall a. Eq a => a -> a -> Bool
== CombIx
r2

instance Ord RComb where
  compare :: RComb -> RComb -> Ordering
compare (RComb CombIx
r1 GComb RComb
_) (RComb CombIx
r2 GComb RComb
_) = CombIx -> CombIx -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CombIx
r1 CombIx
r2

-- | Convert an RComb to a Comb by forgetting the sections and keeping only the CombIx.
rCombToComb :: RComb -> Comb
rCombToComb :: RComb -> Comb
rCombToComb (RComb CombIx
_ix GComb RComb
c) = RComb -> CombIx
rCombIx (RComb -> CombIx) -> GComb RComb -> Comb
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GComb RComb
c

-- | RCombs can be infinitely recursive so we show the CombIx instead.
instance Show RComb where
  show :: RComb -> [Char]
show (RComb CombIx
ix GComb RComb
_) = CombIx -> [Char]
forall a. Show a => a -> [Char]
show CombIx
ix

-- | Map of combinators, parameterized by comb reference type
type GCombs comb = EnumMap Word64 (GComb comb)

-- | A reference to a combinator, parameterized by comb
type Ref = GRef CombIx

type RRef = GRef RComb

data GRef comb
  = Stk !Int -- stack reference to a closure
  | Env !comb -- direct reference to comb, usually embedded as an RComb
  | Dyn !Word64 -- dynamic scope reference to a closure
  deriving (Int -> GRef comb -> ShowS
[GRef comb] -> ShowS
GRef comb -> [Char]
(Int -> GRef comb -> ShowS)
-> (GRef comb -> [Char])
-> ([GRef comb] -> ShowS)
-> Show (GRef comb)
forall comb. Show comb => Int -> GRef comb -> ShowS
forall comb. Show comb => [GRef comb] -> ShowS
forall comb. Show comb => GRef comb -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall comb. Show comb => Int -> GRef comb -> ShowS
showsPrec :: Int -> GRef comb -> ShowS
$cshow :: forall comb. Show comb => GRef comb -> [Char]
show :: GRef comb -> [Char]
$cshowList :: forall comb. Show comb => [GRef comb] -> ShowS
showList :: [GRef comb] -> ShowS
Show, GRef comb -> GRef comb -> Bool
(GRef comb -> GRef comb -> Bool)
-> (GRef comb -> GRef comb -> Bool) -> Eq (GRef comb)
forall comb. Eq comb => GRef comb -> GRef comb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall comb. Eq comb => GRef comb -> GRef comb -> Bool
== :: GRef comb -> GRef comb -> Bool
$c/= :: forall comb. Eq comb => GRef comb -> GRef comb -> Bool
/= :: GRef comb -> GRef comb -> Bool
Eq, Eq (GRef comb)
Eq (GRef comb) =>
(GRef comb -> GRef comb -> Ordering)
-> (GRef comb -> GRef comb -> Bool)
-> (GRef comb -> GRef comb -> Bool)
-> (GRef comb -> GRef comb -> Bool)
-> (GRef comb -> GRef comb -> Bool)
-> (GRef comb -> GRef comb -> GRef comb)
-> (GRef comb -> GRef comb -> GRef comb)
-> Ord (GRef comb)
GRef comb -> GRef comb -> Bool
GRef comb -> GRef comb -> Ordering
GRef comb -> GRef comb -> GRef comb
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall comb. Ord comb => Eq (GRef comb)
forall comb. Ord comb => GRef comb -> GRef comb -> Bool
forall comb. Ord comb => GRef comb -> GRef comb -> Ordering
forall comb. Ord comb => GRef comb -> GRef comb -> GRef comb
$ccompare :: forall comb. Ord comb => GRef comb -> GRef comb -> Ordering
compare :: GRef comb -> GRef comb -> Ordering
$c< :: forall comb. Ord comb => GRef comb -> GRef comb -> Bool
< :: GRef comb -> GRef comb -> Bool
$c<= :: forall comb. Ord comb => GRef comb -> GRef comb -> Bool
<= :: GRef comb -> GRef comb -> Bool
$c> :: forall comb. Ord comb => GRef comb -> GRef comb -> Bool
> :: GRef comb -> GRef comb -> Bool
$c>= :: forall comb. Ord comb => GRef comb -> GRef comb -> Bool
>= :: GRef comb -> GRef comb -> Bool
$cmax :: forall comb. Ord comb => GRef comb -> GRef comb -> GRef comb
max :: GRef comb -> GRef comb -> GRef comb
$cmin :: forall comb. Ord comb => GRef comb -> GRef comb -> GRef comb
min :: GRef comb -> GRef comb -> GRef comb
Ord, (forall a b. (a -> b) -> GRef a -> GRef b)
-> (forall a b. a -> GRef b -> GRef a) -> Functor GRef
forall a b. a -> GRef b -> GRef a
forall a b. (a -> b) -> GRef a -> GRef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GRef a -> GRef b
fmap :: forall a b. (a -> b) -> GRef a -> GRef b
$c<$ :: forall a b. a -> GRef b -> GRef a
<$ :: forall a b. a -> GRef b -> GRef a
Functor, (forall m. Monoid m => GRef m -> m)
-> (forall m a. Monoid m => (a -> m) -> GRef a -> m)
-> (forall m a. Monoid m => (a -> m) -> GRef a -> m)
-> (forall a b. (a -> b -> b) -> b -> GRef a -> b)
-> (forall a b. (a -> b -> b) -> b -> GRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> GRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> GRef a -> b)
-> (forall a. (a -> a -> a) -> GRef a -> a)
-> (forall a. (a -> a -> a) -> GRef a -> a)
-> (forall a. GRef a -> [a])
-> (forall a. GRef a -> Bool)
-> (forall a. GRef a -> Int)
-> (forall a. Eq a => a -> GRef a -> Bool)
-> (forall a. Ord a => GRef a -> a)
-> (forall a. Ord a => GRef a -> a)
-> (forall a. Num a => GRef a -> a)
-> (forall a. Num a => GRef a -> a)
-> Foldable GRef
forall a. Eq a => a -> GRef a -> Bool
forall a. Num a => GRef a -> a
forall a. Ord a => GRef a -> a
forall m. Monoid m => GRef m -> m
forall a. GRef a -> Bool
forall a. GRef a -> Int
forall a. GRef a -> [a]
forall a. (a -> a -> a) -> GRef a -> a
forall m a. Monoid m => (a -> m) -> GRef a -> m
forall b a. (b -> a -> b) -> b -> GRef a -> b
forall a b. (a -> b -> b) -> b -> GRef a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GRef m -> m
fold :: forall m. Monoid m => GRef m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GRef a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GRef a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GRef a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GRef a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GRef a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GRef a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GRef a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GRef a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GRef a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GRef a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GRef a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GRef a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GRef a -> a
foldr1 :: forall a. (a -> a -> a) -> GRef a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GRef a -> a
foldl1 :: forall a. (a -> a -> a) -> GRef a -> a
$ctoList :: forall a. GRef a -> [a]
toList :: forall a. GRef a -> [a]
$cnull :: forall a. GRef a -> Bool
null :: forall a. GRef a -> Bool
$clength :: forall a. GRef a -> Int
length :: forall a. GRef a -> Int
$celem :: forall a. Eq a => a -> GRef a -> Bool
elem :: forall a. Eq a => a -> GRef a -> Bool
$cmaximum :: forall a. Ord a => GRef a -> a
maximum :: forall a. Ord a => GRef a -> a
$cminimum :: forall a. Ord a => GRef a -> a
minimum :: forall a. Ord a => GRef a -> a
$csum :: forall a. Num a => GRef a -> a
sum :: forall a. Num a => GRef a -> a
$cproduct :: forall a. Num a => GRef a -> a
product :: forall a. Num a => GRef a -> a
Foldable, Functor GRef
Foldable GRef
(Functor GRef, Foldable GRef) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> GRef a -> f (GRef b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GRef (f a) -> f (GRef a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GRef a -> m (GRef b))
-> (forall (m :: * -> *) a. Monad m => GRef (m a) -> m (GRef a))
-> Traversable GRef
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GRef (m a) -> m (GRef a)
forall (f :: * -> *) a. Applicative f => GRef (f a) -> f (GRef a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRef a -> m (GRef b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRef a -> f (GRef b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRef a -> f (GRef b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRef a -> f (GRef b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => GRef (f a) -> f (GRef a)
sequenceA :: forall (f :: * -> *) a. Applicative f => GRef (f a) -> f (GRef a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRef a -> m (GRef b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRef a -> m (GRef b)
$csequence :: forall (m :: * -> *) a. Monad m => GRef (m a) -> m (GRef a)
sequence :: forall (m :: * -> *) a. Monad m => GRef (m a) -> m (GRef a)
Traversable)

type Branch = GBranch CombIx

type RBranch = GBranch RComb

data GBranch comb
  = -- if tag == n then t else f
    Test1
      !Word64
      !(GSection comb)
      !(GSection comb)
  | Test2
      !Word64
      !(GSection comb) -- if tag == m then ...
      !Word64
      !(GSection comb) -- else if tag == n then ...
      !(GSection comb) -- else ...
  | TestW
      !(GSection comb)
      !(EnumMap Word64 (GSection comb))
  | TestT
      !(GSection comb)
      !(M.Map Text (GSection comb))
  deriving stock (Int -> GBranch comb -> ShowS
[GBranch comb] -> ShowS
GBranch comb -> [Char]
(Int -> GBranch comb -> ShowS)
-> (GBranch comb -> [Char])
-> ([GBranch comb] -> ShowS)
-> Show (GBranch comb)
forall comb. Show comb => Int -> GBranch comb -> ShowS
forall comb. Show comb => [GBranch comb] -> ShowS
forall comb. Show comb => GBranch comb -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall comb. Show comb => Int -> GBranch comb -> ShowS
showsPrec :: Int -> GBranch comb -> ShowS
$cshow :: forall comb. Show comb => GBranch comb -> [Char]
show :: GBranch comb -> [Char]
$cshowList :: forall comb. Show comb => [GBranch comb] -> ShowS
showList :: [GBranch comb] -> ShowS
Show, GBranch comb -> GBranch comb -> Bool
(GBranch comb -> GBranch comb -> Bool)
-> (GBranch comb -> GBranch comb -> Bool) -> Eq (GBranch comb)
forall comb. Eq comb => GBranch comb -> GBranch comb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall comb. Eq comb => GBranch comb -> GBranch comb -> Bool
== :: GBranch comb -> GBranch comb -> Bool
$c/= :: forall comb. Eq comb => GBranch comb -> GBranch comb -> Bool
/= :: GBranch comb -> GBranch comb -> Bool
Eq, Eq (GBranch comb)
Eq (GBranch comb) =>
(GBranch comb -> GBranch comb -> Ordering)
-> (GBranch comb -> GBranch comb -> Bool)
-> (GBranch comb -> GBranch comb -> Bool)
-> (GBranch comb -> GBranch comb -> Bool)
-> (GBranch comb -> GBranch comb -> Bool)
-> (GBranch comb -> GBranch comb -> GBranch comb)
-> (GBranch comb -> GBranch comb -> GBranch comb)
-> Ord (GBranch comb)
GBranch comb -> GBranch comb -> Bool
GBranch comb -> GBranch comb -> Ordering
GBranch comb -> GBranch comb -> GBranch comb
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall comb. Ord comb => Eq (GBranch comb)
forall comb. Ord comb => GBranch comb -> GBranch comb -> Bool
forall comb. Ord comb => GBranch comb -> GBranch comb -> Ordering
forall comb.
Ord comb =>
GBranch comb -> GBranch comb -> GBranch comb
$ccompare :: forall comb. Ord comb => GBranch comb -> GBranch comb -> Ordering
compare :: GBranch comb -> GBranch comb -> Ordering
$c< :: forall comb. Ord comb => GBranch comb -> GBranch comb -> Bool
< :: GBranch comb -> GBranch comb -> Bool
$c<= :: forall comb. Ord comb => GBranch comb -> GBranch comb -> Bool
<= :: GBranch comb -> GBranch comb -> Bool
$c> :: forall comb. Ord comb => GBranch comb -> GBranch comb -> Bool
> :: GBranch comb -> GBranch comb -> Bool
$c>= :: forall comb. Ord comb => GBranch comb -> GBranch comb -> Bool
>= :: GBranch comb -> GBranch comb -> Bool
$cmax :: forall comb.
Ord comb =>
GBranch comb -> GBranch comb -> GBranch comb
max :: GBranch comb -> GBranch comb -> GBranch comb
$cmin :: forall comb.
Ord comb =>
GBranch comb -> GBranch comb -> GBranch comb
min :: GBranch comb -> GBranch comb -> GBranch comb
Ord, (forall a b. (a -> b) -> GBranch a -> GBranch b)
-> (forall a b. a -> GBranch b -> GBranch a) -> Functor GBranch
forall a b. a -> GBranch b -> GBranch a
forall a b. (a -> b) -> GBranch a -> GBranch b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GBranch a -> GBranch b
fmap :: forall a b. (a -> b) -> GBranch a -> GBranch b
$c<$ :: forall a b. a -> GBranch b -> GBranch a
<$ :: forall a b. a -> GBranch b -> GBranch a
Functor, (forall m. Monoid m => GBranch m -> m)
-> (forall m a. Monoid m => (a -> m) -> GBranch a -> m)
-> (forall m a. Monoid m => (a -> m) -> GBranch a -> m)
-> (forall a b. (a -> b -> b) -> b -> GBranch a -> b)
-> (forall a b. (a -> b -> b) -> b -> GBranch a -> b)
-> (forall b a. (b -> a -> b) -> b -> GBranch a -> b)
-> (forall b a. (b -> a -> b) -> b -> GBranch a -> b)
-> (forall a. (a -> a -> a) -> GBranch a -> a)
-> (forall a. (a -> a -> a) -> GBranch a -> a)
-> (forall a. GBranch a -> [a])
-> (forall a. GBranch a -> Bool)
-> (forall a. GBranch a -> Int)
-> (forall a. Eq a => a -> GBranch a -> Bool)
-> (forall a. Ord a => GBranch a -> a)
-> (forall a. Ord a => GBranch a -> a)
-> (forall a. Num a => GBranch a -> a)
-> (forall a. Num a => GBranch a -> a)
-> Foldable GBranch
forall a. Eq a => a -> GBranch a -> Bool
forall a. Num a => GBranch a -> a
forall a. Ord a => GBranch a -> a
forall m. Monoid m => GBranch m -> m
forall a. GBranch a -> Bool
forall a. GBranch a -> Int
forall a. GBranch a -> [a]
forall a. (a -> a -> a) -> GBranch a -> a
forall m a. Monoid m => (a -> m) -> GBranch a -> m
forall b a. (b -> a -> b) -> b -> GBranch a -> b
forall a b. (a -> b -> b) -> b -> GBranch a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GBranch m -> m
fold :: forall m. Monoid m => GBranch m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GBranch a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GBranch a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GBranch a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GBranch a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GBranch a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GBranch a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GBranch a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GBranch a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GBranch a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GBranch a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GBranch a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GBranch a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GBranch a -> a
foldr1 :: forall a. (a -> a -> a) -> GBranch a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GBranch a -> a
foldl1 :: forall a. (a -> a -> a) -> GBranch a -> a
$ctoList :: forall a. GBranch a -> [a]
toList :: forall a. GBranch a -> [a]
$cnull :: forall a. GBranch a -> Bool
null :: forall a. GBranch a -> Bool
$clength :: forall a. GBranch a -> Int
length :: forall a. GBranch a -> Int
$celem :: forall a. Eq a => a -> GBranch a -> Bool
elem :: forall a. Eq a => a -> GBranch a -> Bool
$cmaximum :: forall a. Ord a => GBranch a -> a
maximum :: forall a. Ord a => GBranch a -> a
$cminimum :: forall a. Ord a => GBranch a -> a
minimum :: forall a. Ord a => GBranch a -> a
$csum :: forall a. Num a => GBranch a -> a
sum :: forall a. Num a => GBranch a -> a
$cproduct :: forall a. Num a => GBranch a -> a
product :: forall a. Num a => GBranch a -> a
Foldable, Functor GBranch
Foldable GBranch
(Functor GBranch, Foldable GBranch) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> GBranch a -> f (GBranch b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GBranch (f a) -> f (GBranch a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GBranch a -> m (GBranch b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GBranch (m a) -> m (GBranch a))
-> Traversable GBranch
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GBranch (m a) -> m (GBranch a)
forall (f :: * -> *) a.
Applicative f =>
GBranch (f a) -> f (GBranch a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GBranch a -> m (GBranch b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GBranch a -> f (GBranch b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GBranch a -> f (GBranch b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GBranch a -> f (GBranch b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GBranch (f a) -> f (GBranch a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GBranch (f a) -> f (GBranch a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GBranch a -> m (GBranch b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GBranch a -> m (GBranch b)
$csequence :: forall (m :: * -> *) a. Monad m => GBranch (m a) -> m (GBranch a)
sequence :: forall (m :: * -> *) a. Monad m => GBranch (m a) -> m (GBranch a)
Traversable)

-- Convenience patterns for matches used in the algorithms below.
pattern MatchW :: Int -> (GSection comb) -> EnumMap Word64 (GSection comb) -> (GSection comb)
pattern $mMatchW :: forall {r} {comb}.
GSection comb
-> (Int -> GSection comb -> EnumMap Word64 (GSection comb) -> r)
-> ((# #) -> r)
-> r
$bMatchW :: forall comb.
Int
-> GSection comb -> EnumMap Word64 (GSection comb) -> GSection comb
MatchW i d cs = Match i (TestW d cs)

pattern MatchT :: Int -> (GSection comb) -> M.Map Text (GSection comb) -> (GSection comb)
pattern $mMatchT :: forall {r} {comb}.
GSection comb
-> (Int -> GSection comb -> Map Text (GSection comb) -> r)
-> ((# #) -> r)
-> r
$bMatchT :: forall comb.
Int -> GSection comb -> Map Text (GSection comb) -> GSection comb
MatchT i d cs = Match i (TestT d cs)

pattern NMatchW ::
  Maybe Reference -> Int -> (GSection comb) -> EnumMap Word64 (GSection comb) -> (GSection comb)
pattern $mNMatchW :: forall {r} {comb}.
GSection comb
-> (Maybe Reference
    -> Int -> GSection comb -> EnumMap Word64 (GSection comb) -> r)
-> ((# #) -> r)
-> r
$bNMatchW :: forall comb.
Maybe Reference
-> Int
-> GSection comb
-> EnumMap Word64 (GSection comb)
-> GSection comb
NMatchW r i d cs = NMatch r i (TestW d cs)

-- Representation of the variable context available in the current
-- frame. This tracks tags that have been dumped to the stack for
-- proper indexing. The `Block` constructor is used to mark when we
-- go into the first portion of a `Let`, to track the size of that
-- sub-frame.
data Ctx v
  = ECtx
  | Block (Ctx v)
  | Tag (Ctx v)
  | Var v Mem (Ctx v)
  deriving (Int -> Ctx v -> ShowS
[Ctx v] -> ShowS
Ctx v -> [Char]
(Int -> Ctx v -> ShowS)
-> (Ctx v -> [Char]) -> ([Ctx v] -> ShowS) -> Show (Ctx v)
forall v. Show v => Int -> Ctx v -> ShowS
forall v. Show v => [Ctx v] -> ShowS
forall v. Show v => Ctx v -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Ctx v -> ShowS
showsPrec :: Int -> Ctx v -> ShowS
$cshow :: forall v. Show v => Ctx v -> [Char]
show :: Ctx v -> [Char]
$cshowList :: forall v. Show v => [Ctx v] -> ShowS
showList :: [Ctx v] -> ShowS
Show)

-- Represents the context formed by the top-level let rec around a
-- set of definitions. Previous steps have normalized the term to
-- only contain a single recursive binding group. The variables in
-- this binding group are resolved to numbered combinators rather
-- than stack positions.
type RCtx v = M.Map v Word64

-- Add a sequence of variables and corresponding calling conventions
-- to the context.
ctx :: [v] -> [Mem] -> Ctx v
ctx :: forall v. [v] -> [Mem] -> Ctx v
ctx [v]
vs [Mem]
cs = [(v, Mem)] -> Ctx v -> Ctx v
forall v. [(v, Mem)] -> Ctx v -> Ctx v
pushCtx ([v] -> [Mem] -> [(v, Mem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs [Mem]
cs) Ctx v
forall v. Ctx v
ECtx

-- Look up a variable in the context, getting its position on the
-- relevant stack and its calling convention if it is there.
ctxResolve :: (Var v) => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve :: forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v = Int -> Int -> Ctx v -> Maybe (Int, Mem)
walk Int
0 Int
0 Ctx v
ctx
  where
    walk :: Int -> Int -> Ctx v -> Maybe (Int, Mem)
walk Int
_ Int
_ Ctx v
ECtx = Maybe (Int, Mem)
forall a. Maybe a
Nothing
    walk Int
ui Int
bi (Block Ctx v
ctx) = Int -> Int -> Ctx v -> Maybe (Int, Mem)
walk Int
ui Int
bi Ctx v
ctx
    walk Int
ui Int
bi (Tag Ctx v
ctx) = Int -> Int -> Ctx v -> Maybe (Int, Mem)
walk (Int
ui Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
bi Ctx v
ctx
    walk Int
ui Int
bi (Var v
x Mem
m Ctx v
ctx)
      | v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
x = case Mem
m of Mem
BX -> (Int, Mem) -> Maybe (Int, Mem)
forall a. a -> Maybe a
Just (Int
bi, Mem
m); Mem
UN -> (Int, Mem) -> Maybe (Int, Mem)
forall a. a -> Maybe a
Just (Int
ui, Mem
m)
      | Bool
otherwise = Int -> Int -> Ctx v -> Maybe (Int, Mem)
walk Int
ui' Int
bi' Ctx v
ctx
      where
        (Int
ui', Int
bi') = case Mem
m of Mem
BX -> (Int
ui, Int
bi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1); Mem
UN -> (Int
ui Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
bi)

-- Add a sequence of variables and calling conventions to the context.
pushCtx :: [(v, Mem)] -> Ctx v -> Ctx v
pushCtx :: forall v. [(v, Mem)] -> Ctx v -> Ctx v
pushCtx [(v, Mem)]
new Ctx v
old = ((v, Mem) -> Ctx v -> Ctx v) -> Ctx v -> [(v, Mem)] -> Ctx v
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((v -> Mem -> Ctx v -> Ctx v) -> (v, Mem) -> Ctx v -> Ctx v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var) Ctx v
old [(v, Mem)]
new

-- Concatenate two contexts
catCtx :: Ctx v -> Ctx v -> Ctx v
catCtx :: forall v. Ctx v -> Ctx v -> Ctx v
catCtx Ctx v
ECtx Ctx v
r = Ctx v
r
catCtx (Tag Ctx v
l) Ctx v
r = Ctx v -> Ctx v
forall v. Ctx v -> Ctx v
Tag (Ctx v -> Ctx v) -> Ctx v -> Ctx v
forall a b. (a -> b) -> a -> b
$ Ctx v -> Ctx v -> Ctx v
forall v. Ctx v -> Ctx v -> Ctx v
catCtx Ctx v
l Ctx v
r
catCtx (Block Ctx v
l) Ctx v
r = Ctx v -> Ctx v
forall v. Ctx v -> Ctx v
Block (Ctx v -> Ctx v) -> Ctx v -> Ctx v
forall a b. (a -> b) -> a -> b
$ Ctx v -> Ctx v -> Ctx v
forall v. Ctx v -> Ctx v -> Ctx v
catCtx Ctx v
l Ctx v
r
catCtx (Var v
v Mem
m Ctx v
l) Ctx v
r = v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
v Mem
m (Ctx v -> Ctx v) -> Ctx v -> Ctx v
forall a b. (a -> b) -> a -> b
$ Ctx v -> Ctx v -> Ctx v
forall v. Ctx v -> Ctx v -> Ctx v
catCtx Ctx v
l Ctx v
r

-- Split the context after a particular variable
breakAfter :: (Eq v) => (v -> Bool) -> Ctx v -> (Ctx v, Ctx v)
breakAfter :: forall v. Eq v => (v -> Bool) -> Ctx v -> (Ctx v, Ctx v)
breakAfter v -> Bool
_ Ctx v
ECtx = (Ctx v
forall v. Ctx v
ECtx, Ctx v
forall v. Ctx v
ECtx)
breakAfter v -> Bool
p (Tag Ctx v
vs) = (Ctx v -> Ctx v) -> (Ctx v, Ctx v) -> (Ctx v, Ctx v)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Ctx v -> Ctx v
forall v. Ctx v -> Ctx v
Tag ((Ctx v, Ctx v) -> (Ctx v, Ctx v))
-> (Ctx v, Ctx v) -> (Ctx v, Ctx v)
forall a b. (a -> b) -> a -> b
$ (v -> Bool) -> Ctx v -> (Ctx v, Ctx v)
forall v. Eq v => (v -> Bool) -> Ctx v -> (Ctx v, Ctx v)
breakAfter v -> Bool
p Ctx v
vs
breakAfter v -> Bool
p (Block Ctx v
vs) = (Ctx v -> Ctx v) -> (Ctx v, Ctx v) -> (Ctx v, Ctx v)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Ctx v -> Ctx v
forall v. Ctx v -> Ctx v
Block ((Ctx v, Ctx v) -> (Ctx v, Ctx v))
-> (Ctx v, Ctx v) -> (Ctx v, Ctx v)
forall a b. (a -> b) -> a -> b
$ (v -> Bool) -> Ctx v -> (Ctx v, Ctx v)
forall v. Eq v => (v -> Bool) -> Ctx v -> (Ctx v, Ctx v)
breakAfter v -> Bool
p Ctx v
vs
breakAfter v -> Bool
p (Var v
v Mem
m Ctx v
vs) = (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
v Mem
m Ctx v
lvs, Ctx v
rvs)
  where
    (Ctx v
lvs, Ctx v
rvs)
      | v -> Bool
p v
v = (Ctx v
forall v. Ctx v
ECtx, Ctx v
vs)
      | Bool
otherwise = (v -> Bool) -> Ctx v -> (Ctx v, Ctx v)
forall v. Eq v => (v -> Bool) -> Ctx v -> (Ctx v, Ctx v)
breakAfter v -> Bool
p Ctx v
vs

-- Modify the context to contain the variables introduced by an
-- unboxed sum
sumCtx :: (Var v) => Ctx v -> v -> [(v, Mem)] -> Ctx v
sumCtx :: forall v. Var v => Ctx v -> v -> [(v, Mem)] -> Ctx v
sumCtx Ctx v
ctx v
v [(v, Mem)]
vcs
  | (Ctx v
lctx, Ctx v
rctx) <- (v -> Bool) -> Ctx v -> (Ctx v, Ctx v)
forall v. Eq v => (v -> Bool) -> Ctx v -> (Ctx v, Ctx v)
breakAfter (v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v) Ctx v
ctx =
      Ctx v -> Ctx v -> Ctx v
forall v. Ctx v -> Ctx v -> Ctx v
catCtx Ctx v
lctx (Ctx v -> Ctx v) -> Ctx v -> Ctx v
forall a b. (a -> b) -> a -> b
$ [(v, Mem)] -> Ctx v -> Ctx v
forall v. [(v, Mem)] -> Ctx v -> Ctx v
pushCtx [(v, Mem)]
vcs Ctx v
rctx

-- Look up a variable in the top let rec context
rctxResolve :: (Var v) => RCtx v -> v -> Maybe Word64
rctxResolve :: forall v. Var v => RCtx v -> v -> Maybe Word64
rctxResolve RCtx v
ctx v
u = v -> RCtx v -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup v
u RCtx v
ctx

-- Compile a top-level definition group to a collection of combinators.
-- The provided word refers to the numbering for the overall group,
-- and intra-group calls are numbered locally, with 0 specifying
-- the global entry point.
emitCombs ::
  (Var v) =>
  RefNums ->
  Reference ->
  Word64 ->
  SuperGroup v ->
  EnumMap Word64 Comb
emitCombs :: forall v.
Var v =>
RefNums
-> Reference -> Word64 -> SuperGroup v -> EnumMap Word64 Comb
emitCombs RefNums
rns Reference
grpr Word64
grpn (Rec [(v, SuperNormal v)]
grp SuperNormal v
ent) =
  RefNums
-> Reference
-> Word64
-> RCtx v
-> (Word64, SuperNormal v)
-> EnumMap Word64 Comb
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> (Word64, SuperNormal v)
-> EnumMap Word64 Comb
emitComb RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (Word64
0, SuperNormal v
ent) EnumMap Word64 Comb -> EnumMap Word64 Comb -> EnumMap Word64 Comb
forall a. Semigroup a => a -> a -> a
<> EnumMap Word64 Comb
aux
  where
    ([v]
rvs, [SuperNormal v]
cmbs) = [(v, SuperNormal v)] -> ([v], [SuperNormal v])
forall a b. [(a, b)] -> ([a], [b])
unzip [(v, SuperNormal v)]
grp
    ixs :: [Word64]
ixs = (Word64 -> Word64) -> [Word64] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) [Word64
1 ..]
    rec :: RCtx v
rec = [(v, Word64)] -> RCtx v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(v, Word64)] -> RCtx v) -> [(v, Word64)] -> RCtx v
forall a b. (a -> b) -> a -> b
$ [v] -> [Word64] -> [(v, Word64)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
rvs [Word64]
ixs
    aux :: EnumMap Word64 Comb
aux = ((Word64, SuperNormal v) -> EnumMap Word64 Comb)
-> [(Word64, SuperNormal v)] -> EnumMap Word64 Comb
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (RefNums
-> Reference
-> Word64
-> RCtx v
-> (Word64, SuperNormal v)
-> EnumMap Word64 Comb
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> (Word64, SuperNormal v)
-> EnumMap Word64 Comb
emitComb RefNums
rns Reference
grpr Word64
grpn RCtx v
rec) ([Word64] -> [SuperNormal v] -> [(Word64, SuperNormal v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64]
ixs [SuperNormal v]
cmbs)

-- | lazily replace all references to combinators with the combinators themselves,
-- tying the knot recursively when necessary.
resolveCombs ::
  -- Existing in-scope combs that might be referenced
  -- TODO: Do we ever actually need to pass this?
  Maybe (EnumMap Word64 RCombs) ->
  -- Combinators which need their knots tied.
  EnumMap Word64 Combs ->
  EnumMap Word64 RCombs
resolveCombs :: Maybe (EnumMap Word64 RCombs)
-> EnumMap Word64 (EnumMap Word64 Comb) -> EnumMap Word64 RCombs
resolveCombs Maybe (EnumMap Word64 RCombs)
mayExisting EnumMap Word64 (EnumMap Word64 Comb)
combs =
  -- Fixed point lookup;
  -- We make sure not to force resolved Combs or we'll loop forever.
  let ~EnumMap Word64 RCombs
resolved =
        EnumMap Word64 (EnumMap Word64 Comb)
combs
          EnumMap Word64 (EnumMap Word64 Comb)
-> (EnumMap Word64 Comb -> RCombs) -> EnumMap Word64 RCombs
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Comb -> GComb RComb) -> EnumMap Word64 Comb -> RCombs
forall a b. (a -> b) -> EnumMap Word64 a -> EnumMap Word64 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Comb -> GComb RComb) -> EnumMap Word64 Comb -> RCombs)
-> ((CombIx -> RComb) -> Comb -> GComb RComb)
-> (CombIx -> RComb)
-> EnumMap Word64 Comb
-> RCombs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CombIx -> RComb) -> Comb -> GComb RComb
forall a b. (a -> b) -> GComb a -> GComb b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) \(cix :: CombIx
cix@(CIx Reference
_ Word64
n Word64
i)) ->
            let cmbs :: RCombs
cmbs = case Maybe (EnumMap Word64 RCombs)
mayExisting Maybe (EnumMap Word64 RCombs)
-> (EnumMap Word64 RCombs -> Maybe RCombs) -> Maybe RCombs
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word64 -> EnumMap Word64 RCombs -> Maybe RCombs
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
n of
                  Just RCombs
cmbs -> RCombs
cmbs
                  Maybe RCombs
Nothing ->
                    case Word64 -> EnumMap Word64 RCombs -> Maybe RCombs
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
n EnumMap Word64 RCombs
resolved of
                      Just RCombs
cmbs -> RCombs
cmbs
                      Maybe RCombs
Nothing -> [Char] -> RCombs
forall a. HasCallStack => [Char] -> a
error ([Char] -> RCombs) -> [Char] -> RCombs
forall a b. (a -> b) -> a -> b
$ [Char]
"unknown combinator `" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"`."
             in case Word64 -> RCombs -> Maybe (GComb RComb)
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
i RCombs
cmbs of
                  Just GComb RComb
cmb -> CombIx -> GComb RComb -> RComb
RComb CombIx
cix GComb RComb
cmb
                  Maybe (GComb RComb)
Nothing ->
                    [Char] -> RComb
forall a. HasCallStack => [Char] -> a
error ([Char] -> RComb) -> [Char] -> RComb
forall a b. (a -> b) -> a -> b
$
                      [Char]
"unknown section `"
                        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
i
                        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"` of combinator `"
                        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
n
                        [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"`."
   in EnumMap Word64 RCombs
resolved

-- Type for aggregating the necessary stack frame size. First field is
-- unboxed size, second is boxed. The Applicative instance takes the
-- point-wise maximum, so that combining values from different branches
-- results in finding the maximum value of either size necessary.
data Counted a = C !Int !Int a
  deriving ((forall a b. (a -> b) -> Counted a -> Counted b)
-> (forall a b. a -> Counted b -> Counted a) -> Functor Counted
forall a b. a -> Counted b -> Counted a
forall a b. (a -> b) -> Counted a -> Counted b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Counted a -> Counted b
fmap :: forall a b. (a -> b) -> Counted a -> Counted b
$c<$ :: forall a b. a -> Counted b -> Counted a
<$ :: forall a b. a -> Counted b -> Counted a
Functor)

instance Applicative Counted where
  pure :: forall a. a -> Counted a
pure = Int -> Int -> a -> Counted a
forall a. Int -> Int -> a -> Counted a
C Int
0 Int
0
  C Int
u0 Int
b0 a -> b
f <*> :: forall a b. Counted (a -> b) -> Counted a -> Counted b
<*> C Int
u1 Int
b1 a
x = Int -> Int -> b -> Counted b
forall a. Int -> Int -> a -> Counted a
C (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
u0 Int
u1) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
b0 Int
b1) (a -> b
f a
x)

newtype Emit a
  = EM (Word64 -> (EC.EnumMap Word64 Comb, Counted a))
  deriving ((forall a b. (a -> b) -> Emit a -> Emit b)
-> (forall a b. a -> Emit b -> Emit a) -> Functor Emit
forall a b. a -> Emit b -> Emit a
forall a b. (a -> b) -> Emit a -> Emit b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Emit a -> Emit b
fmap :: forall a b. (a -> b) -> Emit a -> Emit b
$c<$ :: forall a b. a -> Emit b -> Emit a
<$ :: forall a b. a -> Emit b -> Emit a
Functor)

runEmit :: Word64 -> Emit a -> EC.EnumMap Word64 Comb
runEmit :: forall a. Word64 -> Emit a -> EnumMap Word64 Comb
runEmit Word64
w (EM Word64 -> (EnumMap Word64 Comb, Counted a)
e) = (EnumMap Word64 Comb, Counted a) -> EnumMap Word64 Comb
forall a b. (a, b) -> a
fst ((EnumMap Word64 Comb, Counted a) -> EnumMap Word64 Comb)
-> (EnumMap Word64 Comb, Counted a) -> EnumMap Word64 Comb
forall a b. (a -> b) -> a -> b
$ Word64 -> (EnumMap Word64 Comb, Counted a)
e Word64
w

instance Applicative Emit where
  pure :: forall a. a -> Emit a
pure = (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a)
-> (a -> Word64 -> (EnumMap Word64 Comb, Counted a)) -> a -> Emit a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap Word64 Comb, Counted a)
-> Word64 -> (EnumMap Word64 Comb, Counted a)
forall a. a -> Word64 -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((EnumMap Word64 Comb, Counted a)
 -> Word64 -> (EnumMap Word64 Comb, Counted a))
-> (a -> (EnumMap Word64 Comb, Counted a))
-> a
-> Word64
-> (EnumMap Word64 Comb, Counted a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Counted a -> (EnumMap Word64 Comb, Counted a)
forall a. a -> (EnumMap Word64 Comb, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Counted a -> (EnumMap Word64 Comb, Counted a))
-> (a -> Counted a) -> a -> (EnumMap Word64 Comb, Counted a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Counted a
forall a. a -> Counted a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  EM Word64 -> (EnumMap Word64 Comb, Counted (a -> b))
ef <*> :: forall a b. Emit (a -> b) -> Emit a -> Emit b
<*> EM Word64 -> (EnumMap Word64 Comb, Counted a)
ex = (Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b)
-> (Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b
forall a b. (a -> b) -> a -> b
$ (((EnumMap Word64 Comb, Counted (a -> b))
 -> (EnumMap Word64 Comb, Counted a)
 -> (EnumMap Word64 Comb, Counted b))
-> (Word64 -> (EnumMap Word64 Comb, Counted (a -> b)))
-> (Word64 -> (EnumMap Word64 Comb, Counted a))
-> Word64
-> (EnumMap Word64 Comb, Counted b)
forall a b c.
(a -> b -> c) -> (Word64 -> a) -> (Word64 -> b) -> Word64 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (((EnumMap Word64 Comb, Counted (a -> b))
  -> (EnumMap Word64 Comb, Counted a)
  -> (EnumMap Word64 Comb, Counted b))
 -> (Word64 -> (EnumMap Word64 Comb, Counted (a -> b)))
 -> (Word64 -> (EnumMap Word64 Comb, Counted a))
 -> Word64
 -> (EnumMap Word64 Comb, Counted b))
-> ((Counted (a -> b) -> Counted a -> Counted b)
    -> (EnumMap Word64 Comb, Counted (a -> b))
    -> (EnumMap Word64 Comb, Counted a)
    -> (EnumMap Word64 Comb, Counted b))
-> (Counted (a -> b) -> Counted a -> Counted b)
-> (Word64 -> (EnumMap Word64 Comb, Counted (a -> b)))
-> (Word64 -> (EnumMap Word64 Comb, Counted a))
-> Word64
-> (EnumMap Word64 Comb, Counted b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Counted (a -> b) -> Counted a -> Counted b)
-> (EnumMap Word64 Comb, Counted (a -> b))
-> (EnumMap Word64 Comb, Counted a)
-> (EnumMap Word64 Comb, Counted b)
forall a b c.
(a -> b -> c)
-> (EnumMap Word64 Comb, a)
-> (EnumMap Word64 Comb, b)
-> (EnumMap Word64 Comb, c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2) Counted (a -> b) -> Counted a -> Counted b
forall a b. Counted (a -> b) -> Counted a -> Counted b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) Word64 -> (EnumMap Word64 Comb, Counted (a -> b))
ef Word64 -> (EnumMap Word64 Comb, Counted a)
ex

counted :: Counted a -> Emit a
counted :: forall a. Counted a -> Emit a
counted = (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a)
-> (Counted a -> Word64 -> (EnumMap Word64 Comb, Counted a))
-> Counted a
-> Emit a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap Word64 Comb, Counted a)
-> Word64 -> (EnumMap Word64 Comb, Counted a)
forall a. a -> Word64 -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((EnumMap Word64 Comb, Counted a)
 -> Word64 -> (EnumMap Word64 Comb, Counted a))
-> (Counted a -> (EnumMap Word64 Comb, Counted a))
-> Counted a
-> Word64
-> (EnumMap Word64 Comb, Counted a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Counted a -> (EnumMap Word64 Comb, Counted a)
forall a. a -> (EnumMap Word64 Comb, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

onCount :: (Counted a -> Counted b) -> Emit a -> Emit b
onCount :: forall a b. (Counted a -> Counted b) -> Emit a -> Emit b
onCount Counted a -> Counted b
f (EM Word64 -> (EnumMap Word64 Comb, Counted a)
e) = (Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b)
-> (Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b
forall a b. (a -> b) -> a -> b
$ (Counted a -> Counted b)
-> (EnumMap Word64 Comb, Counted a)
-> (EnumMap Word64 Comb, Counted b)
forall a b.
(a -> b) -> (EnumMap Word64 Comb, a) -> (EnumMap Word64 Comb, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Counted a -> Counted b
f ((EnumMap Word64 Comb, Counted a)
 -> (EnumMap Word64 Comb, Counted b))
-> (Word64 -> (EnumMap Word64 Comb, Counted a))
-> Word64
-> (EnumMap Word64 Comb, Counted b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> (EnumMap Word64 Comb, Counted a)
e

letIndex :: Word16 -> Word64 -> Word64
letIndex :: Word16 -> Word64 -> Word64
letIndex Word16
l Word64
c = Word64
c Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
l

record :: Ctx v -> Word16 -> Emit Section -> Emit Word64
record :: forall v. Ctx v -> Word16 -> Emit Section -> Emit Word64
record Ctx v
ctx Word16
l (EM Word64 -> (EnumMap Word64 Comb, Counted Section)
es) = (Word64 -> (EnumMap Word64 Comb, Counted Word64)) -> Emit Word64
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted Word64)) -> Emit Word64)
-> (Word64 -> (EnumMap Word64 Comb, Counted Word64)) -> Emit Word64
forall a b. (a -> b) -> a -> b
$ \Word64
c ->
  let (EnumMap Word64 Comb
m, C Int
u Int
b Section
s) = Word64 -> (EnumMap Word64 Comb, Counted Section)
es Word64
c
      (Int
au, Int
ab) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 Int
0 Int
0 Ctx v
ctx
      n :: Word64
n = Word16 -> Word64 -> Word64
letIndex Word16
l Word64
c
   in (Word64 -> Comb -> EnumMap Word64 Comb -> EnumMap Word64 Comb
forall k a. EnumKey k => k -> a -> EnumMap k a -> EnumMap k a
EC.mapInsert Word64
n (Int -> Int -> Int -> Int -> Section -> Comb
forall comb.
Int -> Int -> Int -> Int -> GSection comb -> GComb comb
Lam Int
au Int
ab Int
u Int
b Section
s) EnumMap Word64 Comb
m, Int -> Int -> Word64 -> Counted Word64
forall a. Int -> Int -> a -> Counted a
C Int
u Int
b Word64
n)

recordTop :: [v] -> Word16 -> Emit Section -> Emit ()
recordTop :: forall v. [v] -> Word16 -> Emit Section -> Emit ()
recordTop [v]
vs Word16
l (EM Word64 -> (EnumMap Word64 Comb, Counted Section)
e) = (Word64 -> (EnumMap Word64 Comb, Counted ())) -> Emit ()
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted ())) -> Emit ())
-> (Word64 -> (EnumMap Word64 Comb, Counted ())) -> Emit ()
forall a b. (a -> b) -> a -> b
$ \Word64
c ->
  let (EnumMap Word64 Comb
m, C Int
u Int
b Section
s) = Word64 -> (EnumMap Word64 Comb, Counted Section)
e Word64
c
      ab :: Int
ab = [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs
      n :: Word64
n = Word16 -> Word64 -> Word64
letIndex Word16
l Word64
c
   in (Word64 -> Comb -> EnumMap Word64 Comb -> EnumMap Word64 Comb
forall k a. EnumKey k => k -> a -> EnumMap k a -> EnumMap k a
EC.mapInsert Word64
n (Int -> Int -> Int -> Int -> Section -> Comb
forall comb.
Int -> Int -> Int -> Int -> GSection comb -> GComb comb
Lam Int
0 Int
ab Int
u Int
b Section
s) EnumMap Word64 Comb
m, Int -> Int -> () -> Counted ()
forall a. Int -> Int -> a -> Counted a
C Int
u Int
b ())

-- Counts the stack space used by a context and annotates a value
-- with it.
countCtx :: Ctx v -> a -> Emit a
countCtx :: forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx = Counted a -> Emit a
forall a. Counted a -> Emit a
counted (Counted a -> Emit a) -> (a -> Counted a) -> a -> Emit a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> a -> Counted a
forall a. Int -> Int -> a -> Counted a
C Int
u Int
b where (Int
u, Int
b) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 Int
0 Int
0 Ctx v
ctx

countCtx0 :: Int -> Int -> Ctx v -> (Int, Int)
countCtx0 :: forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 !Int
ui !Int
bi (Var v
_ Mem
UN Ctx v
ctx) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 (Int
ui Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
bi Ctx v
ctx
countCtx0 Int
ui Int
bi (Var v
_ Mem
BX Ctx v
ctx) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 Int
ui (Int
bi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx v
ctx
countCtx0 Int
ui Int
bi (Tag Ctx v
ctx) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 (Int
ui Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
bi Ctx v
ctx
countCtx0 Int
ui Int
bi (Block Ctx v
ctx) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 Int
ui Int
bi Ctx v
ctx
countCtx0 Int
ui Int
bi Ctx v
ECtx = (Int
ui, Int
bi)

emitComb ::
  (Var v) =>
  RefNums ->
  Reference ->
  Word64 ->
  RCtx v ->
  (Word64, SuperNormal v) ->
  EC.EnumMap Word64 Comb
emitComb :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> (Word64, SuperNormal v)
-> EnumMap Word64 Comb
emitComb RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (Word64
n, Lambda [Mem]
ccs (TAbss [v]
vs Term ANormalF v
bd)) =
  Word64 -> Emit () -> EnumMap Word64 Comb
forall a. Word64 -> Emit a -> EnumMap Word64 Comb
runEmit Word64
n
    (Emit () -> EnumMap Word64 Comb)
-> (Emit Section -> Emit ()) -> Emit Section -> EnumMap Word64 Comb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Word16 -> Emit Section -> Emit ()
forall v. [v] -> Word16 -> Emit Section -> Emit ()
recordTop [v]
vs Word16
0
    (Emit Section -> EnumMap Word64 Comb)
-> Emit Section -> EnumMap Word64 Comb
forall a b. (a -> b) -> a -> b
$ RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Term ANormalF v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec ([v] -> [Mem] -> Ctx v
forall v. [v] -> [Mem] -> Ctx v
ctx [v]
vs [Mem]
ccs) Term ANormalF v
bd

addCount :: Int -> Int -> Emit a -> Emit a
addCount :: forall a. Int -> Int -> Emit a -> Emit a
addCount Int
i Int
j = (Counted a -> Counted a) -> Emit a -> Emit a
forall a b. (Counted a -> Counted b) -> Emit a -> Emit b
onCount ((Counted a -> Counted a) -> Emit a -> Emit a)
-> (Counted a -> Counted a) -> Emit a -> Emit a
forall a b. (a -> b) -> a -> b
$ \(C Int
u Int
b a
x) -> Int -> Int -> a -> Counted a
forall a. Int -> Int -> a -> Counted a
C (Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) a
x

-- Emit a machine code section from an ANF term
emitSection ::
  (Var v) =>
  RefNums ->
  Reference ->
  Word64 ->
  RCtx v ->
  Ctx v ->
  ANormal v ->
  Emit Section
emitSection :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TLets Direction Word16
d [v]
us [Mem]
ms ANormal v
bu ANormal v
bo) =
  RefNums
-> Reference
-> Word64
-> RCtx v
-> Direction Word16
-> [(v, Mem)]
-> Ctx v
-> ANormal v
-> Emit Section
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Direction Word16
-> [(v, Mem)]
-> Ctx v
-> ANormal v
-> Emit Section
-> Emit Section
emitLet RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Direction Word16
d ([v] -> [Mem] -> [(v, Mem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
us [Mem]
ms) Ctx v
ctx ANormal v
bu (Emit Section -> Emit Section) -> Emit Section -> Emit Section
forall a b. (a -> b) -> a -> b
$
    RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ectx ANormal v
bo
  where
    ectx :: Ctx v
ectx = [(v, Mem)] -> Ctx v -> Ctx v
forall v. [(v, Mem)] -> Ctx v -> Ctx v
pushCtx ([v] -> [Mem] -> [(v, Mem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
us [Mem]
ms) Ctx v
ctx
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TName v
u (Left Reference
f) [v]
args ANormal v
bo) =
  Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
forall v.
Var v =>
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
emitClosures Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx [v]
args ((Ctx v -> Args -> Emit Section) -> Emit Section)
-> (Ctx v -> Args -> Emit Section) -> Emit Section
forall a b. (a -> b) -> a -> b
$ \Ctx v
ctx Args
as ->
    Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> Instr
forall comb. GRef comb -> Args -> GInstr comb
Name (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
f (RefNums -> Reference -> Word64
cnum RefNums
rns Reference
f) Word64
0)) Args
as)
      (Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
u Mem
BX Ctx v
ctx) ANormal v
bo
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TName v
u (Right v
v) [v]
args ANormal v
bo)
  | Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v =
      Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
forall v.
Var v =>
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
emitClosures Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx [v]
args ((Ctx v -> Args -> Emit Section) -> Emit Section)
-> (Ctx v -> Args -> Emit Section) -> Emit Section
forall a b. (a -> b) -> a -> b
$ \Ctx v
ctx Args
as ->
        Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> Instr
forall comb. GRef comb -> Args -> GInstr comb
Name (Int -> GRef CombIx
forall comb. Int -> GRef comb
Stk Int
i) Args
as)
          (Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
u Mem
BX Ctx v
ctx) ANormal v
bo
  | Just Word64
n <- RCtx v -> v -> Maybe Word64
forall v. Var v => RCtx v -> v -> Maybe Word64
rctxResolve RCtx v
rec v
v =
      Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
forall v.
Var v =>
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
emitClosures Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx [v]
args ((Ctx v -> Args -> Emit Section) -> Emit Section)
-> (Ctx v -> Args -> Emit Section) -> Emit Section
forall a b. (a -> b) -> a -> b
$ \Ctx v
ctx Args
as ->
        Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> Instr
forall comb. GRef comb -> Args -> GInstr comb
Name (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
n)) Args
as)
          (Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
u Mem
BX Ctx v
ctx) ANormal v
bo
  | Bool
otherwise = v -> Emit Section
forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
v
emitSection RefNums
_ Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TVar v
v)
  | Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v = Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Int -> Args
BArg1 Int
i
  | Just (Int
i, Mem
UN) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v = Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Int -> Args
UArg1 Int
i
  | Just Word64
j <- RCtx v -> v -> Maybe Word64
forall v. Var v => RCtx v -> v -> Maybe Word64
rctxResolve RCtx v
rec v
v =
      Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section) -> Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
j)) Args
ZArgs
  | Bool
otherwise = v -> Emit Section
forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
v
emitSection RefNums
_ Reference
_ Word64
grpn RCtx v
_ Ctx v
ctx (TPrm POp
p [v]
args) =
  -- 3 is a conservative estimate of how many extra stack slots
  -- a prim op will need for its results.
  Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
3 Int
3
    (Emit Section -> Emit Section)
-> (Args -> Emit Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx
    (Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (POp -> Args -> Instr
emitPOp POp
p (Args -> Instr) -> Args -> Instr
forall a b. (a -> b) -> a -> b
$ Word64 -> Ctx v -> [v] -> Args
forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args)
    (Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield
    (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Args
DArgV Int
i Int
j
  where
    (Int
i, Int
j) = Ctx v -> (Int, Int)
forall v. Ctx v -> (Int, Int)
countBlock Ctx v
ctx
emitSection RefNums
_ Reference
_ Word64
grpn RCtx v
_ Ctx v
ctx (TFOp Word64
p [v]
args) =
  Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
3 Int
3
    (Emit Section -> Emit Section)
-> (Args -> Emit Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx
    (Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Word64 -> Args -> Instr
emitFOp Word64
p (Args -> Instr) -> Args -> Instr
forall a b. (a -> b) -> a -> b
$ Word64 -> Ctx v -> [v] -> Args
forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args)
    (Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield
    (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Args
DArgV Int
i Int
j
  where
    (Int
i, Int
j) = Ctx v -> (Int, Int)
forall v. Ctx v -> (Int, Int)
countBlock Ctx v
ctx
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TApp Func v
f [v]
args) =
  Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
forall v.
Var v =>
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
emitClosures Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx [v]
args ((Ctx v -> Args -> Emit Section) -> Emit Section)
-> (Ctx v -> Args -> Emit Section) -> Emit Section
forall a b. (a -> b) -> a -> b
$ \Ctx v
ctx Args
as ->
    Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section) -> Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Func v
-> Args
-> Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Func v
-> Args
-> Section
emitFunction RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx Func v
f Args
as
emitSection RefNums
_ Reference
_ Word64
_ RCtx v
_ Ctx v
ctx (TLit Lit
l) =
  Emit Section -> Emit Section
c (Emit Section -> Emit Section)
-> (Args -> Emit Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Lit -> Instr
emitLit Lit
l) (Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Lit -> Args
litArg Lit
l
  where
    c :: Emit Section -> Emit Section
c
      | ANF.T {} <- Lit
l = Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
0 Int
1
      | ANF.LM {} <- Lit
l = Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
0 Int
1
      | ANF.LY {} <- Lit
l = Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
0 Int
1
      | Bool
otherwise = Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
1 Int
0
emitSection RefNums
_ Reference
_ Word64
_ RCtx v
_ Ctx v
ctx (TBLit Lit
l) =
  Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
0 Int
1 (Emit Section -> Emit Section)
-> (Args -> Emit Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Lit -> Instr
emitBLit Lit
l) (Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Int -> Args
BArg1 Int
0
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TMatch v
v Branched (ANormal v)
bs)
  | Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
    MatchData Reference
r EnumMap CTag ([Mem], ANormal v)
cs Maybe (ANormal v)
df <- Branched (ANormal v)
bs =
      Maybe Reference -> Int -> GBranch CombIx -> Section
forall comb.
Maybe Reference -> Int -> GBranch comb -> GSection comb
DMatch (Reference -> Maybe Reference
forall a. a -> Maybe a
Just Reference
r) Int
i
        (GBranch CombIx -> Section)
-> Emit (GBranch CombIx) -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Emit (GBranch CombIx)
forall v.
Var v =>
Reference
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Emit (GBranch CombIx)
emitDataMatching Reference
r RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx EnumMap CTag ([Mem], ANormal v)
cs Maybe (ANormal v)
df
  | Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
    MatchRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
hs0 ANormal v
df <- Branched (ANormal v)
bs,
    EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
hs <- [(Word64, EnumMap CTag ([Mem], ANormal v))]
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList ([(Word64, EnumMap CTag ([Mem], ANormal v))]
 -> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v)))
-> [(Word64, EnumMap CTag ([Mem], ANormal v))]
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
forall a b. (a -> b) -> a -> b
$ (Reference -> Word64)
-> (Reference, EnumMap CTag ([Mem], ANormal v))
-> (Word64, EnumMap CTag ([Mem], ANormal v))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (RefNums -> Reference -> Word64
dnum RefNums
rns) ((Reference, EnumMap CTag ([Mem], ANormal v))
 -> (Word64, EnumMap CTag ([Mem], ANormal v)))
-> [(Reference, EnumMap CTag ([Mem], ANormal v))]
-> [(Word64, EnumMap CTag ([Mem], ANormal v))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Reference (EnumMap CTag ([Mem], ANormal v))
-> [(Reference, EnumMap CTag ([Mem], ANormal v))]
forall k a. Map k a -> [(k, a)]
M.toList Map Reference (EnumMap CTag ([Mem], ANormal v))
hs0 =
      (Section -> EnumMap Word64 (GBranch CombIx) -> Section)
-> (Section, EnumMap Word64 (GBranch CombIx)) -> Section
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Section -> EnumMap Word64 (GBranch CombIx) -> Section
forall comb.
Int
-> GSection comb -> EnumMap Word64 (GBranch comb) -> GSection comb
RMatch Int
i)
        ((Section, EnumMap Word64 (GBranch CombIx)) -> Section)
-> Emit (Section, EnumMap Word64 (GBranch CombIx)) -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
-> ANormal v
-> Emit (Section, EnumMap Word64 (GBranch CombIx))
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
-> ANormal v
-> Emit (Section, EnumMap Word64 (GBranch CombIx))
emitRequestMatching RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
hs ANormal v
df
  | Just (Int
i, Mem
UN) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
    MatchIntegral EnumMap Word64 (ANormal v)
cs Maybe (ANormal v)
df <- Branched (ANormal v)
bs =
      (Int -> Section -> EnumMap Word64 Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> EnumMap Word64 (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
forall v (f :: * -> *).
(Var v, Traversable f) =>
(Int -> Section -> f Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> f (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
emitLitMatching
        Int -> Section -> EnumMap Word64 Section -> Section
forall comb.
Int
-> GSection comb -> EnumMap Word64 (GSection comb) -> GSection comb
MatchW
        [Char]
"missing integral case"
        RefNums
rns
        Reference
grpr
        Word64
grpn
        RCtx v
rec
        Ctx v
ctx
        Int
i
        EnumMap Word64 (ANormal v)
cs
        Maybe (ANormal v)
df
  | Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
    MatchNumeric Reference
r EnumMap Word64 (ANormal v)
cs Maybe (ANormal v)
df <- Branched (ANormal v)
bs =
      (Int -> Section -> EnumMap Word64 Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> EnumMap Word64 (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
forall v (f :: * -> *).
(Var v, Traversable f) =>
(Int -> Section -> f Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> f (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
emitLitMatching
        (Maybe Reference
-> Int -> Section -> EnumMap Word64 Section -> Section
forall comb.
Maybe Reference
-> Int
-> GSection comb
-> EnumMap Word64 (GSection comb)
-> GSection comb
NMatchW (Reference -> Maybe Reference
forall a. a -> Maybe a
Just Reference
r))
        [Char]
"missing integral case"
        RefNums
rns
        Reference
grpr
        Word64
grpn
        RCtx v
rec
        Ctx v
ctx
        Int
i
        EnumMap Word64 (ANormal v)
cs
        Maybe (ANormal v)
df
  | Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
    MatchText Map Text (ANormal v)
cs Maybe (ANormal v)
df <- Branched (ANormal v)
bs =
      (Int -> Section -> Map Text Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> Map Text (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
forall v (f :: * -> *).
(Var v, Traversable f) =>
(Int -> Section -> f Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> f (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
emitLitMatching
        Int -> Section -> Map Text Section -> Section
forall comb.
Int -> GSection comb -> Map Text (GSection comb) -> GSection comb
MatchT
        [Char]
"missing text case"
        RefNums
rns
        Reference
grpr
        Word64
grpn
        RCtx v
rec
        Ctx v
ctx
        Int
i
        Map Text (ANormal v)
cs
        Maybe (ANormal v)
df
  | Just (Int
i, Mem
UN) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
    MatchSum EnumMap Word64 ([Mem], ANormal v)
cs <- Branched (ANormal v)
bs =
      RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> Int
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> Int
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit Section
emitSumMatching RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx v
v Int
i EnumMap Word64 ([Mem], ANormal v)
cs
  | Just (Int
_, Mem
cc) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v =
      [Char] -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section) -> [Char] -> Emit Section
forall a b. (a -> b) -> a -> b
$
        [Char]
"emitSection: mismatched calling convention for match: "
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Mem -> Branched (ANormal v) -> [Char]
forall v. Mem -> Branched v -> [Char]
matchCallingError Mem
cc Branched (ANormal v)
bs
  | Bool
otherwise =
      [Char] -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section) -> [Char] -> Emit Section
forall a b. (a -> b) -> a -> b
$
        [Char]
"emitSection: could not resolve match variable: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Ctx v, v) -> [Char]
forall a. Show a => a -> [Char]
show (Ctx v
ctx, v
v)
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (THnd [Reference]
rs v
h ANormal v
b)
  | Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
h =
      Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (EnumSet Word64 -> Instr
forall comb. EnumSet Word64 -> GInstr comb
Reset ([Word64] -> EnumSet Word64
forall k. EnumKey k => [k] -> EnumSet k
EC.setFromList [Word64]
ws))
        (Section -> Section) -> (Section -> Section) -> Section -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Section -> [Word64] -> Section) -> [Word64] -> Section -> Section
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Word64 -> Section -> Section) -> Section -> [Word64] -> Section
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Word64
r -> Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Word64 -> Int -> Instr
forall comb. Word64 -> Int -> GInstr comb
SetDyn Word64
r Int
i))) [Word64]
ws
        (Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx ANormal v
b
  | Bool
otherwise = v -> Emit Section
forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
h
  where
    ws :: [Word64]
ws = RefNums -> Reference -> Word64
dnum RefNums
rns (Reference -> Word64) -> [Reference] -> [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Reference]
rs
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TShift Reference
r v
v ANormal v
e) =
  Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Word64 -> Instr
forall comb. Word64 -> GInstr comb
Capture (Word64 -> Instr) -> Word64 -> Instr
forall a b. (a -> b) -> a -> b
$ RefNums -> Reference -> Word64
dnum RefNums
rns Reference
r)
    (Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
v Mem
BX Ctx v
ctx) ANormal v
e
emitSection RefNums
_ Reference
_ Word64
_ RCtx v
_ Ctx v
ctx (TFrc v
v)
  | Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v =
      Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section) -> Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (Int -> GRef CombIx
forall comb. Int -> GRef comb
Stk Int
i) Args
ZArgs
  | Just (Int, Mem)
_ <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v =
      [Char] -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section) -> [Char] -> Emit Section
forall a b. (a -> b) -> a -> b
$
        [Char]
"emitSection: values to be forced must be boxed: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> [Char]
forall a. Show a => a -> [Char]
show v
v
  | Bool
otherwise = v -> Emit Section
forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
v
emitSection RefNums
_ Reference
_ Word64
_ RCtx v
_ Ctx v
_ ANormal v
tm =
  [Char] -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section) -> [Char] -> Emit Section
forall a b. (a -> b) -> a -> b
$ [Char]
"emitSection: unhandled code: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ANormal v -> [Char]
forall a. Show a => a -> [Char]
show ANormal v
tm

-- Emit the code for a function call
emitFunction ::
  (Var v) =>
  RefNums ->
  Reference ->
  Word64 -> -- self combinator number
  RCtx v -> -- recursive binding group
  Ctx v -> -- local context
  Func v ->
  Args ->
  Section
emitFunction :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Func v
-> Args
-> Section
emitFunction RefNums
_ Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (FVar v
v) Args
as
  | Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v =
      Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (Int -> GRef CombIx
forall comb. Int -> GRef comb
Stk Int
i) Args
as
  | Just Word64
j <- RCtx v -> v -> Maybe Word64
forall v. Var v => RCtx v -> v -> Maybe Word64
rctxResolve RCtx v
rec v
v =
      Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
j)) Args
as
  | Bool
otherwise = v -> Section
forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
v
emitFunction RefNums
rns Reference
_grpr Word64
_ RCtx v
_ Ctx v
_ (FComb Reference
r) Args
as
  | Bool
otherwise -- slow path
    =
      Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
r Word64
n Word64
0)) Args
as
  where
    n :: Word64
n = RefNums -> Reference -> Word64
cnum RefNums
rns Reference
r
emitFunction RefNums
rns Reference
_grpr Word64
_ RCtx v
_ Ctx v
_ (FCon Reference
r CTag
t) Args
as =
  Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Reference -> Word64 -> Args -> Instr
forall comb. Reference -> Word64 -> Args -> GInstr comb
Pack Reference
r (RTag -> CTag -> Word64
packTags RTag
rt CTag
t) Args
as)
    (Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield
    (Args -> Section) -> Args -> Section
forall a b. (a -> b) -> a -> b
$ Int -> Args
BArg1 Int
0
  where
    rt :: RTag
rt = Int -> RTag
forall a. Enum a => Int -> a
toEnum (Int -> RTag) -> (Word64 -> Int) -> Word64 -> RTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RTag) -> Word64 -> RTag
forall a b. (a -> b) -> a -> b
$ RefNums -> Reference -> Word64
dnum RefNums
rns Reference
r
emitFunction RefNums
rns Reference
_grpr Word64
_ RCtx v
_ Ctx v
_ (FReq Reference
r CTag
e) Args
as =
  -- Currently implementing packed calling convention for abilities
  -- TODO ct is 16 bits, but a is 48 bits. This will be a problem if we have
  -- more than 2^16 types.
  Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Reference -> Word64 -> Args -> Instr
forall comb. Reference -> Word64 -> Args -> GInstr comb
Pack Reference
r (RTag -> CTag -> Word64
packTags RTag
rt CTag
e) Args
as)
    (Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
True (Word64 -> GRef CombIx
forall comb. Word64 -> GRef comb
Dyn Word64
a)
    (Args -> Section) -> Args -> Section
forall a b. (a -> b) -> a -> b
$ Int -> Args
BArg1 Int
0
  where
    a :: Word64
a = RefNums -> Reference -> Word64
dnum RefNums
rns Reference
r
    rt :: RTag
rt = Int -> RTag
forall a. Enum a => Int -> a
toEnum (Int -> RTag) -> (Word64 -> Int) -> Word64 -> RTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RTag) -> Word64 -> RTag
forall a b. (a -> b) -> a -> b
$ Word64
a
emitFunction RefNums
_ Reference
_grpr Word64
_ RCtx v
_ Ctx v
ctx (FCont v
k) Args
as
  | Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
k = Int -> Args -> Section
forall comb. Int -> Args -> GSection comb
Jump Int
i Args
as
  | Maybe (Int, Mem)
Nothing <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
k = v -> Section
forall v a. (Var v, HasCallStack) => v -> a
emitFunctionVErr v
k
  | Bool
otherwise = [Char] -> Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Section) -> [Char] -> Section
forall a b. (a -> b) -> a -> b
$ [Char]
"emitFunction: continuations are boxed"
emitFunction RefNums
_ Reference
_grpr Word64
_ RCtx v
_ Ctx v
_ (FPrim Either POp Word64
_) Args
_ =
  [Char] -> Section
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"emitFunction: impossible"

countBlock :: Ctx v -> (Int, Int)
countBlock :: forall v. Ctx v -> (Int, Int)
countBlock = Int -> Int -> Ctx v -> (Int, Int)
forall {a} {b} {v}. (Num a, Num b) => a -> b -> Ctx v -> (a, b)
go Int
0 Int
0
  where
    go :: a -> b -> Ctx v -> (a, b)
go !a
ui !b
bi (Var v
_ Mem
UN Ctx v
ctx) = a -> b -> Ctx v -> (a, b)
go (a
ui a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) b
bi Ctx v
ctx
    go a
ui b
bi (Var v
_ Mem
BX Ctx v
ctx) = a -> b -> Ctx v -> (a, b)
go a
ui (b
bi b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) Ctx v
ctx
    go a
ui b
bi (Tag Ctx v
ctx) = a -> b -> Ctx v -> (a, b)
go (a
ui a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) b
bi Ctx v
ctx
    go a
ui b
bi Ctx v
_ = (a
ui, b
bi)

matchCallingError :: Mem -> Branched v -> String
matchCallingError :: forall v. Mem -> Branched v -> [Char]
matchCallingError Mem
cc Branched v
b = [Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Mem -> [Char]
forall a. Show a => a -> [Char]
show Mem
cc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
brs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
  where
    brs :: [Char]
brs
      | MatchData Reference
_ EnumMap CTag ([Mem], v)
_ Maybe v
_ <- Branched v
b = [Char]
"MatchData"
      | Branched v
MatchEmpty <- Branched v
b = [Char]
"MatchEmpty"
      | MatchIntegral EnumMap Word64 v
_ Maybe v
_ <- Branched v
b = [Char]
"MatchIntegral"
      | MatchNumeric Reference
_ EnumMap Word64 v
_ Maybe v
_ <- Branched v
b = [Char]
"MatchNumeric"
      | MatchRequest Map Reference (EnumMap CTag ([Mem], v))
_ v
_ <- Branched v
b = [Char]
"MatchRequest"
      | MatchSum EnumMap Word64 ([Mem], v)
_ <- Branched v
b = [Char]
"MatchSum"
      | MatchText Map Text v
_ Maybe v
_ <- Branched v
b = [Char]
"MatchText"

emitSectionVErr :: (Var v, HasCallStack) => v -> a
emitSectionVErr :: forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
v =
  [Char] -> a
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$
    [Char]
"emitSection: could not resolve function variable: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> [Char]
forall a. Show a => a -> [Char]
show v
v

emitFunctionVErr :: (Var v, HasCallStack) => v -> a
emitFunctionVErr :: forall v a. (Var v, HasCallStack) => v -> a
emitFunctionVErr v
v =
  [Char] -> a
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$
    [Char]
"emitFunction: could not resolve function variable: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> [Char]
forall a. Show a => a -> [Char]
show v
v

litArg :: ANF.Lit -> Args
litArg :: Lit -> Args
litArg ANF.T {} = Int -> Args
BArg1 Int
0
litArg ANF.LM {} = Int -> Args
BArg1 Int
0
litArg ANF.LY {} = Int -> Args
BArg1 Int
0
litArg Lit
_ = Int -> Args
UArg1 Int
0

-- Emit machine code for a let expression. Some expressions do not
-- require a machine code Let, which uses more complicated stack
-- manipulation.
emitLet ::
  (Var v) =>
  RefNums ->
  Reference ->
  Word64 ->
  RCtx v ->
  Direction Word16 ->
  [(v, Mem)] ->
  Ctx v ->
  ANormal v ->
  Emit Section ->
  Emit Section
emitLet :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Direction Word16
-> [(v, Mem)]
-> Ctx v
-> ANormal v
-> Emit Section
-> Emit Section
emitLet RefNums
_ Reference
_ Word64
_ RCtx v
_ Direction Word16
_ [(v, Mem)]
_ Ctx v
_ (TLit Lit
l) =
  (Section -> Section) -> Emit Section -> Emit Section
forall a b. (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Instr -> Section -> Section) -> Instr -> Section -> Section
forall a b. (a -> b) -> a -> b
$ Lit -> Instr
emitLit Lit
l)
emitLet RefNums
_ Reference
_ Word64
_ RCtx v
_ Direction Word16
_ [(v, Mem)]
_ Ctx v
_ (TBLit Lit
l) =
  (Section -> Section) -> Emit Section -> Emit Section
forall a b. (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Instr -> Section -> Section) -> Instr -> Section -> Section
forall a b. (a -> b) -> a -> b
$ Lit -> Instr
emitBLit Lit
l)
-- emitLet rns grp _   _ _   ctx (TApp (FComb r) args)
--   -- We should be able to tell if we are making a saturated call
--   -- or not here. We aren't carrying the information here yet, though.
--   | False -- not saturated
--   = fmap (Ins . Name (Env n 0) $ emitArgs grp ctx args)
--   where
--   n = cnum rns r
emitLet RefNums
rns Reference
_ Word64
grpn RCtx v
_ Direction Word16
_ [(v, Mem)]
_ Ctx v
ctx (TApp (FCon Reference
r CTag
n) [v]
args) =
  (Section -> Section) -> Emit Section -> Emit Section
forall a b. (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Instr -> Section -> Section)
-> (Args -> Instr) -> Args -> Section -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Word64 -> Args -> Instr
forall comb. Reference -> Word64 -> Args -> GInstr comb
Pack Reference
r (RTag -> CTag -> Word64
packTags RTag
rt CTag
n) (Args -> Section -> Section) -> Args -> Section -> Section
forall a b. (a -> b) -> a -> b
$ Word64 -> Ctx v -> [v] -> Args
forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args)
  where
    rt :: RTag
rt = Int -> RTag
forall a. Enum a => Int -> a
toEnum (Int -> RTag) -> (Word64 -> Int) -> Word64 -> RTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RTag) -> Word64 -> RTag
forall a b. (a -> b) -> a -> b
$ RefNums -> Reference -> Word64
dnum RefNums
rns Reference
r
emitLet RefNums
_ Reference
_ Word64
grpn RCtx v
_ Direction Word16
_ [(v, Mem)]
_ Ctx v
ctx (TApp (FPrim Either POp Word64
p) [v]
args) =
  (Section -> Section) -> Emit Section -> Emit Section
forall a b. (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Instr -> Section -> Section)
-> (Args -> Instr) -> Args -> Section -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POp -> Args -> Instr)
-> (Word64 -> Args -> Instr) -> Either POp Word64 -> Args -> Instr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either POp -> Args -> Instr
emitPOp Word64 -> Args -> Instr
emitFOp Either POp Word64
p (Args -> Section -> Section) -> Args -> Section -> Section
forall a b. (a -> b) -> a -> b
$ Word64 -> Ctx v -> [v] -> Args
forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args)
emitLet RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Direction Word16
d [(v, Mem)]
vcs Ctx v
ctx ANormal v
bnd
  | Direction Word16
Direct <- Direction Word16
d =
      [Char] -> Emit Section -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section -> Emit Section)
-> [Char] -> Emit Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ [Char]
"unsupported compound direct let: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ANormal v -> [Char]
forall a. Show a => a -> [Char]
show ANormal v
bnd
  | Indirect Word16
w <- Direction Word16
d =
      \Emit Section
esect ->
        Section -> Word64 -> Section
f
          (Section -> Word64 -> Section)
-> Emit Section -> Emit (Word64 -> Section)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (Ctx v -> Ctx v
forall v. Ctx v -> Ctx v
Block Ctx v
ctx) ANormal v
bnd
          Emit (Word64 -> Section) -> Emit Word64 -> Emit Section
forall a b. Emit (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ctx v -> Word16 -> Emit Section -> Emit Word64
forall v. Ctx v -> Word16 -> Emit Section -> Emit Word64
record ([(v, Mem)] -> Ctx v -> Ctx v
forall v. [(v, Mem)] -> Ctx v -> Ctx v
pushCtx [(v, Mem)]
vcs Ctx v
ctx) Word16
w Emit Section
esect
  where
    f :: Section -> Word64 -> Section
f Section
s Word64
w = Section -> CombIx -> Section
forall comb. GSection comb -> comb -> GSection comb
Let Section
s (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
w)

-- Translate from ANF prim ops to machine code operations. The
-- machine code operations are divided with respect to more detailed
-- information about expected number and types of arguments.
emitPOp :: ANF.POp -> Args -> Instr
-- Integral
emitPOp :: POp -> Args -> Instr
emitPOp POp
ANF.ADDI = UPrim2 -> Args -> Instr
emitP2 UPrim2
ADDI
emitPOp POp
ANF.ADDN = UPrim2 -> Args -> Instr
emitP2 UPrim2
ADDI
emitPOp POp
ANF.SUBI = UPrim2 -> Args -> Instr
emitP2 UPrim2
SUBI
emitPOp POp
ANF.SUBN = UPrim2 -> Args -> Instr
emitP2 UPrim2
SUBI
emitPOp POp
ANF.MULI = UPrim2 -> Args -> Instr
emitP2 UPrim2
MULI
emitPOp POp
ANF.MULN = UPrim2 -> Args -> Instr
emitP2 UPrim2
MULI
emitPOp POp
ANF.DIVI = UPrim2 -> Args -> Instr
emitP2 UPrim2
DIVI
emitPOp POp
ANF.DIVN = UPrim2 -> Args -> Instr
emitP2 UPrim2
DIVN
emitPOp POp
ANF.MODI = UPrim2 -> Args -> Instr
emitP2 UPrim2
MODI -- TODO: think about how these behave
emitPOp POp
ANF.MODN = UPrim2 -> Args -> Instr
emitP2 UPrim2
MODN -- TODO: think about how these behave
emitPOp POp
ANF.POWI = UPrim2 -> Args -> Instr
emitP2 UPrim2
POWI
emitPOp POp
ANF.POWN = UPrim2 -> Args -> Instr
emitP2 UPrim2
POWI
emitPOp POp
ANF.SHLI = UPrim2 -> Args -> Instr
emitP2 UPrim2
SHLI
emitPOp POp
ANF.SHLN = UPrim2 -> Args -> Instr
emitP2 UPrim2
SHLI -- Note: left shift behaves uniformly
emitPOp POp
ANF.SHRI = UPrim2 -> Args -> Instr
emitP2 UPrim2
SHRI
emitPOp POp
ANF.SHRN = UPrim2 -> Args -> Instr
emitP2 UPrim2
SHRN
emitPOp POp
ANF.LEQI = UPrim2 -> Args -> Instr
emitP2 UPrim2
LEQI
emitPOp POp
ANF.LEQN = UPrim2 -> Args -> Instr
emitP2 UPrim2
LEQN
emitPOp POp
ANF.EQLI = UPrim2 -> Args -> Instr
emitP2 UPrim2
EQLI
emitPOp POp
ANF.EQLN = UPrim2 -> Args -> Instr
emitP2 UPrim2
EQLI
emitPOp POp
ANF.SGNI = UPrim1 -> Args -> Instr
emitP1 UPrim1
SGNI
emitPOp POp
ANF.NEGI = UPrim1 -> Args -> Instr
emitP1 UPrim1
NEGI
emitPOp POp
ANF.INCI = UPrim1 -> Args -> Instr
emitP1 UPrim1
INCI
emitPOp POp
ANF.INCN = UPrim1 -> Args -> Instr
emitP1 UPrim1
INCI
emitPOp POp
ANF.DECI = UPrim1 -> Args -> Instr
emitP1 UPrim1
DECI
emitPOp POp
ANF.DECN = UPrim1 -> Args -> Instr
emitP1 UPrim1
DECI
emitPOp POp
ANF.TZRO = UPrim1 -> Args -> Instr
emitP1 UPrim1
TZRO
emitPOp POp
ANF.LZRO = UPrim1 -> Args -> Instr
emitP1 UPrim1
LZRO
emitPOp POp
ANF.POPC = UPrim1 -> Args -> Instr
emitP1 UPrim1
POPC
emitPOp POp
ANF.ANDN = UPrim2 -> Args -> Instr
emitP2 UPrim2
ANDN
emitPOp POp
ANF.IORN = UPrim2 -> Args -> Instr
emitP2 UPrim2
IORN
emitPOp POp
ANF.XORN = UPrim2 -> Args -> Instr
emitP2 UPrim2
XORN
emitPOp POp
ANF.COMN = UPrim1 -> Args -> Instr
emitP1 UPrim1
COMN
-- Float
emitPOp POp
ANF.ADDF = UPrim2 -> Args -> Instr
emitP2 UPrim2
ADDF
emitPOp POp
ANF.SUBF = UPrim2 -> Args -> Instr
emitP2 UPrim2
SUBF
emitPOp POp
ANF.MULF = UPrim2 -> Args -> Instr
emitP2 UPrim2
MULF
emitPOp POp
ANF.DIVF = UPrim2 -> Args -> Instr
emitP2 UPrim2
DIVF
emitPOp POp
ANF.LEQF = UPrim2 -> Args -> Instr
emitP2 UPrim2
LEQF
emitPOp POp
ANF.EQLF = UPrim2 -> Args -> Instr
emitP2 UPrim2
EQLF
emitPOp POp
ANF.MINF = UPrim2 -> Args -> Instr
emitP2 UPrim2
MINF
emitPOp POp
ANF.MAXF = UPrim2 -> Args -> Instr
emitP2 UPrim2
MAXF
emitPOp POp
ANF.POWF = UPrim2 -> Args -> Instr
emitP2 UPrim2
POWF
emitPOp POp
ANF.EXPF = UPrim1 -> Args -> Instr
emitP1 UPrim1
EXPF
emitPOp POp
ANF.ABSF = UPrim1 -> Args -> Instr
emitP1 UPrim1
ABSF
emitPOp POp
ANF.SQRT = UPrim1 -> Args -> Instr
emitP1 UPrim1
SQRT
emitPOp POp
ANF.LOGF = UPrim1 -> Args -> Instr
emitP1 UPrim1
LOGF
emitPOp POp
ANF.LOGB = UPrim2 -> Args -> Instr
emitP2 UPrim2
LOGB
emitPOp POp
ANF.CEIL = UPrim1 -> Args -> Instr
emitP1 UPrim1
CEIL
emitPOp POp
ANF.FLOR = UPrim1 -> Args -> Instr
emitP1 UPrim1
FLOR
emitPOp POp
ANF.TRNF = UPrim1 -> Args -> Instr
emitP1 UPrim1
TRNF
emitPOp POp
ANF.RNDF = UPrim1 -> Args -> Instr
emitP1 UPrim1
RNDF
emitPOp POp
ANF.COSF = UPrim1 -> Args -> Instr
emitP1 UPrim1
COSF
emitPOp POp
ANF.SINF = UPrim1 -> Args -> Instr
emitP1 UPrim1
SINF
emitPOp POp
ANF.TANF = UPrim1 -> Args -> Instr
emitP1 UPrim1
TANF
emitPOp POp
ANF.COSH = UPrim1 -> Args -> Instr
emitP1 UPrim1
COSH
emitPOp POp
ANF.SINH = UPrim1 -> Args -> Instr
emitP1 UPrim1
SINH
emitPOp POp
ANF.TANH = UPrim1 -> Args -> Instr
emitP1 UPrim1
TANH
emitPOp POp
ANF.ACOS = UPrim1 -> Args -> Instr
emitP1 UPrim1
ACOS
emitPOp POp
ANF.ATAN = UPrim1 -> Args -> Instr
emitP1 UPrim1
ATAN
emitPOp POp
ANF.ASIN = UPrim1 -> Args -> Instr
emitP1 UPrim1
ASIN
emitPOp POp
ANF.ACSH = UPrim1 -> Args -> Instr
emitP1 UPrim1
ACSH
emitPOp POp
ANF.ASNH = UPrim1 -> Args -> Instr
emitP1 UPrim1
ASNH
emitPOp POp
ANF.ATNH = UPrim1 -> Args -> Instr
emitP1 UPrim1
ATNH
emitPOp POp
ANF.ATN2 = UPrim2 -> Args -> Instr
emitP2 UPrim2
ATN2
-- conversions
emitPOp POp
ANF.ITOF = UPrim1 -> Args -> Instr
emitP1 UPrim1
ITOF
emitPOp POp
ANF.NTOF = UPrim1 -> Args -> Instr
emitP1 UPrim1
NTOF
emitPOp POp
ANF.ITOT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
ITOT
emitPOp POp
ANF.NTOT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
NTOT
emitPOp POp
ANF.FTOT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
FTOT
emitPOp POp
ANF.TTON = BPrim1 -> Args -> Instr
emitBP1 BPrim1
TTON
emitPOp POp
ANF.TTOI = BPrim1 -> Args -> Instr
emitBP1 BPrim1
TTOI
emitPOp POp
ANF.TTOF = BPrim1 -> Args -> Instr
emitBP1 BPrim1
TTOF
-- text
emitPOp POp
ANF.CATT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
CATT
emitPOp POp
ANF.TAKT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
TAKT
emitPOp POp
ANF.DRPT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
DRPT
emitPOp POp
ANF.IXOT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
IXOT
emitPOp POp
ANF.SIZT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
SIZT
emitPOp POp
ANF.UCNS = BPrim1 -> Args -> Instr
emitBP1 BPrim1
UCNS
emitPOp POp
ANF.USNC = BPrim1 -> Args -> Instr
emitBP1 BPrim1
USNC
emitPOp POp
ANF.EQLT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
EQLT
emitPOp POp
ANF.LEQT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
LEQT
emitPOp POp
ANF.PAKT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
PAKT
emitPOp POp
ANF.UPKT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
UPKT
-- sequence
emitPOp POp
ANF.CATS = BPrim2 -> Args -> Instr
emitBP2 BPrim2
CATS
emitPOp POp
ANF.TAKS = BPrim2 -> Args -> Instr
emitBP2 BPrim2
TAKS
emitPOp POp
ANF.DRPS = BPrim2 -> Args -> Instr
emitBP2 BPrim2
DRPS
emitPOp POp
ANF.SIZS = BPrim1 -> Args -> Instr
emitBP1 BPrim1
SIZS
emitPOp POp
ANF.CONS = BPrim2 -> Args -> Instr
emitBP2 BPrim2
CONS
emitPOp POp
ANF.SNOC = BPrim2 -> Args -> Instr
emitBP2 BPrim2
SNOC
emitPOp POp
ANF.IDXS = BPrim2 -> Args -> Instr
emitBP2 BPrim2
IDXS
emitPOp POp
ANF.VWLS = BPrim1 -> Args -> Instr
emitBP1 BPrim1
VWLS
emitPOp POp
ANF.VWRS = BPrim1 -> Args -> Instr
emitBP1 BPrim1
VWRS
emitPOp POp
ANF.SPLL = BPrim2 -> Args -> Instr
emitBP2 BPrim2
SPLL
emitPOp POp
ANF.SPLR = BPrim2 -> Args -> Instr
emitBP2 BPrim2
SPLR
-- bytes
emitPOp POp
ANF.PAKB = BPrim1 -> Args -> Instr
emitBP1 BPrim1
PAKB
emitPOp POp
ANF.UPKB = BPrim1 -> Args -> Instr
emitBP1 BPrim1
UPKB
emitPOp POp
ANF.TAKB = BPrim2 -> Args -> Instr
emitBP2 BPrim2
TAKB
emitPOp POp
ANF.DRPB = BPrim2 -> Args -> Instr
emitBP2 BPrim2
DRPB
emitPOp POp
ANF.IXOB = BPrim2 -> Args -> Instr
emitBP2 BPrim2
IXOB
emitPOp POp
ANF.IDXB = BPrim2 -> Args -> Instr
emitBP2 BPrim2
IDXB
emitPOp POp
ANF.SIZB = BPrim1 -> Args -> Instr
emitBP1 BPrim1
SIZB
emitPOp POp
ANF.FLTB = BPrim1 -> Args -> Instr
emitBP1 BPrim1
FLTB
emitPOp POp
ANF.CATB = BPrim2 -> Args -> Instr
emitBP2 BPrim2
CATB
-- universal comparison
emitPOp POp
ANF.EQLU = BPrim2 -> Args -> Instr
emitBP2 BPrim2
EQLU
emitPOp POp
ANF.CMPU = BPrim2 -> Args -> Instr
emitBP2 BPrim2
CMPU
-- code operations
emitPOp POp
ANF.MISS = BPrim1 -> Args -> Instr
emitBP1 BPrim1
MISS
emitPOp POp
ANF.CACH = BPrim1 -> Args -> Instr
emitBP1 BPrim1
CACH
emitPOp POp
ANF.LKUP = BPrim1 -> Args -> Instr
emitBP1 BPrim1
LKUP
emitPOp POp
ANF.TLTT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
TLTT
emitPOp POp
ANF.CVLD = BPrim1 -> Args -> Instr
emitBP1 BPrim1
CVLD
emitPOp POp
ANF.LOAD = BPrim1 -> Args -> Instr
emitBP1 BPrim1
LOAD
emitPOp POp
ANF.VALU = BPrim1 -> Args -> Instr
emitBP1 BPrim1
VALU
emitPOp POp
ANF.SDBX = BPrim2 -> Args -> Instr
emitBP2 BPrim2
SDBX
emitPOp POp
ANF.SDBL = BPrim1 -> Args -> Instr
emitBP1 BPrim1
SDBL
emitPOp POp
ANF.SDBV = BPrim2 -> Args -> Instr
emitBP2 BPrim2
SDBV
-- error call
emitPOp POp
ANF.EROR = BPrim2 -> Args -> Instr
emitBP2 BPrim2
THRO
emitPOp POp
ANF.TRCE = BPrim2 -> Args -> Instr
emitBP2 BPrim2
TRCE
emitPOp POp
ANF.DBTX = BPrim1 -> Args -> Instr
emitBP1 BPrim1
DBTX
-- non-prim translations
emitPOp POp
ANF.BLDS = Args -> Instr
forall comb. Args -> GInstr comb
Seq
emitPOp POp
ANF.FORK = \case
  BArg1 Int
i -> Int -> Instr
forall comb. Int -> GInstr comb
Fork Int
i
  Args
_ -> [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"fork takes exactly one boxed argument"
emitPOp POp
ANF.ATOM = \case
  BArg1 Int
i -> Int -> Instr
forall comb. Int -> GInstr comb
Atomically Int
i
  Args
_ -> [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"atomically takes exactly one boxed argument"
emitPOp POp
ANF.PRNT = \case
  BArg1 Int
i -> Int -> Instr
forall comb. Int -> GInstr comb
Print Int
i
  Args
_ -> [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"print takes exactly one boxed argument"
emitPOp POp
ANF.INFO = \case
  Args
ZArgs -> [Char] -> Instr
forall comb. [Char] -> GInstr comb
Info [Char]
"debug"
  Args
_ -> [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"info takes no arguments"
emitPOp POp
ANF.TFRC = \case
  BArg1 Int
i -> Int -> Instr
forall comb. Int -> GInstr comb
TryForce Int
i
  Args
_ -> [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"tryEval takes exactly one boxed argument"

-- handled in emitSection because Die is not an instruction

-- Emit machine code for ANF IO operations. These are all translated
-- to 'foreing function' calls, but there is a special case for the
-- standard handle access function, because it does not yield an
-- explicit error.
emitFOp :: ANF.FOp -> Args -> Instr
emitFOp :: Word64 -> Args -> Instr
emitFOp Word64
fop = Bool -> Word64 -> Args -> Instr
forall comb. Bool -> Word64 -> Args -> GInstr comb
ForeignCall Bool
True (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a. Enum a => a -> Int
fromEnum Word64
fop)

-- Helper functions for packing the variable argument representation
-- into the indexes stored in prim op instructions
emitP1 :: UPrim1 -> Args -> Instr
emitP1 :: UPrim1 -> Args -> Instr
emitP1 UPrim1
p (UArg1 Int
i) = UPrim1 -> Int -> Instr
forall comb. UPrim1 -> Int -> GInstr comb
UPrim1 UPrim1
p Int
i
emitP1 UPrim1
p Args
a =
  [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Instr) -> [Char] -> Instr
forall a b. (a -> b) -> a -> b
$
    [Char]
"wrong number of args for unary unboxed primop: "
      [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (UPrim1, Args) -> [Char]
forall a. Show a => a -> [Char]
show (UPrim1
p, Args
a)

emitP2 :: UPrim2 -> Args -> Instr
emitP2 :: UPrim2 -> Args -> Instr
emitP2 UPrim2
p (UArg2 Int
i Int
j) = UPrim2 -> Int -> Int -> Instr
forall comb. UPrim2 -> Int -> Int -> GInstr comb
UPrim2 UPrim2
p Int
i Int
j
emitP2 UPrim2
p Args
a =
  [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Instr) -> [Char] -> Instr
forall a b. (a -> b) -> a -> b
$
    [Char]
"wrong number of args for binary unboxed primop: "
      [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (UPrim2, Args) -> [Char]
forall a. Show a => a -> [Char]
show (UPrim2
p, Args
a)

emitBP1 :: BPrim1 -> Args -> Instr
emitBP1 :: BPrim1 -> Args -> Instr
emitBP1 BPrim1
p (UArg1 Int
i) = BPrim1 -> Int -> Instr
forall comb. BPrim1 -> Int -> GInstr comb
BPrim1 BPrim1
p Int
i
emitBP1 BPrim1
p (BArg1 Int
i) = BPrim1 -> Int -> Instr
forall comb. BPrim1 -> Int -> GInstr comb
BPrim1 BPrim1
p Int
i
emitBP1 BPrim1
p Args
a =
  [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Instr) -> [Char] -> Instr
forall a b. (a -> b) -> a -> b
$
    [Char]
"wrong number of args for unary boxed primop: "
      [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (BPrim1, Args) -> [Char]
forall a. Show a => a -> [Char]
show (BPrim1
p, Args
a)

emitBP2 :: BPrim2 -> Args -> Instr
emitBP2 :: BPrim2 -> Args -> Instr
emitBP2 BPrim2
p (UArg2 Int
i Int
j) = BPrim2 -> Int -> Int -> Instr
forall comb. BPrim2 -> Int -> Int -> GInstr comb
BPrim2 BPrim2
p Int
i Int
j
emitBP2 BPrim2
p (BArg2 Int
i Int
j) = BPrim2 -> Int -> Int -> Instr
forall comb. BPrim2 -> Int -> Int -> GInstr comb
BPrim2 BPrim2
p Int
i Int
j
emitBP2 BPrim2
p (DArg2 Int
i Int
j) = BPrim2 -> Int -> Int -> Instr
forall comb. BPrim2 -> Int -> Int -> GInstr comb
BPrim2 BPrim2
p Int
i Int
j
emitBP2 BPrim2
p Args
a =
  [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Instr) -> [Char] -> Instr
forall a b. (a -> b) -> a -> b
$
    [Char]
"wrong number of args for binary boxed primop: "
      [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (BPrim2, Args) -> [Char]
forall a. Show a => a -> [Char]
show (BPrim2
p, Args
a)

emitDataMatching ::
  (Var v) =>
  Reference ->
  RefNums ->
  Reference ->
  Word64 ->
  RCtx v ->
  Ctx v ->
  EnumMap CTag ([Mem], ANormal v) ->
  Maybe (ANormal v) ->
  Emit Branch
emitDataMatching :: forall v.
Var v =>
Reference
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Emit (GBranch CombIx)
emitDataMatching Reference
r RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx EnumMap CTag ([Mem], ANormal v)
cs Maybe (ANormal v)
df =
  Section -> EnumMap Word64 Section -> GBranch CombIx
forall comb.
GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
TestW (Section -> EnumMap Word64 Section -> GBranch CombIx)
-> Emit Section -> Emit (EnumMap Word64 Section -> GBranch CombIx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emit Section
edf Emit (EnumMap Word64 Section -> GBranch CombIx)
-> Emit (EnumMap Word64 Section) -> Emit (GBranch CombIx)
forall a b. Emit (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([Mem], ANormal v) -> Emit Section)
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit (EnumMap Word64 Section)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse (RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
emitCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx) (EnumMap CTag ([Mem], ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
forall a b. Coercible a b => a -> b
coerce EnumMap CTag ([Mem], ANormal v)
cs)
  where
    -- Note: this is not really accurate. A default data case needs
    -- stack space corresponding to the actual data that shows up there.
    -- However, we currently don't use default cases for data.
    edf :: Emit Section
edf
      | Just ANormal v
co <- Maybe (ANormal v)
df = RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx ANormal v
co
      | Bool
otherwise = Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section) -> Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ [Char] -> Section
forall comb. [Char] -> GSection comb
Die ([Char]
"missing data case for hash " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Reference -> [Char]
forall a. Show a => a -> [Char]
show Reference
r)

-- Emits code corresponding to an unboxed sum match.
-- The match is against a tag on the stack, and cases introduce
-- variables to the middle of the context, because the fields were
-- already there, but it was unknown how many there were until
-- branching on the tag.
emitSumMatching ::
  (Var v) =>
  RefNums ->
  Reference ->
  Word64 ->
  RCtx v ->
  Ctx v ->
  v ->
  Int ->
  EnumMap Word64 ([Mem], ANormal v) ->
  Emit Section
emitSumMatching :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> Int
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit Section
emitSumMatching RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx v
v Int
i EnumMap Word64 ([Mem], ANormal v)
cs =
  Int -> Section -> EnumMap Word64 Section -> Section
forall comb.
Int
-> GSection comb -> EnumMap Word64 (GSection comb) -> GSection comb
MatchW Int
i Section
forall {comb}. GSection comb
edf (EnumMap Word64 Section -> Section)
-> Emit (EnumMap Word64 Section) -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Mem], ANormal v) -> Emit Section)
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit (EnumMap Word64 Section)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse (RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> ([Mem], ANormal v)
-> Emit Section
emitSumCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx v
v) EnumMap Word64 ([Mem], ANormal v)
cs
  where
    edf :: GSection comb
edf = [Char] -> GSection comb
forall comb. [Char] -> GSection comb
Die [Char]
"uncovered unboxed sum case"

emitRequestMatching ::
  (Var v) =>
  RefNums ->
  Reference ->
  Word64 ->
  RCtx v ->
  Ctx v ->
  EnumMap Word64 (EnumMap CTag ([Mem], ANormal v)) ->
  ANormal v ->
  Emit (Section, EnumMap Word64 Branch)
emitRequestMatching :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
-> ANormal v
-> Emit (Section, EnumMap Word64 (GBranch CombIx))
emitRequestMatching RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
hs ANormal v
df = (,) (Section
 -> EnumMap Word64 (GBranch CombIx)
 -> (Section, EnumMap Word64 (GBranch CombIx)))
-> Emit Section
-> Emit
     (EnumMap Word64 (GBranch CombIx)
      -> (Section, EnumMap Word64 (GBranch CombIx)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emit Section
pur Emit
  (EnumMap Word64 (GBranch CombIx)
   -> (Section, EnumMap Word64 (GBranch CombIx)))
-> Emit (EnumMap Word64 (GBranch CombIx))
-> Emit (Section, EnumMap Word64 (GBranch CombIx))
forall a b. Emit (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Emit (EnumMap Word64 (GBranch CombIx))
tops
  where
    pur :: Emit Section
pur = RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
emitCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx ([Mem
BX], ANormal v
df)
    tops :: Emit (EnumMap Word64 (GBranch CombIx))
tops = (EnumMap Word64 ([Mem], ANormal v) -> Emit (GBranch CombIx))
-> EnumMap Word64 (EnumMap Word64 ([Mem], ANormal v))
-> Emit (EnumMap Word64 (GBranch CombIx))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse EnumMap Word64 ([Mem], ANormal v) -> Emit (GBranch CombIx)
f (EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
-> EnumMap Word64 (EnumMap Word64 ([Mem], ANormal v))
forall a b. Coercible a b => a -> b
coerce EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
hs)
    f :: EnumMap Word64 ([Mem], ANormal v) -> Emit (GBranch CombIx)
f EnumMap Word64 ([Mem], ANormal v)
cs = Section -> EnumMap Word64 Section -> GBranch CombIx
forall comb.
GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
TestW Section
forall {comb}. GSection comb
edf (EnumMap Word64 Section -> GBranch CombIx)
-> Emit (EnumMap Word64 Section) -> Emit (GBranch CombIx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Mem], ANormal v) -> Emit Section)
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit (EnumMap Word64 Section)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse (RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
emitCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx) EnumMap Word64 ([Mem], ANormal v)
cs
    edf :: GSection comb
edf = [Char] -> GSection comb
forall comb. [Char] -> GSection comb
Die [Char]
"unhandled ability"

emitLitMatching ::
  (Var v) =>
  (Traversable f) =>
  (Int -> Section -> f Section -> Section) ->
  String ->
  RefNums ->
  Reference ->
  Word64 ->
  RCtx v ->
  Ctx v ->
  Int ->
  f (ANormal v) ->
  Maybe (ANormal v) ->
  Emit Section
emitLitMatching :: forall v (f :: * -> *).
(Var v, Traversable f) =>
(Int -> Section -> f Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> f (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
emitLitMatching Int -> Section -> f Section -> Section
con [Char]
err RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx Int
i f (ANormal v)
cs Maybe (ANormal v)
df =
  Int -> Section -> f Section -> Section
con Int
i (Section -> f Section -> Section)
-> Emit Section -> Emit (f Section -> Section)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emit Section
edf Emit (f Section -> Section) -> Emit (f Section) -> Emit Section
forall a b. Emit (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ANormal v -> Emit Section) -> f (ANormal v) -> Emit (f Section)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse (RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
emitCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (([Mem], ANormal v) -> Emit Section)
-> (ANormal v -> ([Mem], ANormal v)) -> ANormal v -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],)) f (ANormal v)
cs
  where
    edf :: Emit Section
edf
      | Just ANormal v
co <- Maybe (ANormal v)
df = RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx ANormal v
co
      | Bool
otherwise = Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section) -> Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ [Char] -> Section
forall comb. [Char] -> GSection comb
Die [Char]
err

emitCase ::
  (Var v) =>
  RefNums ->
  Reference ->
  Word64 ->
  RCtx v ->
  Ctx v ->
  ([Mem], ANormal v) ->
  Emit Section
emitCase :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
emitCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx ([Mem]
ccs, TAbss [v]
vs ANormal v
bo) =
  RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec ([(v, Mem)] -> Ctx v -> Ctx v
forall v. [(v, Mem)] -> Ctx v -> Ctx v
pushCtx ([v] -> [Mem] -> [(v, Mem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs [Mem]
ccs) Ctx v
ctx) ANormal v
bo

emitSumCase ::
  (Var v) =>
  RefNums ->
  Reference ->
  Word64 ->
  RCtx v ->
  Ctx v ->
  v ->
  ([Mem], ANormal v) ->
  Emit Section
emitSumCase :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> ([Mem], ANormal v)
-> Emit Section
emitSumCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx v
v ([Mem]
ccs, TAbss [v]
vs ANormal v
bo) =
  RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (Ctx v -> v -> [(v, Mem)] -> Ctx v
forall v. Var v => Ctx v -> v -> [(v, Mem)] -> Ctx v
sumCtx Ctx v
ctx v
v ([(v, Mem)] -> Ctx v) -> [(v, Mem)] -> Ctx v
forall a b. (a -> b) -> a -> b
$ [v] -> [Mem] -> [(v, Mem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs [Mem]
ccs) ANormal v
bo

litToMLit :: ANF.Lit -> MLit
litToMLit :: Lit -> MLit
litToMLit (ANF.I Int64
i) = Int -> MLit
MI (Int -> MLit) -> Int -> MLit
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
litToMLit (ANF.N Word64
n) = Int -> MLit
MI (Int -> MLit) -> Int -> MLit
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
litToMLit (ANF.C Char
c) = Int -> MLit
MI (Int -> MLit) -> Int -> MLit
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c
litToMLit (ANF.F Double
d) = Double -> MLit
MD Double
d
litToMLit (ANF.T Text
t) = Text -> MLit
MT Text
t
litToMLit (ANF.LM Referent
r) = Referent -> MLit
MM Referent
r
litToMLit (ANF.LY Reference
r) = Reference -> MLit
MY Reference
r

emitLit :: ANF.Lit -> Instr
emitLit :: Lit -> Instr
emitLit = MLit -> Instr
forall comb. MLit -> GInstr comb
Lit (MLit -> Instr) -> (Lit -> MLit) -> Lit -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> MLit
litToMLit

doubleToInt :: Double -> Int
doubleToInt :: Double -> Int
doubleToInt Double
d = ByteArray -> Int -> Int
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ([Double] -> ByteArray
forall a. Prim a => [a] -> ByteArray
byteArrayFromList [Double
d]) Int
0

emitBLit :: ANF.Lit -> Instr
emitBLit :: Lit -> Instr
emitBLit Lit
l = case Lit
l of
  (ANF.F Double
d) -> Reference -> Word64 -> MLit -> Instr
forall comb. Reference -> Word64 -> MLit -> GInstr comb
BLit Reference
lRef Word64
builtinTypeTag (Int -> MLit
MI (Int -> MLit) -> Int -> MLit
forall a b. (a -> b) -> a -> b
$ Double -> Int
doubleToInt Double
d)
  Lit
_ -> Reference -> Word64 -> MLit -> Instr
forall comb. Reference -> Word64 -> MLit -> GInstr comb
BLit Reference
lRef Word64
builtinTypeTag (Lit -> MLit
litToMLit Lit
l)
  where
    lRef :: Reference
lRef = Lit -> Reference
ANF.litRef Lit
l
    builtinTypeTag :: Word64
    builtinTypeTag :: Word64
builtinTypeTag =
      case Reference -> Map Reference Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Lit -> Reference
ANF.litRef Lit
l) Map Reference Word64
builtinTypeNumbering of
        Maybe Word64
Nothing -> [Char] -> Word64
forall a. HasCallStack => [Char] -> a
error [Char]
"emitBLit: unknown builtin type reference"
        Just Word64
n ->
          let rt :: RTag
rt = Int -> RTag
forall a. Enum a => Int -> a
toEnum (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
           in (RTag -> CTag -> Word64
packTags RTag
rt CTag
0)

-- Emits some fix-up code for calling functions. Some of the
-- variables in scope come from the top-level let rec, but these
-- are definitions, not values on the stack. These definitions cannot
-- be passed directly as function arguments, and must have a
-- corresponding stack entry allocated first. So, this function inserts
-- these allocations and passes the appropriate context into the
-- provided continuation.
emitClosures ::
  (Var v) =>
  Reference ->
  Word64 ->
  RCtx v ->
  Ctx v ->
  [v] ->
  (Ctx v -> Args -> Emit Section) ->
  Emit Section
emitClosures :: forall v.
Var v =>
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
emitClosures Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx [v]
args Ctx v -> Args -> Emit Section
k =
  Ctx v -> [v] -> (Ctx v -> Emit Section) -> Emit Section
allocate Ctx v
ctx [v]
args ((Ctx v -> Emit Section) -> Emit Section)
-> (Ctx v -> Emit Section) -> Emit Section
forall a b. (a -> b) -> a -> b
$ \Ctx v
ctx -> Ctx v -> Args -> Emit Section
k Ctx v
ctx (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Word64 -> Ctx v -> [v] -> Args
forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args
  where
    allocate :: Ctx v -> [v] -> (Ctx v -> Emit Section) -> Emit Section
allocate Ctx v
ctx [] Ctx v -> Emit Section
k = Ctx v -> Emit Section
k Ctx v
ctx
    allocate Ctx v
ctx (v
a : [v]
as) Ctx v -> Emit Section
k
      | Just (Int, Mem)
_ <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
a = Ctx v -> [v] -> (Ctx v -> Emit Section) -> Emit Section
allocate Ctx v
ctx [v]
as Ctx v -> Emit Section
k
      | Just Word64
n <- RCtx v -> v -> Maybe Word64
forall v. Var v => RCtx v -> v -> Maybe Word64
rctxResolve RCtx v
rec v
a =
          Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> Instr
forall comb. GRef comb -> Args -> GInstr comb
Name (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
n)) Args
ZArgs) (Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx v -> [v] -> (Ctx v -> Emit Section) -> Emit Section
allocate (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
a Mem
BX Ctx v
ctx) [v]
as Ctx v -> Emit Section
k
      | Bool
otherwise =
          [Char] -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section) -> [Char] -> Emit Section
forall a b. (a -> b) -> a -> b
$ [Char]
"emitClosures: unknown reference: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> [Char]
forall a. Show a => a -> [Char]
show v
a

emitArgs :: (Var v) => Word64 -> Ctx v -> [v] -> Args
emitArgs :: forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args
  | Just [(Int, Mem)]
l <- (v -> Maybe (Int, Mem)) -> [v] -> Maybe [(Int, Mem)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx) [v]
args = [(Int, Mem)] -> Args
demuxArgs [(Int, Mem)]
l
  | Bool
otherwise =
      [Char] -> Args
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Args) -> [Char] -> Args
forall a b. (a -> b) -> a -> b
$
        [Char]
"emitArgs["
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
grpn
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]: "
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"could not resolve argument variables: "
          [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [v] -> [Char]
forall a. Show a => a -> [Char]
show [v]
args

-- Turns a list of stack positions and calling conventions into the
-- argument format expected in the machine code.
demuxArgs :: [(Int, Mem)] -> Args
demuxArgs :: [(Int, Mem)] -> Args
demuxArgs [(Int, Mem)]
as0 =
  case ([(Int, Mem)] -> [Int])
-> ([(Int, Mem)] -> [Int])
-> ([(Int, Mem)], [(Int, Mem)])
-> ([Int], [Int])
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 (((Int, Mem) -> Int) -> [(Int, Mem)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Mem) -> Int
forall a b. (a, b) -> a
fst) (((Int, Mem) -> Int) -> [(Int, Mem)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Mem) -> Int
forall a b. (a, b) -> a
fst) (([(Int, Mem)], [(Int, Mem)]) -> ([Int], [Int]))
-> ([(Int, Mem)], [(Int, Mem)]) -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ ((Int, Mem) -> Bool)
-> [(Int, Mem)] -> ([(Int, Mem)], [(Int, Mem)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Mem -> Mem -> Bool
forall a. Eq a => a -> a -> Bool
== Mem
UN) (Mem -> Bool) -> ((Int, Mem) -> Mem) -> (Int, Mem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Mem) -> Mem
forall a b. (a, b) -> b
snd) [(Int, Mem)]
as0 of
    ([], []) -> Args
ZArgs
    ([], [Int
i]) -> Int -> Args
BArg1 Int
i
    ([], [Int
i, Int
j]) -> Int -> Int -> Args
BArg2 Int
i Int
j
    ([Int
i], []) -> Int -> Args
UArg1 Int
i
    ([Int
i, Int
j], []) -> Int -> Int -> Args
UArg2 Int
i Int
j
    ([Int
i], [Int
j]) -> Int -> Int -> Args
DArg2 Int
i Int
j
    ([], [Int]
bs) -> PrimArray Int -> Args
BArgN (PrimArray Int -> Args) -> PrimArray Int -> Args
forall a b. (a -> b) -> a -> b
$ [Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
bs
    ([Int]
us, []) -> PrimArray Int -> Args
UArgN (PrimArray Int -> Args) -> PrimArray Int -> Args
forall a b. (a -> b) -> a -> b
$ [Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
us
    -- TODO: handle ranges
    ([Int]
us, [Int]
bs) -> PrimArray Int -> PrimArray Int -> Args
DArgN ([Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
us) ([Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
bs)

combDeps :: Comb -> [Word64]
combDeps :: Comb -> [Word64]
combDeps (Lam Int
_ Int
_ Int
_ Int
_ Section
s) = Section -> [Word64]
sectionDeps Section
s

combTypes :: Comb -> [Word64]
combTypes :: Comb -> [Word64]
combTypes (Lam Int
_ Int
_ Int
_ Int
_ Section
s) = Section -> [Word64]
sectionTypes Section
s

sectionDeps :: Section -> [Word64]
sectionDeps :: Section -> [Word64]
sectionDeps (App Bool
_ (Env (CIx Reference
_ Word64
w Word64
_)) Args
_) = [Word64
w]
sectionDeps (Call Bool
_ (CIx Reference
_ Word64
w Word64
_) Args
_) = [Word64
w]
sectionDeps (Match Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchDeps GBranch CombIx
br
sectionDeps (DMatch Maybe Reference
_ Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchDeps GBranch CombIx
br
sectionDeps (RMatch Int
_ Section
pu EnumMap Word64 (GBranch CombIx)
br) =
  Section -> [Word64]
sectionDeps Section
pu [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (GBranch CombIx -> [Word64])
-> EnumMap Word64 (GBranch CombIx) -> [Word64]
forall m a. Monoid m => (a -> m) -> EnumMap Word64 a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GBranch CombIx -> [Word64]
branchDeps EnumMap Word64 (GBranch CombIx)
br
sectionDeps (NMatch Maybe Reference
_ Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchDeps GBranch CombIx
br
sectionDeps (Ins Instr
i Section
s)
  | Name (Env (CIx Reference
_ Word64
w Word64
_)) Args
_ <- Instr
i = Word64
w Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: Section -> [Word64]
sectionDeps Section
s
  | Bool
otherwise = Section -> [Word64]
sectionDeps Section
s
sectionDeps (Let Section
s (CIx Reference
_ Word64
w Word64
_)) = Word64
w Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: Section -> [Word64]
sectionDeps Section
s
sectionDeps Section
_ = []

sectionTypes :: Section -> [Word64]
sectionTypes :: Section -> [Word64]
sectionTypes (Ins Instr
i Section
s) = Instr -> [Word64]
instrTypes Instr
i [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionTypes Section
s
sectionTypes (Let Section
s CombIx
_) = Section -> [Word64]
sectionTypes Section
s
sectionTypes (Match Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchTypes GBranch CombIx
br
sectionTypes (DMatch Maybe Reference
_ Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchTypes GBranch CombIx
br
sectionTypes (NMatch Maybe Reference
_ Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchTypes GBranch CombIx
br
sectionTypes (RMatch Int
_ Section
pu EnumMap Word64 (GBranch CombIx)
br) =
  Section -> [Word64]
sectionTypes Section
pu [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (GBranch CombIx -> [Word64])
-> EnumMap Word64 (GBranch CombIx) -> [Word64]
forall m a. Monoid m => (a -> m) -> EnumMap Word64 a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GBranch CombIx -> [Word64]
branchTypes EnumMap Word64 (GBranch CombIx)
br
sectionTypes Section
_ = []

instrTypes :: Instr -> [Word64]
instrTypes :: Instr -> [Word64]
instrTypes (Pack Reference
_ Word64
w Args
_) = [Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16]
instrTypes (Reset EnumSet Word64
ws) = EnumSet Word64 -> [Word64]
forall k. EnumKey k => EnumSet k -> [k]
setToList EnumSet Word64
ws
instrTypes (Capture Word64
w) = [Word64
w]
instrTypes (SetDyn Word64
w Int
_) = [Word64
w]
instrTypes Instr
_ = []

branchDeps :: Branch -> [Word64]
branchDeps :: GBranch CombIx -> [Word64]
branchDeps (Test1 Word64
_ Section
s1 Section
d) = Section -> [Word64]
sectionDeps Section
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionDeps Section
d
branchDeps (Test2 Word64
_ Section
s1 Word64
_ Section
s2 Section
d) =
  Section -> [Word64]
sectionDeps Section
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionDeps Section
s2 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionDeps Section
d
branchDeps (TestW Section
d EnumMap Word64 Section
m) =
  Section -> [Word64]
sectionDeps Section
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (Section -> [Word64]) -> EnumMap Word64 Section -> [Word64]
forall m a. Monoid m => (a -> m) -> EnumMap Word64 a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Section -> [Word64]
sectionDeps EnumMap Word64 Section
m
branchDeps (TestT Section
d Map Text Section
m) =
  Section -> [Word64]
sectionDeps Section
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (Section -> [Word64]) -> Map Text Section -> [Word64]
forall m a. Monoid m => (a -> m) -> Map Text a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Section -> [Word64]
sectionDeps Map Text Section
m

branchTypes :: Branch -> [Word64]
branchTypes :: GBranch CombIx -> [Word64]
branchTypes (Test1 Word64
_ Section
s1 Section
d) = Section -> [Word64]
sectionTypes Section
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionTypes Section
d
branchTypes (Test2 Word64
_ Section
s1 Word64
_ Section
s2 Section
d) =
  Section -> [Word64]
sectionTypes Section
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionTypes Section
s2 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionTypes Section
d
branchTypes (TestW Section
d EnumMap Word64 Section
m) =
  Section -> [Word64]
sectionTypes Section
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (Section -> [Word64]) -> EnumMap Word64 Section -> [Word64]
forall m a. Monoid m => (a -> m) -> EnumMap Word64 a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Section -> [Word64]
sectionTypes EnumMap Word64 Section
m
branchTypes (TestT Section
d Map Text Section
m) =
  Section -> [Word64]
sectionTypes Section
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (Section -> [Word64]) -> Map Text Section -> [Word64]
forall m a. Monoid m => (a -> m) -> Map Text a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Section -> [Word64]
sectionTypes Map Text Section
m

indent :: Int -> ShowS
indent :: Int -> ShowS
indent Int
ind = [Char] -> ShowS
showString (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' ')

prettyCombs ::
  Word64 ->
  EnumMap Word64 Comb ->
  ShowS
prettyCombs :: Word64 -> EnumMap Word64 Comb -> ShowS
prettyCombs Word64
w EnumMap Word64 Comb
es =
  ((Word64, Comb) -> ShowS -> ShowS)
-> ShowS -> [(Word64, Comb)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\(Word64
i, Comb
c) ShowS
r -> Word64 -> Word64 -> Comb -> ShowS
prettyComb Word64
w Word64
i Comb
c ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r)
    ShowS
forall a. a -> a
id
    (EnumMap Word64 Comb -> [(Word64, Comb)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 Comb
es)

prettyComb :: Word64 -> Word64 -> Comb -> ShowS
prettyComb :: Word64 -> Word64 -> Comb -> ShowS
prettyComb Word64
w Word64
i (Lam Int
ua Int
ba Int
_ Int
_ Section
s) =
  Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
w
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
":"
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
i
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
ua, Int
ba]
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
":\n"
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection Int
2 Section
s

prettySection :: Int -> Section -> ShowS
prettySection :: Int -> Section -> ShowS
prettySection Int
ind Section
sec =
  Int -> ShowS
indent Int
ind ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Section
sec of
    App Bool
_ GRef CombIx
r Args
as ->
      [Char] -> ShowS
showString [Char]
"App "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GRef CombIx -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
12 GRef CombIx
r
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> ShowS
prettyArgs Args
as
    Call Bool
_ CombIx
i Args
as ->
      [Char] -> ShowS
showString [Char]
"Call " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CombIx -> ShowS
forall a. Show a => a -> ShowS
shows CombIx
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> ShowS
prettyArgs Args
as
    Jump Int
i Args
as ->
      [Char] -> ShowS
showString [Char]
"Jump " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> ShowS
prettyArgs Args
as
    Match Int
i GBranch CombIx
bs ->
      [Char] -> ShowS
showString [Char]
"Match "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GBranch CombIx -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch CombIx
bs
    Yield Args
as -> [Char] -> ShowS
showString [Char]
"Yield " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> ShowS
prettyArgs Args
as
    Ins Instr
i Section
nx ->
      Instr -> ShowS
prettyIns Instr
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection Int
ind Section
nx
    Let Section
s CombIx
n ->
      [Char] -> ShowS
showString [Char]
"Let\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Section
s
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
ind
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CombIx -> ShowS
prettyIx CombIx
n
    Die [Char]
s -> [Char] -> ShowS
showString ([Char] -> ShowS) -> [Char] -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"Die " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s
    Section
Exit -> [Char] -> ShowS
showString [Char]
"Exit"
    DMatch Maybe Reference
_ Int
i GBranch CombIx
bs ->
      [Char] -> ShowS
showString [Char]
"DMatch "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GBranch CombIx -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch CombIx
bs
    NMatch Maybe Reference
_ Int
i GBranch CombIx
bs ->
      [Char] -> ShowS
showString [Char]
"NMatch "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GBranch CombIx -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch CombIx
bs
    RMatch Int
i Section
pu EnumMap Word64 (GBranch CombIx)
bs ->
      [Char] -> ShowS
showString [Char]
"RMatch "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\nPUR ->\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Section
pu
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, GBranch CombIx) -> ShowS -> ShowS)
-> ShowS -> [(Word64, GBranch CombIx)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Word64, GBranch CombIx)
p ShowS
r -> (Word64, GBranch CombIx) -> ShowS
rqc (Word64, GBranch CombIx)
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id (EnumMap Word64 (GBranch CombIx) -> [(Word64, GBranch CombIx)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 (GBranch CombIx)
bs)
      where
        rqc :: (Word64, GBranch CombIx) -> ShowS
rqc (Word64
i, GBranch CombIx
e) =
          [Char] -> ShowS
showString [Char]
"\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
i
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" ->\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GBranch CombIx -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch CombIx
e

prettyIx :: CombIx -> ShowS
prettyIx :: CombIx -> ShowS
prettyIx (CIx Reference
_ Word64
c Word64
s) =
  [Char] -> ShowS
showString [Char]
"Resume["
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
c
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
","
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
s
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"]"

prettyBranches :: Int -> Branch -> ShowS
prettyBranches :: Int -> GBranch CombIx -> ShowS
prettyBranches Int
ind GBranch CombIx
bs =
  case GBranch CombIx
bs of
    Test1 Word64
i Section
e Section
df -> Section -> ShowS
pdf Section
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Section -> ShowS
picase Word64
i Section
e
    Test2 Word64
i Section
ei Word64
j Section
ej Section
df -> Section -> ShowS
pdf Section
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Section -> ShowS
picase Word64
i Section
ei ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Section -> ShowS
picase Word64
j Section
ej
    TestW Section
df EnumMap Word64 Section
m ->
      Section -> ShowS
pdf Section
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, Section) -> ShowS -> ShowS)
-> ShowS -> [(Word64, Section)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Word64
i, Section
e) ShowS
r -> Word64 -> Section -> ShowS
picase Word64
i Section
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id (EnumMap Word64 Section -> [(Word64, Section)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 Section
m)
    TestT Section
df Map Text Section
m ->
      Section -> ShowS
pdf Section
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Section) -> ShowS -> ShowS)
-> ShowS -> [(Text, Section)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Text
i, Section
e) ShowS
r -> Text -> Section -> ShowS
ptcase Text
i Section
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id (Map Text Section -> [(Text, Section)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Section
m)
  where
    pdf :: Section -> ShowS
pdf Section
e = Int -> ShowS
indent Int
ind ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"DFLT ->\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Section
e
    ptcase :: Text -> Section -> ShowS
ptcase Text
t Section
e =
      [Char] -> ShowS
showString [Char]
"\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
ind
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShowS
forall a. Show a => a -> ShowS
shows Text
t
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" ->\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Section
e
    picase :: Word64 -> Section -> ShowS
picase Word64
i Section
e =
      [Char] -> ShowS
showString [Char]
"\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
ind
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
i
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" ->\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Section
e

un :: ShowS
un :: ShowS
un = (Char
'U' Char -> ShowS
forall a. a -> [a] -> [a]
:)

bx :: ShowS
bx :: ShowS
bx = (Char
'B' Char -> ShowS
forall a. a -> [a] -> [a]
:)

prettyIns :: Instr -> ShowS
prettyIns :: Instr -> ShowS
prettyIns (Pack Reference
r Word64
i Args
as) =
  [Char] -> ShowS
showString [Char]
"Pack "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Reference -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 Reference
r
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
i
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> ShowS
prettyArgs Args
as
prettyIns Instr
i = Instr -> ShowS
forall a. Show a => a -> ShowS
shows Instr
i

prettyArgs :: Args -> ShowS
prettyArgs :: Args -> ShowS
prettyArgs Args
ZArgs = forall a. Show a => a -> ShowS
shows @[Int] []
prettyArgs (UArg1 Int
i) = ShowS
un ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i]
prettyArgs (BArg1 Int
i) = ShowS
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i]
prettyArgs (UArg2 Int
i Int
j) = ShowS
un ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i, Int
j]
prettyArgs (BArg2 Int
i Int
j) = ShowS
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i, Int
j]
prettyArgs (DArg2 Int
i Int
j) = ShowS
un ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i] ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
j]
prettyArgs (UArgR Int
i Int
l) = ShowS
un ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
Prelude.take Int
l [Int
i ..])
prettyArgs (BArgR Int
i Int
l) = ShowS
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
Prelude.take Int
l [Int
i ..])
prettyArgs (DArgR Int
i Int
l Int
j Int
k) =
  ShowS
un
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
Prelude.take Int
l [Int
i ..])
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
bx
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
Prelude.take Int
k [Int
j ..])
prettyArgs (UArgN PrimArray Int
v) = ShowS
un ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
v)
prettyArgs (BArgN PrimArray Int
v) = ShowS
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
v)
prettyArgs (DArgN PrimArray Int
u PrimArray Int
b) =
  ShowS
un
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
u)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
bx
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
b)
prettyArgs (DArgV Int
i Int
j) = (Char
'V' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i, Int
j]