{-# 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 (.., Lam),
    GCombInfo (..),
    Comb,
    RComb (..),
    RCombInfo,
    GCombs,
    RCombs,
    CombIx (..),
    GRef (..),
    RRef,
    Ref,
    UPrim1 (..),
    UPrim2 (..),
    BPrim1 (..),
    BPrim2 (..),
    GBranch (..),
    Branch,
    RBranch,
    emitCombs,
    emitComb,
    resolveCombs,
    sanitizeCombsOfForeignFuncs,
    absurdCombs,
    emptyRNs,
    argsToLists,
    countArgs,
    combRef,
    combDeps,
    combTypes,
    prettyCombs,
    prettyComb,
  )
where

import Data.Bifoldable (Bifoldable (..))
import Data.Bifunctor (Bifunctor, bimap, first)
import Data.Bitraversable (Bitraversable (..), bifoldMapDefault, bimapDefault)
import Data.Bits (shiftL, shiftR, (.|.))
import Data.Coerce
import Data.Functor ((<&>))
import Data.Map.Strict qualified as M
import Data.Primitive.PrimArray
import Data.Primitive.PrimArray qualified as PA
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.Void (Void, absurd)
import Data.Word (Word16, Word64)
import GHC.Stack (HasCallStack)
import Unison.ABT.Normalized (pattern TAbss)
import Unison.Reference (Reference, showShort)
import Unison.Referent (Referent)
import Unison.Runtime.ANF
  ( ANormal,
    Branched (..),
    CTag,
    Direction (..),
    Func (..),
    Mem (..),
    PackedTag (..),
    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.Foreign.Function.Type (ForeignFunc (..), foreignFuncBuiltinName)
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 Sandboxed = Tracked | Untracked
  deriving (Int -> Sandboxed -> ShowS
[Sandboxed] -> ShowS
Sandboxed -> [Char]
(Int -> Sandboxed -> ShowS)
-> (Sandboxed -> [Char])
-> ([Sandboxed] -> ShowS)
-> Show Sandboxed
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sandboxed -> ShowS
showsPrec :: Int -> Sandboxed -> ShowS
$cshow :: Sandboxed -> [Char]
show :: Sandboxed -> [Char]
$cshowList :: [Sandboxed] -> ShowS
showList :: [Sandboxed] -> ShowS
Show, Sandboxed -> Sandboxed -> Bool
(Sandboxed -> Sandboxed -> Bool)
-> (Sandboxed -> Sandboxed -> Bool) -> Eq Sandboxed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sandboxed -> Sandboxed -> Bool
== :: Sandboxed -> Sandboxed -> Bool
$c/= :: Sandboxed -> Sandboxed -> Bool
/= :: Sandboxed -> Sandboxed -> Bool
Eq, Eq Sandboxed
Eq Sandboxed =>
(Sandboxed -> Sandboxed -> Ordering)
-> (Sandboxed -> Sandboxed -> Bool)
-> (Sandboxed -> Sandboxed -> Bool)
-> (Sandboxed -> Sandboxed -> Bool)
-> (Sandboxed -> Sandboxed -> Bool)
-> (Sandboxed -> Sandboxed -> Sandboxed)
-> (Sandboxed -> Sandboxed -> Sandboxed)
-> Ord Sandboxed
Sandboxed -> Sandboxed -> Bool
Sandboxed -> Sandboxed -> Ordering
Sandboxed -> Sandboxed -> Sandboxed
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 :: Sandboxed -> Sandboxed -> Ordering
compare :: Sandboxed -> Sandboxed -> Ordering
$c< :: Sandboxed -> Sandboxed -> Bool
< :: Sandboxed -> Sandboxed -> Bool
$c<= :: Sandboxed -> Sandboxed -> Bool
<= :: Sandboxed -> Sandboxed -> Bool
$c> :: Sandboxed -> Sandboxed -> Bool
> :: Sandboxed -> Sandboxed -> Bool
$c>= :: Sandboxed -> Sandboxed -> Bool
>= :: Sandboxed -> Sandboxed -> Bool
$cmax :: Sandboxed -> Sandboxed -> Sandboxed
max :: Sandboxed -> Sandboxed -> Sandboxed
$cmin :: Sandboxed -> Sandboxed -> Sandboxed
min :: Sandboxed -> Sandboxed -> Sandboxed
Ord)

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
  | VArg1 !Int
  | VArg2 !Int !Int
  | VArgR !Int !Int
  | VArgN {-# UNPACK #-} !(PrimArray Int)
  | VArgV !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]
argsToLists :: Args -> [Int]
argsToLists = \case
  Args
ZArgs -> []
  VArg1 Int
i -> [Int
i]
  VArg2 Int
i Int
j -> [Int
i, Int
j]
  VArgR Int
i Int
l -> Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
l [Int
i ..]
  VArgN PrimArray Int
us -> PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
us
  VArgV Int
_ -> [Char] -> [Int]
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"argsToLists: DArgV"
{-# INLINEABLE argsToLists #-}

countArgs :: Args -> Int
countArgs :: Args -> Int
countArgs Args
ZArgs = Int
0
countArgs (VArg1 {}) = Int
1
countArgs (VArg2 {}) = Int
2
countArgs (VArgR Int
_ Int
l) = Int
l
countArgs (VArgN PrimArray Int
us) = PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Int
us
countArgs (VArgV {}) = [Char] -> Int
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"countArgs: DArgV"
{-# INLINEABLE countArgs #-}

data UPrim1
  = -- integral
    DECI -- decrement
  | DECN
  | INCI -- increment
  | INCN
  | NEGI -- negate
  | SGNI -- signum
  | LZRO -- leadingZeroes
  | TZRO -- trailingZeroes
  | COMN -- complement
  | COMI -- complement
  | POPC -- popCount
  -- floating
  | ABSF -- abs
  | EXPF -- exp
  | LOGF -- log
  | SQRT -- sqrt
  | COSF -- cos
  | ACOS -- acos
  | COSH -- cosh
  | ACSH -- acosh
  | SINF -- sin
  | ASIN -- asin
  | SINH -- sinh
  | ASNH -- asinh
  | TANF -- tan
  | ATAN -- atan
  | TANH -- tanh
  | ATNH -- atanh
  | ITOF -- intToFloat
  | NTOF -- natToFloat
  | CEIL -- ceiling
  | FLOR -- floor
  | TRNF -- truncate
  | RNDF -- round
  | TRNC -- truncate
  -- Bools
  | NOTB -- not
  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, Int -> UPrim1
UPrim1 -> Int
UPrim1 -> [UPrim1]
UPrim1 -> UPrim1
UPrim1 -> UPrim1 -> [UPrim1]
UPrim1 -> UPrim1 -> UPrim1 -> [UPrim1]
(UPrim1 -> UPrim1)
-> (UPrim1 -> UPrim1)
-> (Int -> UPrim1)
-> (UPrim1 -> Int)
-> (UPrim1 -> [UPrim1])
-> (UPrim1 -> UPrim1 -> [UPrim1])
-> (UPrim1 -> UPrim1 -> [UPrim1])
-> (UPrim1 -> UPrim1 -> UPrim1 -> [UPrim1])
-> Enum UPrim1
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: UPrim1 -> UPrim1
succ :: UPrim1 -> UPrim1
$cpred :: UPrim1 -> UPrim1
pred :: UPrim1 -> UPrim1
$ctoEnum :: Int -> UPrim1
toEnum :: Int -> UPrim1
$cfromEnum :: UPrim1 -> Int
fromEnum :: UPrim1 -> Int
$cenumFrom :: UPrim1 -> [UPrim1]
enumFrom :: UPrim1 -> [UPrim1]
$cenumFromThen :: UPrim1 -> UPrim1 -> [UPrim1]
enumFromThen :: UPrim1 -> UPrim1 -> [UPrim1]
$cenumFromTo :: UPrim1 -> UPrim1 -> [UPrim1]
enumFromTo :: UPrim1 -> UPrim1 -> [UPrim1]
$cenumFromThenTo :: UPrim1 -> UPrim1 -> UPrim1 -> [UPrim1]
enumFromThenTo :: UPrim1 -> UPrim1 -> UPrim1 -> [UPrim1]
Enum, UPrim1
UPrim1 -> UPrim1 -> Bounded UPrim1
forall a. a -> a -> Bounded a
$cminBound :: UPrim1
minBound :: UPrim1
$cmaxBound :: UPrim1
maxBound :: UPrim1
Bounded)

data UPrim2
  = -- integral
    ADDI -- +
  | ADDN
  | SUBI -- -
  | SUBN
  | MULI
  | MULN
  | DIVI -- /
  | DIVN
  | MODI -- mod
  | MODN
  | SHLI -- shiftl
  | SHLN
  | SHRI -- shiftr
  | SHRN
  | POWI -- pow
  | POWN
  | EQLI -- ==
  | EQLN
  | NEQI -- !=
  | NEQN
  | LEQI -- <=
  | LEQN
  | LESI -- <
  | LESN
  | ANDN -- and
  | ANDI
  | IORN -- or
  | IORI
  | XORN -- xor
  | XORI
  | -- floating
    EQLF -- ==
  | NEQF -- !=
  | LEQF -- <=
  | LESF -- <
  | ADDF -- +
  | SUBF -- -
  | MULF
  | DIVF -- /
  | ATN2 -- atan2
  | POWF -- pow
  | LOGB -- logBase
  | MAXF -- max
  | MINF -- min
  | CAST -- unboxed runtime type cast (int to nat, etc.)
  | DRPN -- dropn
  -- Bools
  | ANDB -- and
  | IORB -- or
  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, Int -> UPrim2
UPrim2 -> Int
UPrim2 -> [UPrim2]
UPrim2 -> UPrim2
UPrim2 -> UPrim2 -> [UPrim2]
UPrim2 -> UPrim2 -> UPrim2 -> [UPrim2]
(UPrim2 -> UPrim2)
-> (UPrim2 -> UPrim2)
-> (Int -> UPrim2)
-> (UPrim2 -> Int)
-> (UPrim2 -> [UPrim2])
-> (UPrim2 -> UPrim2 -> [UPrim2])
-> (UPrim2 -> UPrim2 -> [UPrim2])
-> (UPrim2 -> UPrim2 -> UPrim2 -> [UPrim2])
-> Enum UPrim2
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: UPrim2 -> UPrim2
succ :: UPrim2 -> UPrim2
$cpred :: UPrim2 -> UPrim2
pred :: UPrim2 -> UPrim2
$ctoEnum :: Int -> UPrim2
toEnum :: Int -> UPrim2
$cfromEnum :: UPrim2 -> Int
fromEnum :: UPrim2 -> Int
$cenumFrom :: UPrim2 -> [UPrim2]
enumFrom :: UPrim2 -> [UPrim2]
$cenumFromThen :: UPrim2 -> UPrim2 -> [UPrim2]
enumFromThen :: UPrim2 -> UPrim2 -> [UPrim2]
$cenumFromTo :: UPrim2 -> UPrim2 -> [UPrim2]
enumFromTo :: UPrim2 -> UPrim2 -> [UPrim2]
$cenumFromThenTo :: UPrim2 -> UPrim2 -> UPrim2 -> [UPrim2]
enumFromThenTo :: UPrim2 -> UPrim2 -> UPrim2 -> [UPrim2]
Enum, UPrim2
UPrim2 -> UPrim2 -> Bounded UPrim2
forall a. a -> a -> Bounded a
$cminBound :: UPrim2
minBound :: UPrim2
$cmaxBound :: UPrim2
maxBound :: UPrim2
Bounded)

data BPrim1
  = -- text
    SIZT -- size
  | USNC -- unsnoc
  | UCNS -- uncons
  | ITOT -- intToText
  | NTOT -- natToText
  | FTOT -- floatToText
  | TTOI -- textToInt
  | TTON -- textToNat
  | TTOF -- textToFloat
  | PAKT -- pack
  | UPKT -- unpack
  -- sequence
  | VWLS -- viewl
  | VWRS -- viewr
  | SIZS -- size
  | PAKB -- pack
  | UPKB -- unpack
  | SIZB -- size
  | FLTB -- flatten
  -- code
  | MISS -- isMissing
  | CACH -- cache
  | LKUP -- lookup
  | LOAD -- load
  | CVLD -- validate
  | VALU -- value
  | TLTT --  Term.Link.toText
  -- debug
  | DBTX -- debug text
  | SDBL -- sandbox link list
  | -- Refs
    REFN -- Ref.new
  | REFR -- Ref.read
  | RRFC
  | TIKR
  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, Int -> BPrim1
BPrim1 -> Int
BPrim1 -> [BPrim1]
BPrim1 -> BPrim1
BPrim1 -> BPrim1 -> [BPrim1]
BPrim1 -> BPrim1 -> BPrim1 -> [BPrim1]
(BPrim1 -> BPrim1)
-> (BPrim1 -> BPrim1)
-> (Int -> BPrim1)
-> (BPrim1 -> Int)
-> (BPrim1 -> [BPrim1])
-> (BPrim1 -> BPrim1 -> [BPrim1])
-> (BPrim1 -> BPrim1 -> [BPrim1])
-> (BPrim1 -> BPrim1 -> BPrim1 -> [BPrim1])
-> Enum BPrim1
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BPrim1 -> BPrim1
succ :: BPrim1 -> BPrim1
$cpred :: BPrim1 -> BPrim1
pred :: BPrim1 -> BPrim1
$ctoEnum :: Int -> BPrim1
toEnum :: Int -> BPrim1
$cfromEnum :: BPrim1 -> Int
fromEnum :: BPrim1 -> Int
$cenumFrom :: BPrim1 -> [BPrim1]
enumFrom :: BPrim1 -> [BPrim1]
$cenumFromThen :: BPrim1 -> BPrim1 -> [BPrim1]
enumFromThen :: BPrim1 -> BPrim1 -> [BPrim1]
$cenumFromTo :: BPrim1 -> BPrim1 -> [BPrim1]
enumFromTo :: BPrim1 -> BPrim1 -> [BPrim1]
$cenumFromThenTo :: BPrim1 -> BPrim1 -> BPrim1 -> [BPrim1]
enumFromThenTo :: BPrim1 -> BPrim1 -> BPrim1 -> [BPrim1]
Enum, BPrim1
BPrim1 -> BPrim1 -> Bounded BPrim1
forall a. a -> a -> Bounded a
$cminBound :: BPrim1
minBound :: BPrim1
$cmaxBound :: BPrim1
maxBound :: BPrim1
Bounded)

data BPrim2
  = -- universal
    EQLU -- ==
  | CMPU -- compare
  | LEQU -- <=
  | LESU -- <
  -- text
  | DRPT -- drop
  | CATT -- append
  | TAKT -- take
  | IXOT -- indexof
  | EQLT -- ==
  | LEQT -- <=
  | LEST -- <
  -- sequence
  | DRPS -- drop
  | CATS -- append
  | TAKS -- take
  | CONS -- cons
  | SNOC -- snoc
  | IDXS -- index
  | SPLL -- splitLeft
  | SPLR -- splitRight
  -- bytes
  | TAKB -- take
  | DRPB -- drop
  | IDXB -- index
  | CATB -- append
  | IXOB -- indexof
  -- general
  | THRO -- throw
  | TRCE -- trace
  -- code
  | SDBX -- sandbox
  | SDBV -- sandbox Value
  -- Refs
  | REFW -- Ref.write
  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, Int -> BPrim2
BPrim2 -> Int
BPrim2 -> [BPrim2]
BPrim2 -> BPrim2
BPrim2 -> BPrim2 -> [BPrim2]
BPrim2 -> BPrim2 -> BPrim2 -> [BPrim2]
(BPrim2 -> BPrim2)
-> (BPrim2 -> BPrim2)
-> (Int -> BPrim2)
-> (BPrim2 -> Int)
-> (BPrim2 -> [BPrim2])
-> (BPrim2 -> BPrim2 -> [BPrim2])
-> (BPrim2 -> BPrim2 -> [BPrim2])
-> (BPrim2 -> BPrim2 -> BPrim2 -> [BPrim2])
-> Enum BPrim2
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BPrim2 -> BPrim2
succ :: BPrim2 -> BPrim2
$cpred :: BPrim2 -> BPrim2
pred :: BPrim2 -> BPrim2
$ctoEnum :: Int -> BPrim2
toEnum :: Int -> BPrim2
$cfromEnum :: BPrim2 -> Int
fromEnum :: BPrim2 -> Int
$cenumFrom :: BPrim2 -> [BPrim2]
enumFrom :: BPrim2 -> [BPrim2]
$cenumFromThen :: BPrim2 -> BPrim2 -> [BPrim2]
enumFromThen :: BPrim2 -> BPrim2 -> [BPrim2]
$cenumFromTo :: BPrim2 -> BPrim2 -> [BPrim2]
enumFromTo :: BPrim2 -> BPrim2 -> [BPrim2]
$cenumFromThenTo :: BPrim2 -> BPrim2 -> BPrim2 -> [BPrim2]
enumFromThenTo :: BPrim2 -> BPrim2 -> BPrim2 -> [BPrim2]
Enum, BPrim2
BPrim2 -> BPrim2 -> Bounded BPrim2
forall a. a -> a -> Bounded a
$cminBound :: BPrim2
minBound :: BPrim2
$cmaxBound :: BPrim2
maxBound :: BPrim2
Bounded)

data MLit
  = MI !Int
  | MN !Word64
  | MC !Char
  | MD !Double
  | MT !Text
  | MM !Referent -- Term Link
  | MY !Reference -- Type Link
  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 val = GInstr (RComb val)

-- 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
  | -- Use a check-and-set ticket to update a reference
    -- (ref stack index, ticket stack index, new value stack index)
    RefCAS !Int !Int !Int
  | -- Call out to a Haskell function.
    ForeignCall
      !Bool -- catch exceptions
      !ForeignFunc -- 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
      !PackedTag -- tag
      !Args -- arguments to pack
  | -- Push a particular value onto the appropriate stack
    Lit !MLit -- value to push onto the stack
  | -- 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
  | -- Attempted to use a builtin that was not allowed in the current sandboxing context.
    SandboxingFailure !Text.Text -- The name of the builtin which failed was sandboxed.
  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. GInstr comb -> GInstr comb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall comb. GInstr comb -> GInstr comb -> Bool
== :: GInstr comb -> GInstr comb -> Bool
$c/= :: forall 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 comb. Eq (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. GInstr comb -> GInstr comb -> Bool
forall comb. GInstr comb -> GInstr comb -> Ordering
forall comb. GInstr comb -> GInstr comb -> GInstr comb
$ccompare :: forall comb. GInstr comb -> GInstr comb -> Ordering
compare :: GInstr comb -> GInstr comb -> Ordering
$c< :: forall comb. GInstr comb -> GInstr comb -> Bool
< :: GInstr comb -> GInstr comb -> Bool
$c<= :: forall comb. GInstr comb -> GInstr comb -> Bool
<= :: GInstr comb -> GInstr comb -> Bool
$c> :: forall comb. GInstr comb -> GInstr comb -> Bool
> :: GInstr comb -> GInstr comb -> Bool
$c>= :: forall comb. GInstr comb -> GInstr comb -> Bool
>= :: GInstr comb -> GInstr comb -> Bool
$cmax :: forall comb. GInstr comb -> GInstr comb -> GInstr comb
max :: GInstr comb -> GInstr comb -> GInstr comb
$cmin :: forall 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 val = GSection (RComb val)

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
      !CombIx
      {- Lazy! Might be cyclic -} comb
      !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.
    --
    -- The stored CombIx is a combinator that contains the second
    -- section, which can be used to reconstruct structures that
    -- throw away the section, like serializable continuation values.
    -- Code generation will emit the section as its own combinator,
    -- but also include it directly here.
    Let
      !(GSection comb) -- binding
      !CombIx -- body section refrence
      !Int -- stack safety
      !(GSection comb) -- body code
  | -- 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

-- dnum maps type references to their number in the runtime
-- cnum maps combinator references to their number
-- anum maps combinator references to their main arity
data RefNums = RN
  { RefNums -> Reference -> Word64
dnum :: Reference -> Word64,
    RefNums -> Reference -> Word64
cnum :: Reference -> Word64,
    RefNums -> Reference -> Maybe Int
anum :: Reference -> Maybe Int
  }

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

type Comb = GComb Void CombIx

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

data GComb val comb
  = Comb {-# UNPACK #-} !(GCombInfo comb)
  | -- A pre-evaluated comb, typically a pure top-level const
    CachedVal !Word64 {- top level comb ix -} !val
  deriving stock (Int -> GComb val comb -> ShowS
[GComb val comb] -> ShowS
GComb val comb -> [Char]
(Int -> GComb val comb -> ShowS)
-> (GComb val comb -> [Char])
-> ([GComb val comb] -> ShowS)
-> Show (GComb val comb)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall val comb.
(Show comb, Show val) =>
Int -> GComb val comb -> ShowS
forall val comb. (Show comb, Show val) => [GComb val comb] -> ShowS
forall val comb. (Show comb, Show val) => GComb val comb -> [Char]
$cshowsPrec :: forall val comb.
(Show comb, Show val) =>
Int -> GComb val comb -> ShowS
showsPrec :: Int -> GComb val comb -> ShowS
$cshow :: forall val comb. (Show comb, Show val) => GComb val comb -> [Char]
show :: GComb val comb -> [Char]
$cshowList :: forall val comb. (Show comb, Show val) => [GComb val comb] -> ShowS
showList :: [GComb val comb] -> ShowS
Show, GComb val comb -> GComb val comb -> Bool
(GComb val comb -> GComb val comb -> Bool)
-> (GComb val comb -> GComb val comb -> Bool)
-> Eq (GComb val comb)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall val comb.
(Eq comb, Eq val) =>
GComb val comb -> GComb val comb -> Bool
$c== :: forall val comb.
(Eq comb, Eq val) =>
GComb val comb -> GComb val comb -> Bool
== :: GComb val comb -> GComb val comb -> Bool
$c/= :: forall val comb.
(Eq comb, Eq val) =>
GComb val comb -> GComb val comb -> Bool
/= :: GComb val comb -> GComb val comb -> Bool
Eq, Eq (GComb val comb)
Eq (GComb val comb) =>
(GComb val comb -> GComb val comb -> Ordering)
-> (GComb val comb -> GComb val comb -> Bool)
-> (GComb val comb -> GComb val comb -> Bool)
-> (GComb val comb -> GComb val comb -> Bool)
-> (GComb val comb -> GComb val comb -> Bool)
-> (GComb val comb -> GComb val comb -> GComb val comb)
-> (GComb val comb -> GComb val comb -> GComb val comb)
-> Ord (GComb val comb)
GComb val comb -> GComb val comb -> Bool
GComb val comb -> GComb val comb -> Ordering
GComb val comb -> GComb val comb -> GComb val 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 val comb. (Ord comb, Ord val) => Eq (GComb val comb)
forall val comb.
(Ord comb, Ord val) =>
GComb val comb -> GComb val comb -> Bool
forall val comb.
(Ord comb, Ord val) =>
GComb val comb -> GComb val comb -> Ordering
forall val comb.
(Ord comb, Ord val) =>
GComb val comb -> GComb val comb -> GComb val comb
$ccompare :: forall val comb.
(Ord comb, Ord val) =>
GComb val comb -> GComb val comb -> Ordering
compare :: GComb val comb -> GComb val comb -> Ordering
$c< :: forall val comb.
(Ord comb, Ord val) =>
GComb val comb -> GComb val comb -> Bool
< :: GComb val comb -> GComb val comb -> Bool
$c<= :: forall val comb.
(Ord comb, Ord val) =>
GComb val comb -> GComb val comb -> Bool
<= :: GComb val comb -> GComb val comb -> Bool
$c> :: forall val comb.
(Ord comb, Ord val) =>
GComb val comb -> GComb val comb -> Bool
> :: GComb val comb -> GComb val comb -> Bool
$c>= :: forall val comb.
(Ord comb, Ord val) =>
GComb val comb -> GComb val comb -> Bool
>= :: GComb val comb -> GComb val comb -> Bool
$cmax :: forall val comb.
(Ord comb, Ord val) =>
GComb val comb -> GComb val comb -> GComb val comb
max :: GComb val comb -> GComb val comb -> GComb val comb
$cmin :: forall val comb.
(Ord comb, Ord val) =>
GComb val comb -> GComb val comb -> GComb val comb
min :: GComb val comb -> GComb val comb -> GComb val comb
Ord, (forall a b. (a -> b) -> GComb val a -> GComb val b)
-> (forall a b. a -> GComb val b -> GComb val a)
-> Functor (GComb val)
forall a b. a -> GComb val b -> GComb val a
forall a b. (a -> b) -> GComb val a -> GComb val b
forall val a b. a -> GComb val b -> GComb val a
forall val a b. (a -> b) -> GComb val a -> GComb val b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall val a b. (a -> b) -> GComb val a -> GComb val b
fmap :: forall a b. (a -> b) -> GComb val a -> GComb val b
$c<$ :: forall val a b. a -> GComb val b -> GComb val a
<$ :: forall a b. a -> GComb val b -> GComb val a
Functor, (forall m. Monoid m => GComb val m -> m)
-> (forall m a. Monoid m => (a -> m) -> GComb val a -> m)
-> (forall m a. Monoid m => (a -> m) -> GComb val a -> m)
-> (forall a b. (a -> b -> b) -> b -> GComb val a -> b)
-> (forall a b. (a -> b -> b) -> b -> GComb val a -> b)
-> (forall b a. (b -> a -> b) -> b -> GComb val a -> b)
-> (forall b a. (b -> a -> b) -> b -> GComb val a -> b)
-> (forall a. (a -> a -> a) -> GComb val a -> a)
-> (forall a. (a -> a -> a) -> GComb val a -> a)
-> (forall a. GComb val a -> [a])
-> (forall a. GComb val a -> Bool)
-> (forall a. GComb val a -> Int)
-> (forall a. Eq a => a -> GComb val a -> Bool)
-> (forall a. Ord a => GComb val a -> a)
-> (forall a. Ord a => GComb val a -> a)
-> (forall a. Num a => GComb val a -> a)
-> (forall a. Num a => GComb val a -> a)
-> Foldable (GComb val)
forall a. Eq a => a -> GComb val a -> Bool
forall a. Num a => GComb val a -> a
forall a. Ord a => GComb val a -> a
forall m. Monoid m => GComb val m -> m
forall a. GComb val a -> Bool
forall a. GComb val a -> Int
forall a. GComb val a -> [a]
forall a. (a -> a -> a) -> GComb val a -> a
forall val a. Eq a => a -> GComb val a -> Bool
forall val a. Num a => GComb val a -> a
forall val a. Ord a => GComb val a -> a
forall m a. Monoid m => (a -> m) -> GComb val a -> m
forall val m. Monoid m => GComb val m -> m
forall val a. GComb val a -> Bool
forall val a. GComb val a -> Int
forall val a. GComb val a -> [a]
forall b a. (b -> a -> b) -> b -> GComb val a -> b
forall a b. (a -> b -> b) -> b -> GComb val a -> b
forall val a. (a -> a -> a) -> GComb val a -> a
forall val m a. Monoid m => (a -> m) -> GComb val a -> m
forall val b a. (b -> a -> b) -> b -> GComb val a -> b
forall val a b. (a -> b -> b) -> b -> GComb val 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 val m. Monoid m => GComb val m -> m
fold :: forall m. Monoid m => GComb val m -> m
$cfoldMap :: forall val m a. Monoid m => (a -> m) -> GComb val a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GComb val a -> m
$cfoldMap' :: forall val m a. Monoid m => (a -> m) -> GComb val a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GComb val a -> m
$cfoldr :: forall val a b. (a -> b -> b) -> b -> GComb val a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GComb val a -> b
$cfoldr' :: forall val a b. (a -> b -> b) -> b -> GComb val a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GComb val a -> b
$cfoldl :: forall val b a. (b -> a -> b) -> b -> GComb val a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GComb val a -> b
$cfoldl' :: forall val b a. (b -> a -> b) -> b -> GComb val a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GComb val a -> b
$cfoldr1 :: forall val a. (a -> a -> a) -> GComb val a -> a
foldr1 :: forall a. (a -> a -> a) -> GComb val a -> a
$cfoldl1 :: forall val a. (a -> a -> a) -> GComb val a -> a
foldl1 :: forall a. (a -> a -> a) -> GComb val a -> a
$ctoList :: forall val a. GComb val a -> [a]
toList :: forall a. GComb val a -> [a]
$cnull :: forall val a. GComb val a -> Bool
null :: forall a. GComb val a -> Bool
$clength :: forall val a. GComb val a -> Int
length :: forall a. GComb val a -> Int
$celem :: forall val a. Eq a => a -> GComb val a -> Bool
elem :: forall a. Eq a => a -> GComb val a -> Bool
$cmaximum :: forall val a. Ord a => GComb val a -> a
maximum :: forall a. Ord a => GComb val a -> a
$cminimum :: forall val a. Ord a => GComb val a -> a
minimum :: forall a. Ord a => GComb val a -> a
$csum :: forall val a. Num a => GComb val a -> a
sum :: forall a. Num a => GComb val a -> a
$cproduct :: forall val a. Num a => GComb val a -> a
product :: forall a. Num a => GComb val a -> a
Foldable, Functor (GComb val)
Foldable (GComb val)
(Functor (GComb val), Foldable (GComb val)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> GComb val a -> f (GComb val b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GComb val (f a) -> f (GComb val a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GComb val a -> m (GComb val b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GComb val (m a) -> m (GComb val a))
-> Traversable (GComb val)
forall val. Functor (GComb val)
forall val. Foldable (GComb val)
forall val (m :: * -> *) a.
Monad m =>
GComb val (m a) -> m (GComb val a)
forall val (f :: * -> *) a.
Applicative f =>
GComb val (f a) -> f (GComb val a)
forall val (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb val a -> m (GComb val b)
forall val (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb val a -> f (GComb val b)
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 val (m a) -> m (GComb val a)
forall (f :: * -> *) a.
Applicative f =>
GComb val (f a) -> f (GComb val a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb val a -> m (GComb val b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb val a -> f (GComb val b)
$ctraverse :: forall val (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb val a -> f (GComb val b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb val a -> f (GComb val b)
$csequenceA :: forall val (f :: * -> *) a.
Applicative f =>
GComb val (f a) -> f (GComb val a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GComb val (f a) -> f (GComb val a)
$cmapM :: forall val (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb val a -> m (GComb val b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb val a -> m (GComb val b)
$csequence :: forall val (m :: * -> *) a.
Monad m =>
GComb val (m a) -> m (GComb val a)
sequence :: forall (m :: * -> *) a.
Monad m =>
GComb val (m a) -> m (GComb val a)
Traversable)

pattern Lam ::
  Int -> Int -> GSection comb -> GComb val comb
pattern $mLam :: forall {r} {comb} {val}.
GComb val comb
-> (Int -> Int -> GSection comb -> r) -> ((# #) -> r) -> r
$bLam :: forall comb val. Int -> Int -> GSection comb -> GComb val comb
Lam a f sect = Comb (LamI a f sect)

-- it seems GHC can't figure this out itself
{-# COMPLETE CachedVal, Lam #-}

instance Bifunctor GComb where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> GComb a c -> GComb b d
bimap = (a -> b) -> (c -> d) -> GComb a c -> GComb b d
forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault

instance Bifoldable GComb where
  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> GComb a b -> m
bifoldMap = (a -> m) -> (b -> m) -> GComb a b -> m
forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault

instance Bitraversable GComb where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> GComb a b -> f (GComb c d)
bitraverse a -> f c
f b -> f d
_ (CachedVal Word64
cix a
c) = Word64 -> c -> GComb c d
forall val comb. Word64 -> val -> GComb val comb
CachedVal Word64
cix (c -> GComb c d) -> f c -> f (GComb c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
c
  bitraverse a -> f c
_ b -> f d
f (Lam Int
a Int
fr GSection b
s) = Int -> Int -> GSection d -> GComb c d
forall comb val. Int -> Int -> GSection comb -> GComb val comb
Lam Int
a Int
fr (GSection d -> GComb c d) -> f (GSection d) -> f (GComb c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> f d) -> GSection b -> f (GSection d)
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) -> GSection a -> f (GSection b)
traverse b -> f d
f GSection b
s

type RCombs val = GCombs val (RComb val)

-- | The fixed point of a GComb where all references to a Comb are themselves Combs.
newtype RComb val = RComb {forall val. RComb val -> GComb val (RComb val)
unRComb :: GComb val (RComb val)}

type RCombInfo val = GCombInfo (RComb val)

instance Show (RComb val) where
  show :: RComb val -> [Char]
show RComb val
_ = [Char]
"<RCOMB>"

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

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

type RRef val = GRef (RComb val)

data GRef comb
  = Stk !Int -- stack reference to a closure
  | Env !CombIx {- Lazy! Might be cyclic -} comb
  | 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, (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)

instance Eq (GRef comb) where
  GRef comb
a == :: GRef comb -> GRef comb -> Bool
== GRef comb
b = GRef comb -> GRef comb -> Ordering
forall a. Ord a => a -> a -> Ordering
compare GRef comb
a GRef comb
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord (GRef comb) where
  compare :: GRef comb -> GRef comb -> Ordering
compare (Stk Int
a) (Stk Int
b) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
a Int
b
  compare (Stk {}) GRef comb
_ = Ordering
LT
  compare GRef comb
_ (Stk {}) = Ordering
GT
  compare (Env CombIx
a comb
_) (Env CombIx
b comb
_) = CombIx -> CombIx -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CombIx
a CombIx
b
  compare (Env {}) GRef comb
_ = Ordering
LT
  compare GRef comb
_ (Env {}) = Ordering
GT
  compare (Dyn Word64
a) (Dyn Word64
b) = Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word64
a Word64
b

type Branch = GBranch CombIx

type RBranch val = GBranch (RComb val)

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)

branchToEnumMap :: GBranch comb -> Maybe ((GSection comb), EnumMap Word64 (GSection comb))
branchToEnumMap :: forall comb.
GBranch comb
-> Maybe (GSection comb, EnumMap Word64 (GSection comb))
branchToEnumMap = \case
  (Test1 Word64
k GSection comb
t GSection comb
d) -> (GSection comb, EnumMap Word64 (GSection comb))
-> Maybe (GSection comb, EnumMap Word64 (GSection comb))
forall a. a -> Maybe a
Just (GSection comb
d, Word64 -> GSection comb -> EnumMap Word64 (GSection comb)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton Word64
k GSection comb
t)
  (Test2 Word64
k1 GSection comb
s1 Word64
k2 GSection comb
s2 GSection comb
d) -> (GSection comb, EnumMap Word64 (GSection comb))
-> Maybe (GSection comb, EnumMap Word64 (GSection comb))
forall a. a -> Maybe a
Just (GSection comb
d, [(Word64, GSection comb)] -> EnumMap Word64 (GSection comb)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
EC.mapFromList [(Word64
k1, GSection comb
s1), (Word64
k2, GSection comb
s2)])
  (TestW GSection comb
d EnumMap Word64 (GSection comb)
m) -> (GSection comb, EnumMap Word64 (GSection comb))
-> Maybe (GSection comb, EnumMap Word64 (GSection comb))
forall a. a -> Maybe a
Just (GSection comb
d, EnumMap Word64 (GSection comb)
m)
  GBranch comb
_ -> Maybe (GSection comb, EnumMap Word64 (GSection comb))
forall a. Maybe a
Nothing

-- 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 (branchToEnumMap -> Just (d, cs))
  where
    MatchW Int
i GSection comb
d EnumMap Word64 (GSection comb)
cs = Int -> GBranch comb -> GSection comb
forall comb. Int -> GBranch comb -> GSection comb
Match Int
i (GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
forall comb.
GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
mkBranch GSection comb
d EnumMap Word64 (GSection comb)
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 (branchToEnumMap -> Just (d, cs))
  where
    NMatchW Maybe Reference
r Int
i GSection comb
d EnumMap Word64 (GSection comb)
cs = Maybe Reference -> Int -> GBranch comb -> GSection comb
forall comb.
Maybe Reference -> Int -> GBranch comb -> GSection comb
NMatch Maybe Reference
r Int
i (GBranch comb -> GSection comb) -> GBranch comb -> GSection comb
forall a b. (a -> b) -> a -> b
$ GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
forall comb.
GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
mkBranch GSection comb
d EnumMap Word64 (GSection comb)
cs

mkBranch :: (GSection comb) -> (EnumMap Word64 (GSection comb)) -> GBranch comb
mkBranch :: forall comb.
GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
mkBranch GSection comb
d EnumMap Word64 (GSection comb)
m = case EnumMap Word64 (GSection comb) -> [(Word64, GSection comb)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
EC.mapToList EnumMap Word64 (GSection comb)
m of
  [(Word64
k, GSection comb
v)] -> Word64 -> GSection comb -> GSection comb -> GBranch comb
forall comb.
Word64 -> GSection comb -> GSection comb -> GBranch comb
Test1 Word64
k GSection comb
v GSection comb
d
  [(Word64
k1, GSection comb
v1), (Word64
k2, GSection comb
v2)] -> Word64
-> GSection comb
-> Word64
-> GSection comb
-> GSection comb
-> GBranch comb
forall comb.
Word64
-> GSection comb
-> Word64
-> GSection comb
-> GSection comb
-> GBranch comb
Test2 Word64
k1 GSection comb
v1 Word64
k2 GSection comb
v2 GSection comb
d
  [(Word64, GSection comb)]
_ -> GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
forall comb.
GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
TestW GSection comb
d EnumMap Word64 (GSection comb)
m

-- 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 -> Ctx v -> Maybe (Int, Mem)
walk Int
0 Ctx v
ctx
  where
    walk :: Int -> Ctx v -> Maybe (Int, Mem)
walk Int
_ Ctx v
ECtx = Maybe (Int, Mem)
forall a. Maybe a
Nothing
    walk Int
i (Block Ctx v
ctx) = Int -> Ctx v -> Maybe (Int, Mem)
walk Int
i Ctx v
ctx
    walk Int
i (Tag Ctx v
ctx) = Int -> Ctx v -> Maybe (Int, Mem)
walk (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx v
ctx
    walk Int
i (Var v
x Mem
m Ctx v
ctx)
      | v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
x = (Int, Mem) -> Maybe (Int, Mem)
forall a. a -> Maybe a
Just (Int
i, Mem
m)
      | Bool
otherwise = Int -> Ctx v -> Maybe (Int, Mem)
walk (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx v
ctx

-- 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
  Maybe (EnumMap Word64 (RCombs val)) ->
  -- Combinators which need their knots tied.
  EnumMap Word64 (GCombs val CombIx) ->
  EnumMap Word64 (RCombs val)
resolveCombs :: forall val.
Maybe (EnumMap Word64 (RCombs val))
-> EnumMap Word64 (GCombs val CombIx)
-> EnumMap Word64 (RCombs val)
resolveCombs Maybe (EnumMap Word64 (RCombs val))
mayExisting EnumMap Word64 (GCombs val CombIx)
combs =
  -- Fixed point lookup;
  -- We make sure not to force resolved Combs or we'll loop forever.
  let ~EnumMap Word64 (RCombs val)
resolved =
        EnumMap Word64 (GCombs val CombIx)
combs
          EnumMap Word64 (GCombs val CombIx)
-> (GCombs val CombIx -> RCombs val) -> EnumMap Word64 (RCombs val)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((GComb val CombIx -> GComb val (RComb val))
-> GCombs val CombIx -> RCombs val
forall a b. (a -> b) -> EnumMap Word64 a -> EnumMap Word64 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GComb val CombIx -> GComb val (RComb val))
 -> GCombs val CombIx -> RCombs val)
-> ((CombIx -> RComb val)
    -> GComb val CombIx -> GComb val (RComb val))
-> (CombIx -> RComb val)
-> GCombs val CombIx
-> RCombs val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CombIx -> RComb val) -> GComb val CombIx -> GComb val (RComb val)
forall a b. (a -> b) -> GComb val a -> GComb val b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) \(CIx Reference
_ Word64
n Word64
i) ->
            let cmbs :: RCombs val
cmbs = case Maybe (EnumMap Word64 (RCombs val))
mayExisting Maybe (EnumMap Word64 (RCombs val))
-> (EnumMap Word64 (RCombs val) -> Maybe (RCombs val))
-> Maybe (RCombs val)
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 val) -> Maybe (RCombs val)
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
n of
                  Just RCombs val
cmbs -> RCombs val
cmbs
                  Maybe (RCombs val)
Nothing ->
                    case Word64 -> EnumMap Word64 (RCombs val) -> Maybe (RCombs val)
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
n EnumMap Word64 (RCombs val)
resolved of
                      Just RCombs val
cmbs -> RCombs val
cmbs
                      Maybe (RCombs val)
Nothing -> [Char] -> RCombs val
forall a. HasCallStack => [Char] -> a
error ([Char] -> RCombs val) -> [Char] -> RCombs val
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 val -> Maybe (GComb val (RComb val))
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
i RCombs val
cmbs of
                  Just GComb val (RComb val)
cmb -> GComb val (RComb val) -> RComb val
forall val. GComb val (RComb val) -> RComb val
RComb GComb val (RComb val)
cmb
                  Maybe (GComb val (RComb val))
Nothing ->
                    [Char] -> RComb val
forall a. HasCallStack => [Char] -> a
error ([Char] -> RComb val) -> [Char] -> RComb val
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 val)
resolved

absurdCombs :: EnumMap Word64 (EnumMap Word64 (GComb Void cix)) -> EnumMap Word64 (GCombs any cix)
absurdCombs :: forall cix any.
EnumMap Word64 (EnumMap Word64 (GComb Void cix))
-> EnumMap Word64 (GCombs any cix)
absurdCombs = (EnumMap Word64 (GComb Void cix) -> GCombs any cix)
-> EnumMap Word64 (EnumMap Word64 (GComb Void cix))
-> EnumMap Word64 (GCombs any cix)
forall a b. (a -> b) -> EnumMap Word64 a -> EnumMap Word64 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((EnumMap Word64 (GComb Void cix) -> GCombs any cix)
 -> EnumMap Word64 (EnumMap Word64 (GComb Void cix))
 -> EnumMap Word64 (GCombs any cix))
-> ((Void -> any)
    -> EnumMap Word64 (GComb Void cix) -> GCombs any cix)
-> (Void -> any)
-> EnumMap Word64 (EnumMap Word64 (GComb Void cix))
-> EnumMap Word64 (GCombs any cix)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GComb Void cix -> GComb any cix)
-> EnumMap Word64 (GComb Void cix) -> GCombs any cix
forall a b. (a -> b) -> EnumMap Word64 a -> EnumMap Word64 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GComb Void cix -> GComb any cix)
 -> EnumMap Word64 (GComb Void cix) -> GCombs any cix)
-> ((Void -> any) -> GComb Void cix -> GComb any cix)
-> (Void -> any)
-> EnumMap Word64 (GComb Void cix)
-> GCombs any cix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Void -> any) -> GComb Void cix -> GComb any cix
forall a b c. (a -> b) -> GComb a c -> GComb b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Void -> any)
 -> EnumMap Word64 (EnumMap Word64 (GComb Void cix))
 -> EnumMap Word64 (GCombs any cix))
-> (Void -> any)
-> EnumMap Word64 (EnumMap Word64 (GComb Void cix))
-> EnumMap Word64 (GCombs any cix)
forall a b. (a -> b) -> a -> b
$ Void -> any
forall a. Void -> a
absurd

-- Type for aggregating the necessary stack frame size. First field is the
-- necessary size. The Applicative instance takes the
-- maximum, so that combining values from different branches
-- results in finding the maximum number of slots either side requires.
--
-- TODO: Now that we have a single stack, most of this counting can probably be simplified.
data Counted a = C !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 -> a -> Counted a
forall a. Int -> a -> Counted a
C Int
0
  C Int
s0 a -> b
f <*> :: forall a b. Counted (a -> b) -> Counted a -> Counted b
<*> C Int
s1 a
x = Int -> b -> Counted b
forall a. Int -> a -> Counted a
C (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
s0 Int
s1) (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, Comb)
record :: forall v. Ctx v -> Word16 -> Emit Section -> Emit (Word64, Comb)
record Ctx v
ctx Word16
l (EM Word64 -> (EnumMap Word64 Comb, Counted Section)
es) = (Word64 -> (EnumMap Word64 Comb, Counted (Word64, Comb)))
-> Emit (Word64, Comb)
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted (Word64, Comb)))
 -> Emit (Word64, Comb))
-> (Word64 -> (EnumMap Word64 Comb, Counted (Word64, Comb)))
-> Emit (Word64, Comb)
forall a b. (a -> b) -> a -> b
$ \Word64
c ->
  let (EnumMap Word64 Comb
m, C Int
sz Section
s) = Word64 -> (EnumMap Word64 Comb, Counted Section)
es Word64
c
      na :: Int
na = Int -> Ctx v -> Int
forall v. Int -> Ctx v -> Int
countCtx0 Int
0 Ctx v
ctx
      n :: Word64
n = Word16 -> Word64 -> Word64
letIndex Word16
l Word64
c
      comb :: Comb
comb = Int -> Int -> Section -> Comb
forall comb val. Int -> Int -> GSection comb -> GComb val comb
Lam Int
na Int
sz Section
s
   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 Comb
comb EnumMap Word64 Comb
m, Int -> (Word64, Comb) -> Counted (Word64, Comb)
forall a. Int -> a -> Counted a
C Int
sz (Word64
n, Comb
comb))

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
sz Section
s) = Word64 -> (EnumMap Word64 Comb, Counted Section)
e Word64
c
      na :: Int
na = [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 -> Section -> Comb
forall comb val. Int -> Int -> GSection comb -> GComb val comb
Lam Int
na Int
sz Section
s) EnumMap Word64 Comb
m, Int -> () -> Counted ()
forall a. Int -> a -> Counted a
C Int
sz ())

-- 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 -> a -> Counted a
forall a. Int -> a -> Counted a
C Int
i
  where
    i :: Int
i = Int -> Ctx v -> Int
forall v. Int -> Ctx v -> Int
countCtx0 Int
0 Ctx v
ctx

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

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 -> Emit a -> Emit a
addCount :: forall a. Int -> Emit a -> Emit a
addCount Int
i = (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
sz a
x) -> Int -> a -> Counted a
forall a. Int -> a -> Counted a
C (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) 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 ->
    let cix :: CombIx
cix = (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
f (RefNums -> Reference -> Word64
cnum RefNums
rns Reference
f) Word64
0)
     in GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> GInstr CombIx
forall comb. GRef comb -> Args -> GInstr comb
Name (CombIx -> CombIx -> GRef CombIx
forall comb. CombIx -> comb -> GRef comb
Env CombIx
cix CombIx
cix) 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 ->
        GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> GInstr CombIx
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 ->
        let cix :: CombIx
cix = (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
n)
         in GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> GInstr CombIx
forall comb. GRef comb -> Args -> GInstr comb
Name (CombIx -> CombIx -> GRef CombIx
forall comb. CombIx -> comb -> GRef comb
Env CombIx
cix CombIx
cix) 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
_) <- 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
VArg1 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 =
      let cix :: CombIx
cix = (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
j)
       in 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 -> CombIx -> GRef CombIx
forall comb. CombIx -> comb -> GRef comb
Env CombIx
cix CombIx
cix) (Args -> Section) -> Args -> Section
forall a b. (a -> b) -> a -> b
$ 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 -> Emit Section -> Emit Section
forall a. Int -> Emit a -> Emit a
addCount Int
3
    (Emit Section -> Emit Section)
-> (Int -> Emit Section) -> Int -> 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)
-> (Int -> Section) -> Int -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (POp -> Args -> GInstr CombIx
emitPOp POp
p (Args -> GInstr CombIx) -> Args -> GInstr CombIx
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) -> (Int -> Section) -> Int -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield
    (Args -> Section) -> (Int -> Args) -> Int -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Args
VArgV
    (Int -> Emit Section) -> Int -> Emit Section
forall a b. (a -> b) -> a -> b
$ Ctx v -> Int
forall v. Ctx v -> Int
countBlock Ctx v
ctx
emitSection RefNums
_ Reference
_ Word64
grpn RCtx v
_ Ctx v
ctx (TFOp ForeignFunc
p [v]
args) =
  Int -> Emit Section -> Emit Section
forall a. Int -> Emit a -> Emit a
addCount Int
3
    (Emit Section -> Emit Section)
-> (Int -> Emit Section) -> Int -> 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)
-> (Int -> Section) -> Int -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (ForeignFunc -> Args -> GInstr CombIx
emitFOp ForeignFunc
p (Args -> GInstr CombIx) -> Args -> GInstr CombIx
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) -> (Int -> Section) -> Int -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield
    (Args -> Section) -> (Int -> Args) -> Int -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Args
VArgV
    (Int -> Emit Section) -> Int -> Emit Section
forall a b. (a -> b) -> a -> b
$ Ctx v -> Int
forall v. Ctx v -> 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
. GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Lit -> GInstr CombIx
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
$ Int -> Args
VArg1 Int
0
  where
    c :: Emit Section -> Emit Section
c
      | ANF.T {} <- Lit
l = Int -> Emit Section -> Emit Section
forall a. Int -> Emit a -> Emit a
addCount Int
1
      | ANF.LM {} <- Lit
l = Int -> Emit Section -> Emit Section
forall a. Int -> Emit a -> Emit a
addCount Int
1
      | ANF.LY {} <- Lit
l = Int -> Emit Section -> Emit Section
forall a. Int -> Emit a -> Emit a
addCount Int
1
      | Bool
otherwise = Int -> Emit Section -> Emit Section
forall a. Int -> Emit a -> Emit a
addCount Int
1
emitSection RefNums
_ Reference
_ Word64
_ RCtx v
_ Ctx v
ctx (TBLit Lit
l) =
  Int -> Emit Section -> Emit Section
forall a. Int -> Emit a -> Emit a
addCount 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
. GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Lit -> GInstr CombIx
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
$ Int -> Args
VArg1 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 =
      GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (EnumSet Word64 -> GInstr CombIx
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 -> GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Word64 -> Int -> GInstr CombIx
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) =
  GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Word64 -> GInstr CombIx
forall comb. Word64 -> GInstr comb
Capture (Word64 -> GInstr CombIx) -> Word64 -> GInstr CombIx
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 =
      let cix :: CombIx
cix = Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
j
       in Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (CombIx -> CombIx -> GRef CombIx
forall comb. CombIx -> comb -> GRef comb
Env CombIx
cix CombIx
cix) 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
  | Just Int
k <- RefNums -> Reference -> Maybe Int
anum RefNums
rns Reference
r,
    Args -> Int
countArgs Args
as Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k -- exactly saturated call
    =
      Bool -> CombIx -> CombIx -> Args -> Section
forall comb. Bool -> CombIx -> comb -> Args -> GSection comb
Call Bool
False CombIx
cix CombIx
cix Args
as
  | Bool
otherwise -- slow path
    =
      Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (CombIx -> CombIx -> GRef CombIx
forall comb. CombIx -> comb -> GRef comb
Env CombIx
cix CombIx
cix) Args
as
  where
    n :: Word64
n = RefNums -> Reference -> Word64
cnum RefNums
rns Reference
r
    cix :: CombIx
cix = Reference -> Word64 -> Word64 -> CombIx
CIx Reference
r Word64
n Word64
0
emitFunction RefNums
rns Reference
_grpr Word64
_ RCtx v
_ Ctx v
_ (FCon Reference
r CTag
t) Args
as =
  GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Reference -> PackedTag -> Args -> GInstr CombIx
forall comb. Reference -> PackedTag -> Args -> GInstr comb
Pack Reference
r (RTag -> CTag -> PackedTag
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
VArg1 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.
  GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Reference -> PackedTag -> Args -> GInstr CombIx
forall comb. Reference -> PackedTag -> Args -> GInstr comb
Pack Reference
r (RTag -> CTag -> PackedTag
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
VArg1 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 ForeignFunc
_) Args
_ =
  [Char] -> Section
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"emitFunction: impossible"

countBlock :: Ctx v -> Int
countBlock :: forall v. Ctx v -> Int
countBlock = Int -> Ctx v -> Int
forall {t} {v}. Num t => t -> Ctx v -> t
go Int
0
  where
    go :: t -> Ctx v -> t
go !t
i (Var v
_ Mem
_ Ctx v
ctx) = t -> Ctx v -> t
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) Ctx v
ctx
    go t
i (Tag Ctx v
ctx) = t -> Ctx v -> t
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) Ctx v
ctx
    go t
i Ctx v
_ = t
i

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

-- 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 (GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GInstr CombIx -> Section -> Section)
-> GInstr CombIx -> Section -> Section
forall a b. (a -> b) -> a -> b
$ Lit -> GInstr CombIx
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 (GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GInstr CombIx -> Section -> Section)
-> GInstr CombIx -> Section -> Section
forall a b. (a -> b) -> a -> b
$ Lit -> GInstr CombIx
emitLit 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 (GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GInstr CombIx -> Section -> Section)
-> (Args -> GInstr CombIx) -> Args -> Section -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> PackedTag -> Args -> GInstr CombIx
forall comb. Reference -> PackedTag -> Args -> GInstr comb
Pack Reference
r (RTag -> CTag -> PackedTag
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 ForeignFunc
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 (GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GInstr CombIx -> Section -> Section)
-> (Args -> GInstr CombIx) -> Args -> Section -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POp -> Args -> GInstr CombIx)
-> (ForeignFunc -> Args -> GInstr CombIx)
-> Either POp ForeignFunc
-> Args
-> GInstr CombIx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either POp -> Args -> GInstr CombIx
emitPOp ForeignFunc -> Args -> GInstr CombIx
emitFOp Either POp ForeignFunc
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, Comb) -> Section
f
          (Section -> (Word64, Comb) -> Section)
-> Emit Section -> Emit ((Word64, Comb) -> 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, Comb) -> Section)
-> Emit (Word64, Comb) -> 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, Comb)
forall v. Ctx v -> Word16 -> Emit Section -> Emit (Word64, Comb)
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, Comb) -> Section
f Section
s (Word64
w, Lam Int
_ Int
f Section
bd) =
      let cix :: CombIx
cix = (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
w)
       in Section -> CombIx -> Int -> Section -> Section
forall comb.
GSection comb -> CombIx -> Int -> GSection comb -> GSection comb
Let Section
s CombIx
cix Int
f Section
bd

-- 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 -> GInstr CombIx
emitPOp POp
ANF.ADDI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
ADDI
emitPOp POp
ANF.ADDN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
ADDN
emitPOp POp
ANF.SUBI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
SUBI
emitPOp POp
ANF.SUBN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
SUBN
emitPOp POp
ANF.DRPN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
DRPN
emitPOp POp
ANF.MULI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
MULI
emitPOp POp
ANF.MULN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
MULN
emitPOp POp
ANF.DIVI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
DIVI
emitPOp POp
ANF.DIVN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
DIVN
emitPOp POp
ANF.MODI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
MODI -- TODO: think about how these behave
emitPOp POp
ANF.MODN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
MODN -- TODO: think about how these behave
emitPOp POp
ANF.POWI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
POWI
emitPOp POp
ANF.POWN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
POWN
emitPOp POp
ANF.SHLI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
SHLI
emitPOp POp
ANF.SHLN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
SHLN -- Note: left shift behaves uniformly
emitPOp POp
ANF.SHRI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
SHRI
emitPOp POp
ANF.SHRN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
SHRN
emitPOp POp
ANF.LEQI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
LEQI
emitPOp POp
ANF.LESI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
LESI
emitPOp POp
ANF.LEQN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
LEQN
emitPOp POp
ANF.LESN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
LESN
emitPOp POp
ANF.EQLI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
EQLI
emitPOp POp
ANF.NEQI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
NEQI
emitPOp POp
ANF.EQLN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
EQLN
emitPOp POp
ANF.NEQN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
NEQN
emitPOp POp
ANF.SGNI = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
SGNI
emitPOp POp
ANF.NEGI = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
NEGI
emitPOp POp
ANF.INCI = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
INCI
emitPOp POp
ANF.INCN = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
INCN
emitPOp POp
ANF.DECI = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
DECI
emitPOp POp
ANF.DECN = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
DECN
emitPOp POp
ANF.TRNC = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
TRNC
emitPOp POp
ANF.TZRO = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
TZRO
emitPOp POp
ANF.LZRO = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
LZRO
emitPOp POp
ANF.POPC = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
POPC
emitPOp POp
ANF.ANDN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
ANDN
emitPOp POp
ANF.ANDI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
ANDI
emitPOp POp
ANF.IORN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
IORN
emitPOp POp
ANF.IORI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
IORI
emitPOp POp
ANF.XORI = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
XORI
emitPOp POp
ANF.XORN = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
XORN
emitPOp POp
ANF.COMN = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
COMN
emitPOp POp
ANF.COMI = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
COMI
-- Float
emitPOp POp
ANF.ADDF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
ADDF
emitPOp POp
ANF.SUBF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
SUBF
emitPOp POp
ANF.MULF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
MULF
emitPOp POp
ANF.DIVF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
DIVF
emitPOp POp
ANF.LEQF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
LEQF
emitPOp POp
ANF.LESF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
LESF
emitPOp POp
ANF.EQLF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
EQLF
emitPOp POp
ANF.NEQF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
NEQF
emitPOp POp
ANF.MINF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
MINF
emitPOp POp
ANF.MAXF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
MAXF
emitPOp POp
ANF.POWF = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
POWF
emitPOp POp
ANF.EXPF = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
EXPF
emitPOp POp
ANF.ABSF = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
ABSF
emitPOp POp
ANF.SQRT = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
SQRT
emitPOp POp
ANF.LOGF = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
LOGF
emitPOp POp
ANF.LOGB = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
LOGB
emitPOp POp
ANF.CEIL = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
CEIL
emitPOp POp
ANF.FLOR = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
FLOR
emitPOp POp
ANF.TRNF = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
TRNF
emitPOp POp
ANF.RNDF = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
RNDF
emitPOp POp
ANF.COSF = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
COSF
emitPOp POp
ANF.SINF = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
SINF
emitPOp POp
ANF.TANF = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
TANF
emitPOp POp
ANF.COSH = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
COSH
emitPOp POp
ANF.SINH = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
SINH
emitPOp POp
ANF.TANH = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
TANH
emitPOp POp
ANF.ACOS = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
ACOS
emitPOp POp
ANF.ATAN = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
ATAN
emitPOp POp
ANF.ASIN = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
ASIN
emitPOp POp
ANF.ACSH = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
ACSH
emitPOp POp
ANF.ASNH = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
ASNH
emitPOp POp
ANF.ATNH = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
ATNH
emitPOp POp
ANF.ATN2 = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
ATN2
-- conversions
emitPOp POp
ANF.ITOF = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
ITOF
emitPOp POp
ANF.NTOF = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
NTOF
emitPOp POp
ANF.ITOT = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
ITOT
emitPOp POp
ANF.NTOT = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
NTOT
emitPOp POp
ANF.FTOT = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
FTOT
emitPOp POp
ANF.TTON = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
TTON
emitPOp POp
ANF.TTOI = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
TTOI
emitPOp POp
ANF.TTOF = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
TTOF
emitPOp POp
ANF.CAST = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
CAST
-- text
emitPOp POp
ANF.CATT = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
CATT
emitPOp POp
ANF.TAKT = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
TAKT
emitPOp POp
ANF.DRPT = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
DRPT
emitPOp POp
ANF.IXOT = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
IXOT
emitPOp POp
ANF.SIZT = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
SIZT
emitPOp POp
ANF.UCNS = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
UCNS
emitPOp POp
ANF.USNC = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
USNC
emitPOp POp
ANF.EQLT = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
EQLT
emitPOp POp
ANF.LEQT = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
LEQT
emitPOp POp
ANF.PAKT = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
PAKT
emitPOp POp
ANF.UPKT = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
UPKT
-- sequence
emitPOp POp
ANF.CATS = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
CATS
emitPOp POp
ANF.TAKS = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
TAKS
emitPOp POp
ANF.DRPS = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
DRPS
emitPOp POp
ANF.SIZS = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
SIZS
emitPOp POp
ANF.CONS = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
CONS
emitPOp POp
ANF.SNOC = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
SNOC
emitPOp POp
ANF.IDXS = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
IDXS
emitPOp POp
ANF.VWLS = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
VWLS
emitPOp POp
ANF.VWRS = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
VWRS
emitPOp POp
ANF.SPLL = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
SPLL
emitPOp POp
ANF.SPLR = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
SPLR
-- bytes
emitPOp POp
ANF.PAKB = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
PAKB
emitPOp POp
ANF.UPKB = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
UPKB
emitPOp POp
ANF.TAKB = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
TAKB
emitPOp POp
ANF.DRPB = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
DRPB
emitPOp POp
ANF.IXOB = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
IXOB
emitPOp POp
ANF.IDXB = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
IDXB
emitPOp POp
ANF.SIZB = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
SIZB
emitPOp POp
ANF.FLTB = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
FLTB
emitPOp POp
ANF.CATB = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
CATB
-- universal comparison
emitPOp POp
ANF.EQLU = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
EQLU
emitPOp POp
ANF.LEQU = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
LEQU
emitPOp POp
ANF.LESU = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
LESU
emitPOp POp
ANF.CMPU = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
CMPU
-- code operations
emitPOp POp
ANF.MISS = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
MISS
emitPOp POp
ANF.CACH = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
CACH
emitPOp POp
ANF.LKUP = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
LKUP
emitPOp POp
ANF.TLTT = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
TLTT
emitPOp POp
ANF.CVLD = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
CVLD
emitPOp POp
ANF.LOAD = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
LOAD
emitPOp POp
ANF.VALU = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
VALU
emitPOp POp
ANF.SDBX = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
SDBX
emitPOp POp
ANF.SDBL = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
SDBL
emitPOp POp
ANF.SDBV = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
SDBV
-- error call
emitPOp POp
ANF.EROR = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
THRO
emitPOp POp
ANF.TRCE = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
TRCE
emitPOp POp
ANF.DBTX = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
DBTX
-- Refs
emitPOp POp
ANF.REFN = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
REFN
emitPOp POp
ANF.REFR = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
REFR
emitPOp POp
ANF.REFW = BPrim2 -> Args -> GInstr CombIx
emitBP2 BPrim2
REFW
emitPOp POp
ANF.RCAS = Args -> GInstr CombIx
refCAS
emitPOp POp
ANF.RRFC = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
RRFC
emitPOp POp
ANF.TIKR = BPrim1 -> Args -> GInstr CombIx
emitBP1 BPrim1
TIKR
-- non-prim translations
emitPOp POp
ANF.BLDS = Args -> GInstr CombIx
forall comb. Args -> GInstr comb
Seq
-- Bools
emitPOp POp
ANF.NOTB = UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
NOTB
emitPOp POp
ANF.ANDB = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
ANDB
emitPOp POp
ANF.IORB = UPrim2 -> Args -> GInstr CombIx
emitP2 UPrim2
IORB
emitPOp POp
ANF.FORK = \case
  VArg1 Int
i -> Int -> GInstr CombIx
forall comb. Int -> GInstr comb
Fork Int
i
  Args
_ -> [Char] -> GInstr CombIx
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"fork takes exactly one boxed argument"
emitPOp POp
ANF.ATOM = \case
  VArg1 Int
i -> Int -> GInstr CombIx
forall comb. Int -> GInstr comb
Atomically Int
i
  Args
_ -> [Char] -> GInstr CombIx
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"atomically takes exactly one boxed argument"
emitPOp POp
ANF.PRNT = \case
  VArg1 Int
i -> Int -> GInstr CombIx
forall comb. Int -> GInstr comb
Print Int
i
  Args
_ -> [Char] -> GInstr CombIx
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"print takes exactly one boxed argument"
emitPOp POp
ANF.INFO = \case
  Args
ZArgs -> [Char] -> GInstr CombIx
forall comb. [Char] -> GInstr comb
Info [Char]
"debug"
  Args
_ -> [Char] -> GInstr CombIx
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"info takes no arguments"
emitPOp POp
ANF.TFRC = \case
  VArg1 Int
i -> Int -> GInstr CombIx
forall comb. Int -> GInstr comb
TryForce Int
i
  Args
_ -> [Char] -> GInstr CombIx
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 :: ForeignFunc -> Args -> Instr
emitFOp :: ForeignFunc -> Args -> GInstr CombIx
emitFOp ForeignFunc
fop = Bool -> ForeignFunc -> Args -> GInstr CombIx
forall comb. Bool -> ForeignFunc -> Args -> GInstr comb
ForeignCall Bool
True ForeignFunc
fop

-- Helper functions for packing the variable argument representation
-- into the indexes stored in prim op instructions
emitP1 :: UPrim1 -> Args -> Instr
emitP1 :: UPrim1 -> Args -> GInstr CombIx
emitP1 UPrim1
p (VArg1 Int
i) = UPrim1 -> Int -> GInstr CombIx
forall comb. UPrim1 -> Int -> GInstr comb
UPrim1 UPrim1
p Int
i
emitP1 UPrim1
p Args
a =
  [Char] -> GInstr CombIx
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> GInstr CombIx) -> [Char] -> GInstr CombIx
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 -> GInstr CombIx
emitP2 UPrim2
p (VArg2 Int
i Int
j) = UPrim2 -> Int -> Int -> GInstr CombIx
forall comb. UPrim2 -> Int -> Int -> GInstr comb
UPrim2 UPrim2
p Int
i Int
j
emitP2 UPrim2
p Args
a =
  [Char] -> GInstr CombIx
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> GInstr CombIx) -> [Char] -> GInstr CombIx
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 -> GInstr CombIx
emitBP1 BPrim1
p (VArg1 Int
i) = BPrim1 -> Int -> GInstr CombIx
forall comb. BPrim1 -> Int -> GInstr comb
BPrim1 BPrim1
p Int
i
emitBP1 BPrim1
p Args
a =
  [Char] -> GInstr CombIx
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> GInstr CombIx) -> [Char] -> GInstr CombIx
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 -> GInstr CombIx
emitBP2 BPrim2
p (VArg2 Int
i Int
j) = BPrim2 -> Int -> Int -> GInstr CombIx
forall comb. BPrim2 -> Int -> Int -> GInstr comb
BPrim2 BPrim2
p Int
i Int
j
emitBP2 BPrim2
p Args
a =
  [Char] -> GInstr CombIx
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> GInstr CombIx) -> [Char] -> GInstr CombIx
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)

refCAS :: Args -> Instr
refCAS :: Args -> GInstr CombIx
refCAS (VArgN (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList -> [Int
i, Int
j, Int
k])) = Int -> Int -> Int -> GInstr CombIx
forall comb. Int -> Int -> Int -> GInstr comb
RefCAS Int
i Int
j Int
k
refCAS Args
a =
  [Char] -> GInstr CombIx
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> GInstr CombIx) -> [Char] -> GInstr CombIx
forall a b. (a -> b) -> a -> b
$
    [Char]
"wrong number of args for refCAS: "
      [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Args -> [Char]
forall a. Show a => a -> [Char]
show 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
mkBranch (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
mkBranch 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 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
litToMLit (ANF.N Word64
n) = Word64 -> MLit
MN Word64
n
litToMLit (ANF.C Char
c) = Char -> MLit
MC 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

-- | Emit a literal as a machine literal of the correct boxed/unboxed format.
emitLit :: ANF.Lit -> Instr
emitLit :: Lit -> GInstr CombIx
emitLit = MLit -> GInstr CombIx
forall comb. MLit -> GInstr comb
Lit (MLit -> GInstr CombIx) -> (Lit -> MLit) -> Lit -> GInstr CombIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> MLit
litToMLit

-- 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 =
          let cix :: CombIx
cix = (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
n)
           in GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> GInstr CombIx
forall comb. GRef comb -> Args -> GInstr comb
Name (CombIx -> CombIx -> GRef CombIx
forall comb. CombIx -> comb -> GRef comb
Env CombIx
cix CombIx
cix) 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 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Reference -> [Char]
forall a. Show a => a -> [Char]
show Reference
grpr

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 = \case
  [] -> Args
ZArgs
  [(Int
i, Mem
_)] -> Int -> Args
VArg1 Int
i
  [(Int
i, Mem
_), (Int
j, Mem
_)] -> Int -> Int -> Args
VArg2 Int
i Int
j
  [(Int, Mem)]
args -> PrimArray Int -> Args
VArgN (PrimArray Int -> Args) -> PrimArray Int -> Args
forall a b. (a -> b) -> a -> b
$ [Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
PA.primArrayFromList ((Int, Mem) -> Int
forall a b. (a, b) -> a
fst ((Int, Mem) -> Int) -> [(Int, Mem)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Mem)]
args)

combDeps :: GComb val comb -> [Word64]
combDeps :: forall val comb. GComb val comb -> [Word64]
combDeps (Lam Int
_ Int
_ GSection comb
s) = GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
s
combDeps (CachedVal {}) = []

combTypes :: GComb any comb -> [Word64]
combTypes :: forall val comb. GComb val comb -> [Word64]
combTypes (Lam Int
_ Int
_ GSection comb
s) = GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
s
combTypes (CachedVal {}) = []

sectionDeps :: GSection comb -> [Word64]
sectionDeps :: forall comb. GSection comb -> [Word64]
sectionDeps (App Bool
_ (Env (CIx Reference
_ Word64
w Word64
_) comb
_) Args
_) = [Word64
w]
sectionDeps (Call Bool
_ (CIx Reference
_ Word64
w Word64
_) comb
_ Args
_) = [Word64
w]
sectionDeps (Match Int
_ GBranch comb
br) = GBranch comb -> [Word64]
forall comb. GBranch comb -> [Word64]
branchDeps GBranch comb
br
sectionDeps (DMatch Maybe Reference
_ Int
_ GBranch comb
br) = GBranch comb -> [Word64]
forall comb. GBranch comb -> [Word64]
branchDeps GBranch comb
br
sectionDeps (RMatch Int
_ GSection comb
pu EnumMap Word64 (GBranch comb)
br) =
  GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
pu [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (GBranch comb -> [Word64])
-> EnumMap Word64 (GBranch comb) -> [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 comb -> [Word64]
forall comb. GBranch comb -> [Word64]
branchDeps EnumMap Word64 (GBranch comb)
br
sectionDeps (NMatch Maybe Reference
_ Int
_ GBranch comb
br) = GBranch comb -> [Word64]
forall comb. GBranch comb -> [Word64]
branchDeps GBranch comb
br
sectionDeps (Ins GInstr comb
i GSection comb
s)
  | Name (Env (CIx Reference
_ Word64
w Word64
_) comb
_) Args
_ <- GInstr comb
i = Word64
w Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
s
  | Bool
otherwise = GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
s
sectionDeps (Let GSection comb
s (CIx Reference
_ Word64
w Word64
_) Int
_ GSection comb
b) =
  Word64
w Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
s [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
b
sectionDeps GSection comb
_ = []

sectionTypes :: GSection comb -> [Word64]
sectionTypes :: forall comb. GSection comb -> [Word64]
sectionTypes (Ins GInstr comb
i GSection comb
s) = GInstr comb -> [Word64]
forall comb. GInstr comb -> [Word64]
instrTypes GInstr comb
i [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
s
sectionTypes (Let GSection comb
s CombIx
_ Int
_ GSection comb
b) = GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
s [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
b
sectionTypes (Match Int
_ GBranch comb
br) = GBranch comb -> [Word64]
forall comb. GBranch comb -> [Word64]
branchTypes GBranch comb
br
sectionTypes (DMatch Maybe Reference
_ Int
_ GBranch comb
br) = GBranch comb -> [Word64]
forall comb. GBranch comb -> [Word64]
branchTypes GBranch comb
br
sectionTypes (NMatch Maybe Reference
_ Int
_ GBranch comb
br) = GBranch comb -> [Word64]
forall comb. GBranch comb -> [Word64]
branchTypes GBranch comb
br
sectionTypes (RMatch Int
_ GSection comb
pu EnumMap Word64 (GBranch comb)
br) =
  GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
pu [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (GBranch comb -> [Word64])
-> EnumMap Word64 (GBranch comb) -> [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 comb -> [Word64]
forall comb. GBranch comb -> [Word64]
branchTypes EnumMap Word64 (GBranch comb)
br
sectionTypes GSection comb
_ = []

instrTypes :: GInstr comb -> [Word64]
instrTypes :: forall comb. GInstr comb -> [Word64]
instrTypes (Pack Reference
_ (PackedTag 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 GInstr comb
_ = []

branchDeps :: GBranch comb -> [Word64]
branchDeps :: forall comb. GBranch comb -> [Word64]
branchDeps (Test1 Word64
_ GSection comb
s1 GSection comb
d) = GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
d
branchDeps (Test2 Word64
_ GSection comb
s1 Word64
_ GSection comb
s2 GSection comb
d) =
  GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
s2 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
d
branchDeps (TestW GSection comb
d EnumMap Word64 (GSection comb)
m) =
  GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (GSection comb -> [Word64])
-> EnumMap Word64 (GSection comb) -> [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 GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps EnumMap Word64 (GSection comb)
m
branchDeps (TestT GSection comb
d Map Text (GSection comb)
m) =
  GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps GSection comb
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (GSection comb -> [Word64]) -> Map Text (GSection comb) -> [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 GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionDeps Map Text (GSection comb)
m

branchTypes :: GBranch comb -> [Word64]
branchTypes :: forall comb. GBranch comb -> [Word64]
branchTypes (Test1 Word64
_ GSection comb
s1 GSection comb
d) = GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
d
branchTypes (Test2 Word64
_ GSection comb
s1 Word64
_ GSection comb
s2 GSection comb
d) =
  GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
s2 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
d
branchTypes (TestW GSection comb
d EnumMap Word64 (GSection comb)
m) =
  GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (GSection comb -> [Word64])
-> EnumMap Word64 (GSection comb) -> [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 GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes EnumMap Word64 (GSection comb)
m
branchTypes (TestT GSection comb
d Map Text (GSection comb)
m) =
  GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes GSection comb
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (GSection comb -> [Word64]) -> Map Text (GSection comb) -> [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 GSection comb -> [Word64]
forall comb. GSection comb -> [Word64]
sectionTypes Map Text (GSection comb)
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
forall val comb.
(Show val, Show comb) =>
Word64 -> Word64 -> GComb val 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 :: (Show val, Show comb) => Word64 -> Word64 -> GComb val comb -> ShowS
prettyComb :: forall val comb.
(Show val, Show comb) =>
Word64 -> Word64 -> GComb val comb -> ShowS
prettyComb Word64
w Word64
i = \case
  (Lam Int
a Int
_ GSection comb
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
. [Char] -> ShowS
showString [Char]
":"
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
a
      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 -> GSection comb -> ShowS
forall comb. Show comb => Int -> GSection comb -> ShowS
prettySection Int
2 GSection comb
s
  (CachedVal Word64
a val
b) ->
    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
. [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
a
      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
. val -> ShowS
forall a. Show a => a -> ShowS
shows val
b

prettySection :: (Show comb) => Int -> GSection comb -> ShowS
prettySection :: forall comb. Show comb => Int -> GSection comb -> ShowS
prettySection Int
ind GSection comb
sec =
  Int -> ShowS
indent Int
ind ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case GSection comb
sec of
    App Bool
_ GRef comb
r Args
as ->
      [Char] -> ShowS
showString [Char]
"App "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GRef comb -> ShowS
forall comb. Int -> GRef comb -> ShowS
prettyGRef Int
12 GRef comb
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 comb
_ Args
as ->
      [Char] -> ShowS
showString [Char]
"Call " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CombIx -> ShowS
prettyCIx 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 comb
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 comb -> ShowS
forall comb. Show comb => Int -> GBranch comb -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch comb
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 GInstr comb
i GSection comb
nx ->
      GInstr comb -> ShowS
forall comb. Show comb => GInstr comb -> ShowS
prettyIns GInstr comb
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 -> GSection comb -> ShowS
forall comb. Show comb => Int -> GSection comb -> ShowS
prettySection Int
ind GSection comb
nx
    Let GSection comb
s CombIx
_ Int
_ GSection comb
b ->
      [Char] -> ShowS
showString [Char]
"Let\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GSection comb -> ShowS
forall comb. Show comb => Int -> GSection comb -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) GSection comb
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 -> GSection comb -> ShowS
forall comb. Show comb => Int -> GSection comb -> ShowS
prettySection Int
ind GSection comb
b
    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
    GSection comb
Exit -> [Char] -> ShowS
showString [Char]
"Exit"
    DMatch Maybe Reference
_ Int
i GBranch comb
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 comb -> ShowS
forall comb. Show comb => Int -> GBranch comb -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch comb
bs
    NMatch Maybe Reference
_ Int
i GBranch comb
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 comb -> ShowS
forall comb. Show comb => Int -> GBranch comb -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch comb
bs
    RMatch Int
i GSection comb
pu EnumMap Word64 (GBranch comb)
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 -> GSection comb -> ShowS
forall comb. Show comb => Int -> GSection comb -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GSection comb
pu
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, GBranch comb) -> ShowS -> ShowS)
-> ShowS -> [(Word64, GBranch 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, GBranch comb)
p ShowS
r -> (Word64, GBranch comb) -> ShowS
rqc (Word64, GBranch comb)
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 comb) -> [(Word64, GBranch comb)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 (GBranch comb)
bs)
      where
        rqc :: (Word64, GBranch comb) -> ShowS
rqc (Word64
i, GBranch comb
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 comb -> ShowS
forall comb. Show comb => Int -> GBranch comb -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch comb
e

prettyCIx :: CombIx -> ShowS
prettyCIx :: CombIx -> ShowS
prettyCIx (CIx Reference
r Word64
_ Word64
n) =
  Reference -> ShowS
prettyRef Reference
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. if Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then ShowS
forall a. a -> a
id else [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
n

prettyRef :: Reference -> ShowS
prettyRef :: Reference -> ShowS
prettyRef = [Char] -> ShowS
showString ([Char] -> ShowS) -> (Reference -> [Char]) -> Reference -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> [Char]) -> (Reference -> Text) -> Reference -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Reference -> Text
showShort Int
10

prettyGRef :: Int -> GRef comb -> ShowS
prettyGRef :: forall comb. Int -> GRef comb -> ShowS
prettyGRef Int
p GRef comb
r =
  Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ case GRef comb
r of
    Stk Int
i -> [Char] -> ShowS
showString [Char]
"Stk " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i
    Dyn Word64
w -> [Char] -> ShowS
showString [Char]
"Dyn " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
w
    Env CombIx
cix comb
_ -> [Char] -> ShowS
showString [Char]
"Env " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CombIx -> ShowS
prettyCIx CombIx
cix

prettyBranches :: (Show comb) => Int -> GBranch comb -> ShowS
prettyBranches :: forall comb. Show comb => Int -> GBranch comb -> ShowS
prettyBranches Int
ind GBranch comb
bs =
  case GBranch comb
bs of
    Test1 Word64
i GSection comb
e GSection comb
df -> GSection comb -> ShowS
pdf GSection comb
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> GSection comb -> ShowS
picase Word64
i GSection comb
e
    Test2 Word64
i GSection comb
ei Word64
j GSection comb
ej GSection comb
df -> GSection comb -> ShowS
pdf GSection comb
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> GSection comb -> ShowS
picase Word64
i GSection comb
ei ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> GSection comb -> ShowS
picase Word64
j GSection comb
ej
    TestW GSection comb
df EnumMap Word64 (GSection comb)
m ->
      GSection comb -> ShowS
pdf GSection comb
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, GSection comb) -> ShowS -> ShowS)
-> ShowS -> [(Word64, GSection 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, GSection comb
e) ShowS
r -> Word64 -> GSection comb -> ShowS
picase Word64
i GSection comb
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id (EnumMap Word64 (GSection comb) -> [(Word64, GSection comb)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 (GSection comb)
m)
    TestT GSection comb
df Map Text (GSection comb)
m ->
      GSection comb -> ShowS
pdf GSection comb
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, GSection comb) -> ShowS -> ShowS)
-> ShowS -> [(Text, GSection 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 (\(Text
i, GSection comb
e) ShowS
r -> Text -> GSection comb -> ShowS
ptcase Text
i GSection comb
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id (Map Text (GSection comb) -> [(Text, GSection comb)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text (GSection comb)
m)
  where
    pdf :: GSection comb -> ShowS
pdf GSection comb
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 -> GSection comb -> ShowS
forall comb. Show comb => Int -> GSection comb -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GSection comb
e
    ptcase :: Text -> GSection comb -> ShowS
ptcase Text
t GSection comb
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 -> GSection comb -> ShowS
forall comb. Show comb => Int -> GSection comb -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GSection comb
e
    picase :: Word64 -> GSection comb -> ShowS
picase Word64
i GSection comb
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 -> GSection comb -> ShowS
forall comb. Show comb => Int -> GSection comb -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GSection comb
e

prettyIns :: (Show comb) => GInstr comb -> ShowS
prettyIns :: forall comb. Show comb => GInstr comb -> ShowS
prettyIns (Pack Reference
r PackedTag
i Args
as) =
  [Char] -> ShowS
showString [Char]
"Pack "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
prettyRef 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
. PackedTag -> ShowS
forall a. Show a => a -> ShowS
shows PackedTag
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 (Lit MLit
l) =
  [Char] -> ShowS
showString [Char]
"Lit " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MLit -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 MLit
l
prettyIns (Name GRef comb
r Args
as) =
  [Char] -> ShowS
showString [Char]
"Name "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GRef comb -> ShowS
forall comb. Int -> GRef comb -> ShowS
prettyGRef Int
12 GRef comb
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
. Args -> ShowS
prettyArgs Args
as
prettyIns GInstr comb
i = GInstr comb -> ShowS
forall a. Show a => a -> ShowS
shows GInstr comb
i

prettyArgs :: Args -> ShowS
prettyArgs :: Args -> ShowS
prettyArgs Args
ZArgs = [Char] -> ShowS
showString [Char]
"ZArgs"
prettyArgs Args
v = Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Args -> ShowS
forall a. Show a => a -> ShowS
shows Args
v

-- | If running in a sandboxed environment, replace all restricted foreign functions with an error.
sanitizeCombsOfForeignFuncs :: Bool -> (Set ForeignFunc) -> EnumMap Word64 (EnumMap Word64 (GComb Void CombIx)) -> EnumMap Word64 (EnumMap Word64 (GComb Void CombIx))
sanitizeCombsOfForeignFuncs :: Bool
-> Set ForeignFunc
-> EnumMap Word64 (EnumMap Word64 Comb)
-> EnumMap Word64 (EnumMap Word64 Comb)
sanitizeCombsOfForeignFuncs Bool
sanitize Set ForeignFunc
sandboxedForeigns EnumMap Word64 (EnumMap Word64 Comb)
m
  | Bool
sanitize = ((EnumMap Word64 Comb -> EnumMap Word64 Comb)
-> EnumMap Word64 (EnumMap Word64 Comb)
-> EnumMap Word64 (EnumMap Word64 Comb)
forall a b. (a -> b) -> EnumMap Word64 a -> EnumMap Word64 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((EnumMap Word64 Comb -> EnumMap Word64 Comb)
 -> EnumMap Word64 (EnumMap Word64 Comb)
 -> EnumMap Word64 (EnumMap Word64 Comb))
-> ((Comb -> Comb) -> EnumMap Word64 Comb -> EnumMap Word64 Comb)
-> (Comb -> Comb)
-> EnumMap Word64 (EnumMap Word64 Comb)
-> EnumMap Word64 (EnumMap Word64 Comb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comb -> Comb) -> EnumMap Word64 Comb -> EnumMap Word64 Comb
forall a b. (a -> b) -> EnumMap Word64 a -> EnumMap Word64 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Set ForeignFunc -> Comb -> Comb
sanitizeComb Set ForeignFunc
sandboxedForeigns) EnumMap Word64 (EnumMap Word64 Comb)
m
  | Bool
otherwise = EnumMap Word64 (EnumMap Word64 Comb)
m

sanitizeComb :: Set ForeignFunc -> GComb Void CombIx -> GComb Void CombIx
sanitizeComb :: Set ForeignFunc -> Comb -> Comb
sanitizeComb Set ForeignFunc
sandboxedForeigns = \case
  Lam Int
a Int
b Section
s -> Int -> Int -> Section -> Comb
forall comb val. Int -> Int -> GSection comb -> GComb val comb
Lam Int
a Int
b (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
s)

-- | Crawl the source code and statically replace all sandboxed foreign funcs with an error.
sanitizeSection :: Set ForeignFunc -> GSection CombIx -> GSection CombIx
sanitizeSection :: Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
section = case Section
section of
  Ins (ForeignCall Bool
_ ForeignFunc
f Args
as) Section
nx
    | ForeignFunc -> Set ForeignFunc -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ForeignFunc
f Set ForeignFunc
sandboxedForeigns -> GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Text -> GInstr CombIx
forall comb. Text -> GInstr comb
SandboxingFailure (ForeignFunc -> Text
foreignFuncBuiltinName ForeignFunc
f)) (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
nx)
    | Bool
otherwise -> GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Bool -> ForeignFunc -> Args -> GInstr CombIx
forall comb. Bool -> ForeignFunc -> Args -> GInstr comb
ForeignCall Bool
True ForeignFunc
f Args
as) (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
nx)
  Ins GInstr CombIx
i Section
nx -> GInstr CombIx -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins GInstr CombIx
i (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
nx)
  App {} -> Section
section
  Call {} -> Section
section
  Jump {} -> Section
section
  Match Int
i GBranch CombIx
bs -> Int -> GBranch CombIx -> Section
forall comb. Int -> GBranch comb -> GSection comb
Match Int
i (Set ForeignFunc -> GBranch CombIx -> GBranch CombIx
sanitizeBranches Set ForeignFunc
sandboxedForeigns GBranch CombIx
bs)
  Yield {} -> Section
section
  Let Section
s CombIx
i Int
f Section
b -> Section -> CombIx -> Int -> Section -> Section
forall comb.
GSection comb -> CombIx -> Int -> GSection comb -> GSection comb
Let (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
s) CombIx
i Int
f (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
b)
  Die {} -> Section
section
  Section
Exit -> Section
section
  DMatch Maybe Reference
i Int
j GBranch CombIx
bs -> Maybe Reference -> Int -> GBranch CombIx -> Section
forall comb.
Maybe Reference -> Int -> GBranch comb -> GSection comb
DMatch Maybe Reference
i Int
j (Set ForeignFunc -> GBranch CombIx -> GBranch CombIx
sanitizeBranches Set ForeignFunc
sandboxedForeigns GBranch CombIx
bs)
  NMatch Maybe Reference
i Int
j GBranch CombIx
bs -> Maybe Reference -> Int -> GBranch CombIx -> Section
forall comb.
Maybe Reference -> Int -> GBranch comb -> GSection comb
NMatch Maybe Reference
i Int
j (Set ForeignFunc -> GBranch CombIx -> GBranch CombIx
sanitizeBranches Set ForeignFunc
sandboxedForeigns GBranch CombIx
bs)
  RMatch Int
i Section
s EnumMap Word64 (GBranch CombIx)
bs -> Int -> Section -> EnumMap Word64 (GBranch CombIx) -> Section
forall comb.
Int
-> GSection comb -> EnumMap Word64 (GBranch comb) -> GSection comb
RMatch Int
i (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
s) ((GBranch CombIx -> GBranch CombIx)
-> EnumMap Word64 (GBranch CombIx)
-> EnumMap Word64 (GBranch CombIx)
forall a b. (a -> b) -> EnumMap Word64 a -> EnumMap Word64 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set ForeignFunc -> GBranch CombIx -> GBranch CombIx
sanitizeBranches Set ForeignFunc
sandboxedForeigns) EnumMap Word64 (GBranch CombIx)
bs)

sanitizeBranches :: Set ForeignFunc -> GBranch CombIx -> GBranch CombIx
sanitizeBranches :: Set ForeignFunc -> GBranch CombIx -> GBranch CombIx
sanitizeBranches Set ForeignFunc
sandboxedForeigns = \case
  Test1 Word64
i Section
s Section
d -> Word64 -> Section -> Section -> GBranch CombIx
forall comb.
Word64 -> GSection comb -> GSection comb -> GBranch comb
Test1 Word64
i (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
s) (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
d)
  Test2 Word64
i Section
s Word64
j Section
t Section
d -> Word64 -> Section -> Word64 -> Section -> Section -> GBranch CombIx
forall comb.
Word64
-> GSection comb
-> Word64
-> GSection comb
-> GSection comb
-> GBranch comb
Test2 Word64
i (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
s) Word64
j (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
t) (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
d)
  TestW Section
d EnumMap Word64 Section
m -> Section -> EnumMap Word64 Section -> GBranch CombIx
forall comb.
GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
TestW (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
d) ((Section -> Section)
-> EnumMap Word64 Section -> EnumMap Word64 Section
forall a b. (a -> b) -> EnumMap Word64 a -> EnumMap Word64 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns) EnumMap Word64 Section
m)
  TestT Section
d Map Text Section
m -> Section -> Map Text Section -> GBranch CombIx
forall comb.
GSection comb -> Map Text (GSection comb) -> GBranch comb
TestT (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns Section
d) ((Section -> Section) -> Map Text Section -> Map Text Section
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set ForeignFunc -> Section -> Section
sanitizeSection Set ForeignFunc
sandboxedForeigns) Map Text Section
m)