{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
module Unison.Runtime.MCode
( Args' (..),
Args (..),
RefNums (..),
MLit (..),
GInstr (..),
Instr,
RInstr,
GSection (.., MatchT, MatchW),
RSection,
Section,
GComb (..),
Comb,
RComb (..),
pattern RCombIx,
pattern RCombRef,
rCombToComb,
GCombs,
Combs,
RCombs,
CombIx (..),
GRef (..),
RRef,
Ref,
UPrim1 (..),
UPrim2 (..),
BPrim1 (..),
BPrim2 (..),
GBranch (..),
Branch,
RBranch,
bcount,
ucount,
emitCombs,
emitComb,
resolveCombs,
emptyRNs,
argsToLists,
combRef,
rCombRef,
combDeps,
combTypes,
prettyCombs,
prettyComb,
)
where
import Data.Bifunctor (bimap, first)
import Data.Bits (shiftL, shiftR, (.|.))
import Data.Coerce
import Data.Functor ((<&>))
import Data.List (partition)
import Data.Map.Strict qualified as M
import Data.Primitive.ByteArray
import Data.Primitive.PrimArray
import Data.Word (Word16, Word64)
import GHC.Stack (HasCallStack)
import Unison.ABT.Normalized (pattern TAbss)
import Unison.Reference (Reference)
import Unison.Referent (Referent)
import Unison.Runtime.ANF
( ANormal,
Branched (..),
CTag,
Direction (..),
Func (..),
Mem (..),
SuperGroup (..),
SuperNormal (..),
internalBug,
packTags,
pattern TApp,
pattern TBLit,
pattern TFOp,
pattern TFrc,
pattern THnd,
pattern TLets,
pattern TLit,
pattern TMatch,
pattern TName,
pattern TPrm,
pattern TShift,
pattern TVar,
)
import Unison.Runtime.ANF qualified as ANF
import Unison.Runtime.Builtin.Types (builtinTypeNumbering)
import Unison.Util.EnumContainers as EC
import Unison.Util.Text (Text)
import Unison.Var (Var)
data Args'
= Arg1 !Int
| Arg2 !Int !Int
|
ArgN {-# UNPACK #-} !(PrimArray Int)
| ArgR !Int !Int
deriving (Int -> Args' -> ShowS
[Args'] -> ShowS
Args' -> [Char]
(Int -> Args' -> ShowS)
-> (Args' -> [Char]) -> ([Args'] -> ShowS) -> Show Args'
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Args' -> ShowS
showsPrec :: Int -> Args' -> ShowS
$cshow :: Args' -> [Char]
show :: Args' -> [Char]
$cshowList :: [Args'] -> ShowS
showList :: [Args'] -> ShowS
Show)
data Args
= ZArgs
| UArg1 !Int
| UArg2 !Int !Int
| BArg1 !Int
| BArg2 !Int !Int
| DArg2 !Int !Int
| UArgR !Int !Int
| BArgR !Int !Int
| DArgR !Int !Int !Int !Int
| BArgN !(PrimArray Int)
| UArgN !(PrimArray Int)
| DArgN !(PrimArray Int) !(PrimArray Int)
| DArgV !Int !Int
deriving (Int -> Args -> ShowS
[Args] -> ShowS
Args -> [Char]
(Int -> Args -> ShowS)
-> (Args -> [Char]) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Args -> ShowS
showsPrec :: Int -> Args -> ShowS
$cshow :: Args -> [Char]
show :: Args -> [Char]
$cshowList :: [Args] -> ShowS
showList :: [Args] -> ShowS
Show, Args -> Args -> Bool
(Args -> Args -> Bool) -> (Args -> Args -> Bool) -> Eq Args
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Args -> Args -> Bool
== :: Args -> Args -> Bool
$c/= :: Args -> Args -> Bool
/= :: Args -> Args -> Bool
Eq, Eq Args
Eq Args =>
(Args -> Args -> Ordering)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Bool)
-> (Args -> Args -> Args)
-> (Args -> Args -> Args)
-> Ord Args
Args -> Args -> Bool
Args -> Args -> Ordering
Args -> Args -> Args
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Args -> Args -> Ordering
compare :: Args -> Args -> Ordering
$c< :: Args -> Args -> Bool
< :: Args -> Args -> Bool
$c<= :: Args -> Args -> Bool
<= :: Args -> Args -> Bool
$c> :: Args -> Args -> Bool
> :: Args -> Args -> Bool
$c>= :: Args -> Args -> Bool
>= :: Args -> Args -> Bool
$cmax :: Args -> Args -> Args
max :: Args -> Args -> Args
$cmin :: Args -> Args -> Args
min :: Args -> Args -> Args
Ord)
argsToLists :: Args -> ([Int], [Int])
argsToLists :: Args -> ([Int], [Int])
argsToLists Args
ZArgs = ([], [])
argsToLists (UArg1 Int
i) = ([Int
i], [])
argsToLists (UArg2 Int
i Int
j) = ([Int
i, Int
j], [])
argsToLists (BArg1 Int
i) = ([], [Int
i])
argsToLists (BArg2 Int
i Int
j) = ([], [Int
i, Int
j])
argsToLists (DArg2 Int
i Int
j) = ([Int
i], [Int
j])
argsToLists (UArgR Int
i Int
l) = (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
l [Int
i ..], [])
argsToLists (BArgR Int
i Int
l) = ([], Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
l [Int
i ..])
argsToLists (DArgR Int
ui Int
ul Int
bi Int
bl) = (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
ul [Int
ui ..], Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
bl [Int
bi ..])
argsToLists (BArgN PrimArray Int
bs) = ([], PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
bs)
argsToLists (UArgN PrimArray Int
us) = (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
us, [])
argsToLists (DArgN PrimArray Int
us PrimArray Int
bs) = (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
us, PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
bs)
argsToLists (DArgV Int
_ Int
_) = [Char] -> ([Int], [Int])
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"argsToLists: DArgV"
ucount, bcount :: Args -> Int
ucount :: Args -> Int
ucount (UArg1 Int
_) = Int
1
ucount (UArg2 Int
_ Int
_) = Int
2
ucount (DArg2 Int
_ Int
_) = Int
1
ucount (UArgR Int
_ Int
l) = Int
l
ucount (DArgR Int
_ Int
l Int
_ Int
_) = Int
l
ucount Args
_ = Int
0
{-# INLINE ucount #-}
bcount :: Args -> Int
bcount (BArg1 Int
_) = Int
1
bcount (BArg2 Int
_ Int
_) = Int
2
bcount (DArg2 Int
_ Int
_) = Int
1
bcount (BArgR Int
_ Int
l) = Int
l
bcount (DArgR Int
_ Int
_ Int
_ Int
l) = Int
l
bcount (BArgN PrimArray Int
a) = PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Int
a
bcount Args
_ = Int
0
{-# INLINE bcount #-}
data UPrim1
=
DECI
| INCI
| NEGI
| SGNI
| LZRO
| TZRO
| COMN
| POPC
| ABSF
| EXPF
| LOGF
| SQRT
| COSF
| ACOS
| COSH
| ACSH
| SINF
| ASIN
| SINH
| ASNH
| TANF
| ATAN
| TANH
| ATNH
| ITOF
| NTOF
| CEIL
| FLOR
| TRNF
| RNDF
deriving (Int -> UPrim1 -> ShowS
[UPrim1] -> ShowS
UPrim1 -> [Char]
(Int -> UPrim1 -> ShowS)
-> (UPrim1 -> [Char]) -> ([UPrim1] -> ShowS) -> Show UPrim1
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UPrim1 -> ShowS
showsPrec :: Int -> UPrim1 -> ShowS
$cshow :: UPrim1 -> [Char]
show :: UPrim1 -> [Char]
$cshowList :: [UPrim1] -> ShowS
showList :: [UPrim1] -> ShowS
Show, UPrim1 -> UPrim1 -> Bool
(UPrim1 -> UPrim1 -> Bool)
-> (UPrim1 -> UPrim1 -> Bool) -> Eq UPrim1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UPrim1 -> UPrim1 -> Bool
== :: UPrim1 -> UPrim1 -> Bool
$c/= :: UPrim1 -> UPrim1 -> Bool
/= :: UPrim1 -> UPrim1 -> Bool
Eq, Eq UPrim1
Eq UPrim1 =>
(UPrim1 -> UPrim1 -> Ordering)
-> (UPrim1 -> UPrim1 -> Bool)
-> (UPrim1 -> UPrim1 -> Bool)
-> (UPrim1 -> UPrim1 -> Bool)
-> (UPrim1 -> UPrim1 -> Bool)
-> (UPrim1 -> UPrim1 -> UPrim1)
-> (UPrim1 -> UPrim1 -> UPrim1)
-> Ord UPrim1
UPrim1 -> UPrim1 -> Bool
UPrim1 -> UPrim1 -> Ordering
UPrim1 -> UPrim1 -> UPrim1
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UPrim1 -> UPrim1 -> Ordering
compare :: UPrim1 -> UPrim1 -> Ordering
$c< :: UPrim1 -> UPrim1 -> Bool
< :: UPrim1 -> UPrim1 -> Bool
$c<= :: UPrim1 -> UPrim1 -> Bool
<= :: UPrim1 -> UPrim1 -> Bool
$c> :: UPrim1 -> UPrim1 -> Bool
> :: UPrim1 -> UPrim1 -> Bool
$c>= :: UPrim1 -> UPrim1 -> Bool
>= :: UPrim1 -> UPrim1 -> Bool
$cmax :: UPrim1 -> UPrim1 -> UPrim1
max :: UPrim1 -> UPrim1 -> UPrim1
$cmin :: UPrim1 -> UPrim1 -> UPrim1
min :: UPrim1 -> UPrim1 -> UPrim1
Ord)
data UPrim2
=
ADDI
| SUBI
| MULI
| DIVI
| MODI
| DIVN
| MODN
| SHLI
| SHRI
| SHRN
| POWI
| EQLI
| LEQI
| LEQN
| ANDN
| IORN
| XORN
| EQLF
| LEQF
| ADDF
| SUBF
| MULF
| DIVF
| ATN2
| POWF
| LOGB
| MAXF
| MINF
deriving (Int -> UPrim2 -> ShowS
[UPrim2] -> ShowS
UPrim2 -> [Char]
(Int -> UPrim2 -> ShowS)
-> (UPrim2 -> [Char]) -> ([UPrim2] -> ShowS) -> Show UPrim2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UPrim2 -> ShowS
showsPrec :: Int -> UPrim2 -> ShowS
$cshow :: UPrim2 -> [Char]
show :: UPrim2 -> [Char]
$cshowList :: [UPrim2] -> ShowS
showList :: [UPrim2] -> ShowS
Show, UPrim2 -> UPrim2 -> Bool
(UPrim2 -> UPrim2 -> Bool)
-> (UPrim2 -> UPrim2 -> Bool) -> Eq UPrim2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UPrim2 -> UPrim2 -> Bool
== :: UPrim2 -> UPrim2 -> Bool
$c/= :: UPrim2 -> UPrim2 -> Bool
/= :: UPrim2 -> UPrim2 -> Bool
Eq, Eq UPrim2
Eq UPrim2 =>
(UPrim2 -> UPrim2 -> Ordering)
-> (UPrim2 -> UPrim2 -> Bool)
-> (UPrim2 -> UPrim2 -> Bool)
-> (UPrim2 -> UPrim2 -> Bool)
-> (UPrim2 -> UPrim2 -> Bool)
-> (UPrim2 -> UPrim2 -> UPrim2)
-> (UPrim2 -> UPrim2 -> UPrim2)
-> Ord UPrim2
UPrim2 -> UPrim2 -> Bool
UPrim2 -> UPrim2 -> Ordering
UPrim2 -> UPrim2 -> UPrim2
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UPrim2 -> UPrim2 -> Ordering
compare :: UPrim2 -> UPrim2 -> Ordering
$c< :: UPrim2 -> UPrim2 -> Bool
< :: UPrim2 -> UPrim2 -> Bool
$c<= :: UPrim2 -> UPrim2 -> Bool
<= :: UPrim2 -> UPrim2 -> Bool
$c> :: UPrim2 -> UPrim2 -> Bool
> :: UPrim2 -> UPrim2 -> Bool
$c>= :: UPrim2 -> UPrim2 -> Bool
>= :: UPrim2 -> UPrim2 -> Bool
$cmax :: UPrim2 -> UPrim2 -> UPrim2
max :: UPrim2 -> UPrim2 -> UPrim2
$cmin :: UPrim2 -> UPrim2 -> UPrim2
min :: UPrim2 -> UPrim2 -> UPrim2
Ord)
data BPrim1
=
SIZT
| USNC
| UCNS
| ITOT
| NTOT
| FTOT
| TTOI
| TTON
| TTOF
| PAKT
| UPKT
| VWLS
| VWRS
| SIZS
| PAKB
| UPKB
| SIZB
| FLTB
| MISS
| CACH
| LKUP
| LOAD
| CVLD
| VALU
| TLTT
| DBTX
| SDBL
deriving (Int -> BPrim1 -> ShowS
[BPrim1] -> ShowS
BPrim1 -> [Char]
(Int -> BPrim1 -> ShowS)
-> (BPrim1 -> [Char]) -> ([BPrim1] -> ShowS) -> Show BPrim1
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BPrim1 -> ShowS
showsPrec :: Int -> BPrim1 -> ShowS
$cshow :: BPrim1 -> [Char]
show :: BPrim1 -> [Char]
$cshowList :: [BPrim1] -> ShowS
showList :: [BPrim1] -> ShowS
Show, BPrim1 -> BPrim1 -> Bool
(BPrim1 -> BPrim1 -> Bool)
-> (BPrim1 -> BPrim1 -> Bool) -> Eq BPrim1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BPrim1 -> BPrim1 -> Bool
== :: BPrim1 -> BPrim1 -> Bool
$c/= :: BPrim1 -> BPrim1 -> Bool
/= :: BPrim1 -> BPrim1 -> Bool
Eq, Eq BPrim1
Eq BPrim1 =>
(BPrim1 -> BPrim1 -> Ordering)
-> (BPrim1 -> BPrim1 -> Bool)
-> (BPrim1 -> BPrim1 -> Bool)
-> (BPrim1 -> BPrim1 -> Bool)
-> (BPrim1 -> BPrim1 -> Bool)
-> (BPrim1 -> BPrim1 -> BPrim1)
-> (BPrim1 -> BPrim1 -> BPrim1)
-> Ord BPrim1
BPrim1 -> BPrim1 -> Bool
BPrim1 -> BPrim1 -> Ordering
BPrim1 -> BPrim1 -> BPrim1
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BPrim1 -> BPrim1 -> Ordering
compare :: BPrim1 -> BPrim1 -> Ordering
$c< :: BPrim1 -> BPrim1 -> Bool
< :: BPrim1 -> BPrim1 -> Bool
$c<= :: BPrim1 -> BPrim1 -> Bool
<= :: BPrim1 -> BPrim1 -> Bool
$c> :: BPrim1 -> BPrim1 -> Bool
> :: BPrim1 -> BPrim1 -> Bool
$c>= :: BPrim1 -> BPrim1 -> Bool
>= :: BPrim1 -> BPrim1 -> Bool
$cmax :: BPrim1 -> BPrim1 -> BPrim1
max :: BPrim1 -> BPrim1 -> BPrim1
$cmin :: BPrim1 -> BPrim1 -> BPrim1
min :: BPrim1 -> BPrim1 -> BPrim1
Ord)
data BPrim2
=
EQLU
| CMPU
| DRPT
| CATT
| TAKT
| IXOT
| EQLT
| LEQT
| LEST
| DRPS
| CATS
| TAKS
| CONS
| SNOC
| IDXS
| SPLL
| SPLR
| TAKB
| DRPB
| IDXB
| CATB
| IXOB
| THRO
| TRCE
| SDBX
| SDBV
deriving (Int -> BPrim2 -> ShowS
[BPrim2] -> ShowS
BPrim2 -> [Char]
(Int -> BPrim2 -> ShowS)
-> (BPrim2 -> [Char]) -> ([BPrim2] -> ShowS) -> Show BPrim2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BPrim2 -> ShowS
showsPrec :: Int -> BPrim2 -> ShowS
$cshow :: BPrim2 -> [Char]
show :: BPrim2 -> [Char]
$cshowList :: [BPrim2] -> ShowS
showList :: [BPrim2] -> ShowS
Show, BPrim2 -> BPrim2 -> Bool
(BPrim2 -> BPrim2 -> Bool)
-> (BPrim2 -> BPrim2 -> Bool) -> Eq BPrim2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BPrim2 -> BPrim2 -> Bool
== :: BPrim2 -> BPrim2 -> Bool
$c/= :: BPrim2 -> BPrim2 -> Bool
/= :: BPrim2 -> BPrim2 -> Bool
Eq, Eq BPrim2
Eq BPrim2 =>
(BPrim2 -> BPrim2 -> Ordering)
-> (BPrim2 -> BPrim2 -> Bool)
-> (BPrim2 -> BPrim2 -> Bool)
-> (BPrim2 -> BPrim2 -> Bool)
-> (BPrim2 -> BPrim2 -> Bool)
-> (BPrim2 -> BPrim2 -> BPrim2)
-> (BPrim2 -> BPrim2 -> BPrim2)
-> Ord BPrim2
BPrim2 -> BPrim2 -> Bool
BPrim2 -> BPrim2 -> Ordering
BPrim2 -> BPrim2 -> BPrim2
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BPrim2 -> BPrim2 -> Ordering
compare :: BPrim2 -> BPrim2 -> Ordering
$c< :: BPrim2 -> BPrim2 -> Bool
< :: BPrim2 -> BPrim2 -> Bool
$c<= :: BPrim2 -> BPrim2 -> Bool
<= :: BPrim2 -> BPrim2 -> Bool
$c> :: BPrim2 -> BPrim2 -> Bool
> :: BPrim2 -> BPrim2 -> Bool
$c>= :: BPrim2 -> BPrim2 -> Bool
>= :: BPrim2 -> BPrim2 -> Bool
$cmax :: BPrim2 -> BPrim2 -> BPrim2
max :: BPrim2 -> BPrim2 -> BPrim2
$cmin :: BPrim2 -> BPrim2 -> BPrim2
min :: BPrim2 -> BPrim2 -> BPrim2
Ord)
data MLit
= MI !Int
| MD !Double
| MT !Text
| MM !Referent
| MY !Reference
deriving (Int -> MLit -> ShowS
[MLit] -> ShowS
MLit -> [Char]
(Int -> MLit -> ShowS)
-> (MLit -> [Char]) -> ([MLit] -> ShowS) -> Show MLit
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MLit -> ShowS
showsPrec :: Int -> MLit -> ShowS
$cshow :: MLit -> [Char]
show :: MLit -> [Char]
$cshowList :: [MLit] -> ShowS
showList :: [MLit] -> ShowS
Show, MLit -> MLit -> Bool
(MLit -> MLit -> Bool) -> (MLit -> MLit -> Bool) -> Eq MLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MLit -> MLit -> Bool
== :: MLit -> MLit -> Bool
$c/= :: MLit -> MLit -> Bool
/= :: MLit -> MLit -> Bool
Eq, Eq MLit
Eq MLit =>
(MLit -> MLit -> Ordering)
-> (MLit -> MLit -> Bool)
-> (MLit -> MLit -> Bool)
-> (MLit -> MLit -> Bool)
-> (MLit -> MLit -> Bool)
-> (MLit -> MLit -> MLit)
-> (MLit -> MLit -> MLit)
-> Ord MLit
MLit -> MLit -> Bool
MLit -> MLit -> Ordering
MLit -> MLit -> MLit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MLit -> MLit -> Ordering
compare :: MLit -> MLit -> Ordering
$c< :: MLit -> MLit -> Bool
< :: MLit -> MLit -> Bool
$c<= :: MLit -> MLit -> Bool
<= :: MLit -> MLit -> Bool
$c> :: MLit -> MLit -> Bool
> :: MLit -> MLit -> Bool
$c>= :: MLit -> MLit -> Bool
>= :: MLit -> MLit -> Bool
$cmax :: MLit -> MLit -> MLit
max :: MLit -> MLit -> MLit
$cmin :: MLit -> MLit -> MLit
min :: MLit -> MLit -> MLit
Ord)
type Instr = GInstr CombIx
type RInstr = GInstr RComb
data GInstr comb
=
UPrim1
!UPrim1
!Int
|
UPrim2
!UPrim2
!Int
!Int
|
BPrim1
!BPrim1
!Int
|
BPrim2
!BPrim2
!Int
!Int
|
ForeignCall
!Bool
!Word64
!Args
|
SetDyn
!Word64
!Int
|
Capture !Word64
|
Name !(GRef comb) !Args
|
Info !String
|
Pack
!Reference
!Word64
!Args
|
Unpack
!(Maybe Reference)
!Int
|
Lit !MLit
|
BLit !Reference !Word64 !MLit
|
Print !Int
|
Reset !(EnumSet Word64)
|
Fork !Int
|
Atomically !Int
|
Seq !Args
|
TryForce !Int
deriving stock (Int -> GInstr comb -> ShowS
[GInstr comb] -> ShowS
GInstr comb -> [Char]
(Int -> GInstr comb -> ShowS)
-> (GInstr comb -> [Char])
-> ([GInstr comb] -> ShowS)
-> Show (GInstr comb)
forall comb. Show comb => Int -> GInstr comb -> ShowS
forall comb. Show comb => [GInstr comb] -> ShowS
forall comb. Show comb => GInstr comb -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall comb. Show comb => Int -> GInstr comb -> ShowS
showsPrec :: Int -> GInstr comb -> ShowS
$cshow :: forall comb. Show comb => GInstr comb -> [Char]
show :: GInstr comb -> [Char]
$cshowList :: forall comb. Show comb => [GInstr comb] -> ShowS
showList :: [GInstr comb] -> ShowS
Show, GInstr comb -> GInstr comb -> Bool
(GInstr comb -> GInstr comb -> Bool)
-> (GInstr comb -> GInstr comb -> Bool) -> Eq (GInstr comb)
forall comb. Eq comb => GInstr comb -> GInstr comb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall comb. Eq comb => GInstr comb -> GInstr comb -> Bool
== :: GInstr comb -> GInstr comb -> Bool
$c/= :: forall comb. Eq comb => GInstr comb -> GInstr comb -> Bool
/= :: GInstr comb -> GInstr comb -> Bool
Eq, Eq (GInstr comb)
Eq (GInstr comb) =>
(GInstr comb -> GInstr comb -> Ordering)
-> (GInstr comb -> GInstr comb -> Bool)
-> (GInstr comb -> GInstr comb -> Bool)
-> (GInstr comb -> GInstr comb -> Bool)
-> (GInstr comb -> GInstr comb -> Bool)
-> (GInstr comb -> GInstr comb -> GInstr comb)
-> (GInstr comb -> GInstr comb -> GInstr comb)
-> Ord (GInstr comb)
GInstr comb -> GInstr comb -> Bool
GInstr comb -> GInstr comb -> Ordering
GInstr comb -> GInstr comb -> GInstr comb
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall comb. Ord comb => Eq (GInstr comb)
forall comb. Ord comb => GInstr comb -> GInstr comb -> Bool
forall comb. Ord comb => GInstr comb -> GInstr comb -> Ordering
forall comb. Ord comb => GInstr comb -> GInstr comb -> GInstr comb
$ccompare :: forall comb. Ord comb => GInstr comb -> GInstr comb -> Ordering
compare :: GInstr comb -> GInstr comb -> Ordering
$c< :: forall comb. Ord comb => GInstr comb -> GInstr comb -> Bool
< :: GInstr comb -> GInstr comb -> Bool
$c<= :: forall comb. Ord comb => GInstr comb -> GInstr comb -> Bool
<= :: GInstr comb -> GInstr comb -> Bool
$c> :: forall comb. Ord comb => GInstr comb -> GInstr comb -> Bool
> :: GInstr comb -> GInstr comb -> Bool
$c>= :: forall comb. Ord comb => GInstr comb -> GInstr comb -> Bool
>= :: GInstr comb -> GInstr comb -> Bool
$cmax :: forall comb. Ord comb => GInstr comb -> GInstr comb -> GInstr comb
max :: GInstr comb -> GInstr comb -> GInstr comb
$cmin :: forall comb. Ord comb => GInstr comb -> GInstr comb -> GInstr comb
min :: GInstr comb -> GInstr comb -> GInstr comb
Ord, (forall a b. (a -> b) -> GInstr a -> GInstr b)
-> (forall a b. a -> GInstr b -> GInstr a) -> Functor GInstr
forall a b. a -> GInstr b -> GInstr a
forall a b. (a -> b) -> GInstr a -> GInstr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GInstr a -> GInstr b
fmap :: forall a b. (a -> b) -> GInstr a -> GInstr b
$c<$ :: forall a b. a -> GInstr b -> GInstr a
<$ :: forall a b. a -> GInstr b -> GInstr a
Functor, (forall m. Monoid m => GInstr m -> m)
-> (forall m a. Monoid m => (a -> m) -> GInstr a -> m)
-> (forall m a. Monoid m => (a -> m) -> GInstr a -> m)
-> (forall a b. (a -> b -> b) -> b -> GInstr a -> b)
-> (forall a b. (a -> b -> b) -> b -> GInstr a -> b)
-> (forall b a. (b -> a -> b) -> b -> GInstr a -> b)
-> (forall b a. (b -> a -> b) -> b -> GInstr a -> b)
-> (forall a. (a -> a -> a) -> GInstr a -> a)
-> (forall a. (a -> a -> a) -> GInstr a -> a)
-> (forall a. GInstr a -> [a])
-> (forall a. GInstr a -> Bool)
-> (forall a. GInstr a -> Int)
-> (forall a. Eq a => a -> GInstr a -> Bool)
-> (forall a. Ord a => GInstr a -> a)
-> (forall a. Ord a => GInstr a -> a)
-> (forall a. Num a => GInstr a -> a)
-> (forall a. Num a => GInstr a -> a)
-> Foldable GInstr
forall a. Eq a => a -> GInstr a -> Bool
forall a. Num a => GInstr a -> a
forall a. Ord a => GInstr a -> a
forall m. Monoid m => GInstr m -> m
forall a. GInstr a -> Bool
forall a. GInstr a -> Int
forall a. GInstr a -> [a]
forall a. (a -> a -> a) -> GInstr a -> a
forall m a. Monoid m => (a -> m) -> GInstr a -> m
forall b a. (b -> a -> b) -> b -> GInstr a -> b
forall a b. (a -> b -> b) -> b -> GInstr a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GInstr m -> m
fold :: forall m. Monoid m => GInstr m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GInstr a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GInstr a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GInstr a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GInstr a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GInstr a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GInstr a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GInstr a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GInstr a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GInstr a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GInstr a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GInstr a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GInstr a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GInstr a -> a
foldr1 :: forall a. (a -> a -> a) -> GInstr a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GInstr a -> a
foldl1 :: forall a. (a -> a -> a) -> GInstr a -> a
$ctoList :: forall a. GInstr a -> [a]
toList :: forall a. GInstr a -> [a]
$cnull :: forall a. GInstr a -> Bool
null :: forall a. GInstr a -> Bool
$clength :: forall a. GInstr a -> Int
length :: forall a. GInstr a -> Int
$celem :: forall a. Eq a => a -> GInstr a -> Bool
elem :: forall a. Eq a => a -> GInstr a -> Bool
$cmaximum :: forall a. Ord a => GInstr a -> a
maximum :: forall a. Ord a => GInstr a -> a
$cminimum :: forall a. Ord a => GInstr a -> a
minimum :: forall a. Ord a => GInstr a -> a
$csum :: forall a. Num a => GInstr a -> a
sum :: forall a. Num a => GInstr a -> a
$cproduct :: forall a. Num a => GInstr a -> a
product :: forall a. Num a => GInstr a -> a
Foldable, Functor GInstr
Foldable GInstr
(Functor GInstr, Foldable GInstr) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GInstr a -> f (GInstr b))
-> (forall (f :: * -> *) a.
Applicative f =>
GInstr (f a) -> f (GInstr a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GInstr a -> m (GInstr b))
-> (forall (m :: * -> *) a.
Monad m =>
GInstr (m a) -> m (GInstr a))
-> Traversable GInstr
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GInstr (m a) -> m (GInstr a)
forall (f :: * -> *) a.
Applicative f =>
GInstr (f a) -> f (GInstr a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GInstr a -> m (GInstr b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GInstr a -> f (GInstr b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GInstr a -> f (GInstr b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GInstr a -> f (GInstr b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GInstr (f a) -> f (GInstr a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GInstr (f a) -> f (GInstr a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GInstr a -> m (GInstr b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GInstr a -> m (GInstr b)
$csequence :: forall (m :: * -> *) a. Monad m => GInstr (m a) -> m (GInstr a)
sequence :: forall (m :: * -> *) a. Monad m => GInstr (m a) -> m (GInstr a)
Traversable)
type Section = GSection CombIx
type RSection = GSection RComb
data GSection comb
=
App
!Bool
!(GRef comb)
!Args
|
Call
!Bool
!comb
!Args
|
Jump
!Int
!Args
|
Match
!Int
!(GBranch comb)
|
Yield !Args
|
Ins !(GInstr comb) !(GSection comb)
|
Let !(GSection comb) !comb
|
Die String
|
Exit
|
DMatch
!(Maybe Reference)
!Int
!(GBranch comb)
|
NMatch
!(Maybe Reference)
!Int
!(GBranch comb)
|
RMatch
!Int
!(GSection comb)
!(EnumMap Word64 (GBranch comb))
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
!Word64
!Word64
deriving (CombIx -> CombIx -> Bool
(CombIx -> CombIx -> Bool)
-> (CombIx -> CombIx -> Bool) -> Eq CombIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CombIx -> CombIx -> Bool
== :: CombIx -> CombIx -> Bool
$c/= :: CombIx -> CombIx -> Bool
/= :: CombIx -> CombIx -> Bool
Eq, Eq CombIx
Eq CombIx =>
(CombIx -> CombIx -> Ordering)
-> (CombIx -> CombIx -> Bool)
-> (CombIx -> CombIx -> Bool)
-> (CombIx -> CombIx -> Bool)
-> (CombIx -> CombIx -> Bool)
-> (CombIx -> CombIx -> CombIx)
-> (CombIx -> CombIx -> CombIx)
-> Ord CombIx
CombIx -> CombIx -> Bool
CombIx -> CombIx -> Ordering
CombIx -> CombIx -> CombIx
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CombIx -> CombIx -> Ordering
compare :: CombIx -> CombIx -> Ordering
$c< :: CombIx -> CombIx -> Bool
< :: CombIx -> CombIx -> Bool
$c<= :: CombIx -> CombIx -> Bool
<= :: CombIx -> CombIx -> Bool
$c> :: CombIx -> CombIx -> Bool
> :: CombIx -> CombIx -> Bool
$c>= :: CombIx -> CombIx -> Bool
>= :: CombIx -> CombIx -> Bool
$cmax :: CombIx -> CombIx -> CombIx
max :: CombIx -> CombIx -> CombIx
$cmin :: CombIx -> CombIx -> CombIx
min :: CombIx -> CombIx -> CombIx
Ord, Int -> CombIx -> ShowS
[CombIx] -> ShowS
CombIx -> [Char]
(Int -> CombIx -> ShowS)
-> (CombIx -> [Char]) -> ([CombIx] -> ShowS) -> Show CombIx
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CombIx -> ShowS
showsPrec :: Int -> CombIx -> ShowS
$cshow :: CombIx -> [Char]
show :: CombIx -> [Char]
$cshowList :: [CombIx] -> ShowS
showList :: [CombIx] -> ShowS
Show)
combRef :: CombIx -> Reference
combRef :: CombIx -> Reference
combRef (CIx Reference
r Word64
_ Word64
_) = Reference
r
rCombRef :: RComb -> Reference
rCombRef :: RComb -> Reference
rCombRef (RComb CombIx
cix GComb RComb
_) = CombIx -> Reference
combRef CombIx
cix
data RefNums = RN
{ RefNums -> Reference -> Word64
dnum :: Reference -> Word64,
RefNums -> Reference -> Word64
cnum :: Reference -> Word64
}
emptyRNs :: RefNums
emptyRNs :: RefNums
emptyRNs = (Reference -> Word64) -> (Reference -> Word64) -> RefNums
RN Reference -> Word64
forall {p} {a}. p -> a
mt Reference -> Word64
forall {p} {a}. p -> a
mt
where
mt :: p -> a
mt p
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"RefNums: empty"
type Comb = GComb CombIx
data GComb comb
= Lam
!Int
!Int
!Int
!Int
!(GSection comb)
deriving stock (Int -> GComb comb -> ShowS
[GComb comb] -> ShowS
GComb comb -> [Char]
(Int -> GComb comb -> ShowS)
-> (GComb comb -> [Char])
-> ([GComb comb] -> ShowS)
-> Show (GComb comb)
forall comb. Show comb => Int -> GComb comb -> ShowS
forall comb. Show comb => [GComb comb] -> ShowS
forall comb. Show comb => GComb comb -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall comb. Show comb => Int -> GComb comb -> ShowS
showsPrec :: Int -> GComb comb -> ShowS
$cshow :: forall comb. Show comb => GComb comb -> [Char]
show :: GComb comb -> [Char]
$cshowList :: forall comb. Show comb => [GComb comb] -> ShowS
showList :: [GComb comb] -> ShowS
Show, GComb comb -> GComb comb -> Bool
(GComb comb -> GComb comb -> Bool)
-> (GComb comb -> GComb comb -> Bool) -> Eq (GComb comb)
forall comb. Eq comb => GComb comb -> GComb comb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall comb. Eq comb => GComb comb -> GComb comb -> Bool
== :: GComb comb -> GComb comb -> Bool
$c/= :: forall comb. Eq comb => GComb comb -> GComb comb -> Bool
/= :: GComb comb -> GComb comb -> Bool
Eq, Eq (GComb comb)
Eq (GComb comb) =>
(GComb comb -> GComb comb -> Ordering)
-> (GComb comb -> GComb comb -> Bool)
-> (GComb comb -> GComb comb -> Bool)
-> (GComb comb -> GComb comb -> Bool)
-> (GComb comb -> GComb comb -> Bool)
-> (GComb comb -> GComb comb -> GComb comb)
-> (GComb comb -> GComb comb -> GComb comb)
-> Ord (GComb comb)
GComb comb -> GComb comb -> Bool
GComb comb -> GComb comb -> Ordering
GComb comb -> GComb comb -> GComb comb
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall comb. Ord comb => Eq (GComb comb)
forall comb. Ord comb => GComb comb -> GComb comb -> Bool
forall comb. Ord comb => GComb comb -> GComb comb -> Ordering
forall comb. Ord comb => GComb comb -> GComb comb -> GComb comb
$ccompare :: forall comb. Ord comb => GComb comb -> GComb comb -> Ordering
compare :: GComb comb -> GComb comb -> Ordering
$c< :: forall comb. Ord comb => GComb comb -> GComb comb -> Bool
< :: GComb comb -> GComb comb -> Bool
$c<= :: forall comb. Ord comb => GComb comb -> GComb comb -> Bool
<= :: GComb comb -> GComb comb -> Bool
$c> :: forall comb. Ord comb => GComb comb -> GComb comb -> Bool
> :: GComb comb -> GComb comb -> Bool
$c>= :: forall comb. Ord comb => GComb comb -> GComb comb -> Bool
>= :: GComb comb -> GComb comb -> Bool
$cmax :: forall comb. Ord comb => GComb comb -> GComb comb -> GComb comb
max :: GComb comb -> GComb comb -> GComb comb
$cmin :: forall comb. Ord comb => GComb comb -> GComb comb -> GComb comb
min :: GComb comb -> GComb comb -> GComb comb
Ord, (forall a b. (a -> b) -> GComb a -> GComb b)
-> (forall a b. a -> GComb b -> GComb a) -> Functor GComb
forall a b. a -> GComb b -> GComb a
forall a b. (a -> b) -> GComb a -> GComb b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GComb a -> GComb b
fmap :: forall a b. (a -> b) -> GComb a -> GComb b
$c<$ :: forall a b. a -> GComb b -> GComb a
<$ :: forall a b. a -> GComb b -> GComb a
Functor, (forall m. Monoid m => GComb m -> m)
-> (forall m a. Monoid m => (a -> m) -> GComb a -> m)
-> (forall m a. Monoid m => (a -> m) -> GComb a -> m)
-> (forall a b. (a -> b -> b) -> b -> GComb a -> b)
-> (forall a b. (a -> b -> b) -> b -> GComb a -> b)
-> (forall b a. (b -> a -> b) -> b -> GComb a -> b)
-> (forall b a. (b -> a -> b) -> b -> GComb a -> b)
-> (forall a. (a -> a -> a) -> GComb a -> a)
-> (forall a. (a -> a -> a) -> GComb a -> a)
-> (forall a. GComb a -> [a])
-> (forall a. GComb a -> Bool)
-> (forall a. GComb a -> Int)
-> (forall a. Eq a => a -> GComb a -> Bool)
-> (forall a. Ord a => GComb a -> a)
-> (forall a. Ord a => GComb a -> a)
-> (forall a. Num a => GComb a -> a)
-> (forall a. Num a => GComb a -> a)
-> Foldable GComb
forall a. Eq a => a -> GComb a -> Bool
forall a. Num a => GComb a -> a
forall a. Ord a => GComb a -> a
forall m. Monoid m => GComb m -> m
forall a. GComb a -> Bool
forall a. GComb a -> Int
forall a. GComb a -> [a]
forall a. (a -> a -> a) -> GComb a -> a
forall m a. Monoid m => (a -> m) -> GComb a -> m
forall b a. (b -> a -> b) -> b -> GComb a -> b
forall a b. (a -> b -> b) -> b -> GComb a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GComb m -> m
fold :: forall m. Monoid m => GComb m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GComb a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GComb a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GComb a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GComb a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GComb a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GComb a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GComb a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GComb a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GComb a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GComb a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GComb a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GComb a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GComb a -> a
foldr1 :: forall a. (a -> a -> a) -> GComb a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GComb a -> a
foldl1 :: forall a. (a -> a -> a) -> GComb a -> a
$ctoList :: forall a. GComb a -> [a]
toList :: forall a. GComb a -> [a]
$cnull :: forall a. GComb a -> Bool
null :: forall a. GComb a -> Bool
$clength :: forall a. GComb a -> Int
length :: forall a. GComb a -> Int
$celem :: forall a. Eq a => a -> GComb a -> Bool
elem :: forall a. Eq a => a -> GComb a -> Bool
$cmaximum :: forall a. Ord a => GComb a -> a
maximum :: forall a. Ord a => GComb a -> a
$cminimum :: forall a. Ord a => GComb a -> a
minimum :: forall a. Ord a => GComb a -> a
$csum :: forall a. Num a => GComb a -> a
sum :: forall a. Num a => GComb a -> a
$cproduct :: forall a. Num a => GComb a -> a
product :: forall a. Num a => GComb a -> a
Foldable, Functor GComb
Foldable GComb
(Functor GComb, Foldable GComb) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb a -> f (GComb b))
-> (forall (f :: * -> *) a.
Applicative f =>
GComb (f a) -> f (GComb a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb a -> m (GComb b))
-> (forall (m :: * -> *) a. Monad m => GComb (m a) -> m (GComb a))
-> Traversable GComb
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GComb (m a) -> m (GComb a)
forall (f :: * -> *) a. Applicative f => GComb (f a) -> f (GComb a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb a -> m (GComb b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb a -> f (GComb b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb a -> f (GComb b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GComb a -> f (GComb b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => GComb (f a) -> f (GComb a)
sequenceA :: forall (f :: * -> *) a. Applicative f => GComb (f a) -> f (GComb a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb a -> m (GComb b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GComb a -> m (GComb b)
$csequence :: forall (m :: * -> *) a. Monad m => GComb (m a) -> m (GComb a)
sequence :: forall (m :: * -> *) a. Monad m => GComb (m a) -> m (GComb a)
Traversable)
type Combs = GCombs CombIx
type RCombs = GCombs RComb
pattern RCombIx :: CombIx -> RComb
pattern $mRCombIx :: forall {r}. RComb -> (CombIx -> r) -> ((# #) -> r) -> r
RCombIx r <- (rCombIx -> r)
{-# COMPLETE RCombIx #-}
pattern RCombRef :: Reference -> RComb
pattern $mRCombRef :: forall {r}. RComb -> (Reference -> r) -> ((# #) -> r) -> r
RCombRef r <- (combRef . rCombIx -> r)
{-# COMPLETE RCombRef #-}
data RComb = RComb
{ RComb -> CombIx
rCombIx :: !CombIx,
RComb -> GComb RComb
unRComb :: (GComb RComb )
}
instance Eq RComb where
RComb CombIx
r1 GComb RComb
_ == :: RComb -> RComb -> Bool
== RComb CombIx
r2 GComb RComb
_ = CombIx
r1 CombIx -> CombIx -> Bool
forall a. Eq a => a -> a -> Bool
== CombIx
r2
instance Ord RComb where
compare :: RComb -> RComb -> Ordering
compare (RComb CombIx
r1 GComb RComb
_) (RComb CombIx
r2 GComb RComb
_) = CombIx -> CombIx -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CombIx
r1 CombIx
r2
rCombToComb :: RComb -> Comb
rCombToComb :: RComb -> Comb
rCombToComb (RComb CombIx
_ix GComb RComb
c) = RComb -> CombIx
rCombIx (RComb -> CombIx) -> GComb RComb -> Comb
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GComb RComb
c
instance Show RComb where
show :: RComb -> [Char]
show (RComb CombIx
ix GComb RComb
_) = CombIx -> [Char]
forall a. Show a => a -> [Char]
show CombIx
ix
type GCombs comb = EnumMap Word64 (GComb comb)
type Ref = GRef CombIx
type RRef = GRef RComb
data GRef comb
= Stk !Int
| Env !comb
| Dyn !Word64
deriving (Int -> GRef comb -> ShowS
[GRef comb] -> ShowS
GRef comb -> [Char]
(Int -> GRef comb -> ShowS)
-> (GRef comb -> [Char])
-> ([GRef comb] -> ShowS)
-> Show (GRef comb)
forall comb. Show comb => Int -> GRef comb -> ShowS
forall comb. Show comb => [GRef comb] -> ShowS
forall comb. Show comb => GRef comb -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall comb. Show comb => Int -> GRef comb -> ShowS
showsPrec :: Int -> GRef comb -> ShowS
$cshow :: forall comb. Show comb => GRef comb -> [Char]
show :: GRef comb -> [Char]
$cshowList :: forall comb. Show comb => [GRef comb] -> ShowS
showList :: [GRef comb] -> ShowS
Show, GRef comb -> GRef comb -> Bool
(GRef comb -> GRef comb -> Bool)
-> (GRef comb -> GRef comb -> Bool) -> Eq (GRef comb)
forall comb. Eq comb => GRef comb -> GRef comb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall comb. Eq comb => GRef comb -> GRef comb -> Bool
== :: GRef comb -> GRef comb -> Bool
$c/= :: forall comb. Eq comb => GRef comb -> GRef comb -> Bool
/= :: GRef comb -> GRef comb -> Bool
Eq, Eq (GRef comb)
Eq (GRef comb) =>
(GRef comb -> GRef comb -> Ordering)
-> (GRef comb -> GRef comb -> Bool)
-> (GRef comb -> GRef comb -> Bool)
-> (GRef comb -> GRef comb -> Bool)
-> (GRef comb -> GRef comb -> Bool)
-> (GRef comb -> GRef comb -> GRef comb)
-> (GRef comb -> GRef comb -> GRef comb)
-> Ord (GRef comb)
GRef comb -> GRef comb -> Bool
GRef comb -> GRef comb -> Ordering
GRef comb -> GRef comb -> GRef comb
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall comb. Ord comb => Eq (GRef comb)
forall comb. Ord comb => GRef comb -> GRef comb -> Bool
forall comb. Ord comb => GRef comb -> GRef comb -> Ordering
forall comb. Ord comb => GRef comb -> GRef comb -> GRef comb
$ccompare :: forall comb. Ord comb => GRef comb -> GRef comb -> Ordering
compare :: GRef comb -> GRef comb -> Ordering
$c< :: forall comb. Ord comb => GRef comb -> GRef comb -> Bool
< :: GRef comb -> GRef comb -> Bool
$c<= :: forall comb. Ord comb => GRef comb -> GRef comb -> Bool
<= :: GRef comb -> GRef comb -> Bool
$c> :: forall comb. Ord comb => GRef comb -> GRef comb -> Bool
> :: GRef comb -> GRef comb -> Bool
$c>= :: forall comb. Ord comb => GRef comb -> GRef comb -> Bool
>= :: GRef comb -> GRef comb -> Bool
$cmax :: forall comb. Ord comb => GRef comb -> GRef comb -> GRef comb
max :: GRef comb -> GRef comb -> GRef comb
$cmin :: forall comb. Ord comb => GRef comb -> GRef comb -> GRef comb
min :: GRef comb -> GRef comb -> GRef comb
Ord, (forall a b. (a -> b) -> GRef a -> GRef b)
-> (forall a b. a -> GRef b -> GRef a) -> Functor GRef
forall a b. a -> GRef b -> GRef a
forall a b. (a -> b) -> GRef a -> GRef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GRef a -> GRef b
fmap :: forall a b. (a -> b) -> GRef a -> GRef b
$c<$ :: forall a b. a -> GRef b -> GRef a
<$ :: forall a b. a -> GRef b -> GRef a
Functor, (forall m. Monoid m => GRef m -> m)
-> (forall m a. Monoid m => (a -> m) -> GRef a -> m)
-> (forall m a. Monoid m => (a -> m) -> GRef a -> m)
-> (forall a b. (a -> b -> b) -> b -> GRef a -> b)
-> (forall a b. (a -> b -> b) -> b -> GRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> GRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> GRef a -> b)
-> (forall a. (a -> a -> a) -> GRef a -> a)
-> (forall a. (a -> a -> a) -> GRef a -> a)
-> (forall a. GRef a -> [a])
-> (forall a. GRef a -> Bool)
-> (forall a. GRef a -> Int)
-> (forall a. Eq a => a -> GRef a -> Bool)
-> (forall a. Ord a => GRef a -> a)
-> (forall a. Ord a => GRef a -> a)
-> (forall a. Num a => GRef a -> a)
-> (forall a. Num a => GRef a -> a)
-> Foldable GRef
forall a. Eq a => a -> GRef a -> Bool
forall a. Num a => GRef a -> a
forall a. Ord a => GRef a -> a
forall m. Monoid m => GRef m -> m
forall a. GRef a -> Bool
forall a. GRef a -> Int
forall a. GRef a -> [a]
forall a. (a -> a -> a) -> GRef a -> a
forall m a. Monoid m => (a -> m) -> GRef a -> m
forall b a. (b -> a -> b) -> b -> GRef a -> b
forall a b. (a -> b -> b) -> b -> GRef a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GRef m -> m
fold :: forall m. Monoid m => GRef m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GRef a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GRef a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GRef a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GRef a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GRef a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GRef a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GRef a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GRef a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GRef a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GRef a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GRef a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GRef a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GRef a -> a
foldr1 :: forall a. (a -> a -> a) -> GRef a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GRef a -> a
foldl1 :: forall a. (a -> a -> a) -> GRef a -> a
$ctoList :: forall a. GRef a -> [a]
toList :: forall a. GRef a -> [a]
$cnull :: forall a. GRef a -> Bool
null :: forall a. GRef a -> Bool
$clength :: forall a. GRef a -> Int
length :: forall a. GRef a -> Int
$celem :: forall a. Eq a => a -> GRef a -> Bool
elem :: forall a. Eq a => a -> GRef a -> Bool
$cmaximum :: forall a. Ord a => GRef a -> a
maximum :: forall a. Ord a => GRef a -> a
$cminimum :: forall a. Ord a => GRef a -> a
minimum :: forall a. Ord a => GRef a -> a
$csum :: forall a. Num a => GRef a -> a
sum :: forall a. Num a => GRef a -> a
$cproduct :: forall a. Num a => GRef a -> a
product :: forall a. Num a => GRef a -> a
Foldable, Functor GRef
Foldable GRef
(Functor GRef, Foldable GRef) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRef a -> f (GRef b))
-> (forall (f :: * -> *) a.
Applicative f =>
GRef (f a) -> f (GRef a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRef a -> m (GRef b))
-> (forall (m :: * -> *) a. Monad m => GRef (m a) -> m (GRef a))
-> Traversable GRef
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GRef (m a) -> m (GRef a)
forall (f :: * -> *) a. Applicative f => GRef (f a) -> f (GRef a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRef a -> m (GRef b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRef a -> f (GRef b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRef a -> f (GRef b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GRef a -> f (GRef b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => GRef (f a) -> f (GRef a)
sequenceA :: forall (f :: * -> *) a. Applicative f => GRef (f a) -> f (GRef a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRef a -> m (GRef b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GRef a -> m (GRef b)
$csequence :: forall (m :: * -> *) a. Monad m => GRef (m a) -> m (GRef a)
sequence :: forall (m :: * -> *) a. Monad m => GRef (m a) -> m (GRef a)
Traversable)
type Branch = GBranch CombIx
type RBranch = GBranch RComb
data GBranch comb
=
Test1
!Word64
!(GSection comb)
!(GSection comb)
| Test2
!Word64
!(GSection comb)
!Word64
!(GSection comb)
!(GSection comb)
| 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)
pattern MatchW :: Int -> (GSection comb) -> EnumMap Word64 (GSection comb) -> (GSection comb)
pattern $mMatchW :: forall {r} {comb}.
GSection comb
-> (Int -> GSection comb -> EnumMap Word64 (GSection comb) -> r)
-> ((# #) -> r)
-> r
$bMatchW :: forall comb.
Int
-> GSection comb -> EnumMap Word64 (GSection comb) -> GSection comb
MatchW i d cs = Match i (TestW d cs)
pattern MatchT :: Int -> (GSection comb) -> M.Map Text (GSection comb) -> (GSection comb)
pattern $mMatchT :: forall {r} {comb}.
GSection comb
-> (Int -> GSection comb -> Map Text (GSection comb) -> r)
-> ((# #) -> r)
-> r
$bMatchT :: forall comb.
Int -> GSection comb -> Map Text (GSection comb) -> GSection comb
MatchT i d cs = Match i (TestT d cs)
pattern NMatchW ::
Maybe Reference -> Int -> (GSection comb) -> EnumMap Word64 (GSection comb) -> (GSection comb)
pattern $mNMatchW :: forall {r} {comb}.
GSection comb
-> (Maybe Reference
-> Int -> GSection comb -> EnumMap Word64 (GSection comb) -> r)
-> ((# #) -> r)
-> r
$bNMatchW :: forall comb.
Maybe Reference
-> Int
-> GSection comb
-> EnumMap Word64 (GSection comb)
-> GSection comb
NMatchW r i d cs = NMatch r i (TestW d cs)
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)
type RCtx v = M.Map v Word64
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
ctxResolve :: (Var v) => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve :: forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v = Int -> Int -> Ctx v -> Maybe (Int, Mem)
walk Int
0 Int
0 Ctx v
ctx
where
walk :: Int -> Int -> Ctx v -> Maybe (Int, Mem)
walk Int
_ Int
_ Ctx v
ECtx = Maybe (Int, Mem)
forall a. Maybe a
Nothing
walk Int
ui Int
bi (Block Ctx v
ctx) = Int -> Int -> Ctx v -> Maybe (Int, Mem)
walk Int
ui Int
bi Ctx v
ctx
walk Int
ui Int
bi (Tag Ctx v
ctx) = Int -> Int -> Ctx v -> Maybe (Int, Mem)
walk (Int
ui Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
bi Ctx v
ctx
walk Int
ui Int
bi (Var v
x Mem
m Ctx v
ctx)
| v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
x = case Mem
m of Mem
BX -> (Int, Mem) -> Maybe (Int, Mem)
forall a. a -> Maybe a
Just (Int
bi, Mem
m); Mem
UN -> (Int, Mem) -> Maybe (Int, Mem)
forall a. a -> Maybe a
Just (Int
ui, Mem
m)
| Bool
otherwise = Int -> Int -> Ctx v -> Maybe (Int, Mem)
walk Int
ui' Int
bi' Ctx v
ctx
where
(Int
ui', Int
bi') = case Mem
m of Mem
BX -> (Int
ui, Int
bi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1); Mem
UN -> (Int
ui Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
bi)
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
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
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
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
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
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)
resolveCombs ::
Maybe (EnumMap Word64 RCombs) ->
EnumMap Word64 Combs ->
EnumMap Word64 RCombs
resolveCombs :: Maybe (EnumMap Word64 RCombs)
-> EnumMap Word64 (EnumMap Word64 Comb) -> EnumMap Word64 RCombs
resolveCombs Maybe (EnumMap Word64 RCombs)
mayExisting EnumMap Word64 (EnumMap Word64 Comb)
combs =
let ~EnumMap Word64 RCombs
resolved =
EnumMap Word64 (EnumMap Word64 Comb)
combs
EnumMap Word64 (EnumMap Word64 Comb)
-> (EnumMap Word64 Comb -> RCombs) -> EnumMap Word64 RCombs
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Comb -> GComb RComb) -> EnumMap Word64 Comb -> RCombs
forall a b. (a -> b) -> EnumMap Word64 a -> EnumMap Word64 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Comb -> GComb RComb) -> EnumMap Word64 Comb -> RCombs)
-> ((CombIx -> RComb) -> Comb -> GComb RComb)
-> (CombIx -> RComb)
-> EnumMap Word64 Comb
-> RCombs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CombIx -> RComb) -> Comb -> GComb RComb
forall a b. (a -> b) -> GComb a -> GComb b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) \(cix :: CombIx
cix@(CIx Reference
_ Word64
n Word64
i)) ->
let cmbs :: RCombs
cmbs = case Maybe (EnumMap Word64 RCombs)
mayExisting Maybe (EnumMap Word64 RCombs)
-> (EnumMap Word64 RCombs -> Maybe RCombs) -> Maybe RCombs
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word64 -> EnumMap Word64 RCombs -> Maybe RCombs
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
n of
Just RCombs
cmbs -> RCombs
cmbs
Maybe RCombs
Nothing ->
case Word64 -> EnumMap Word64 RCombs -> Maybe RCombs
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
n EnumMap Word64 RCombs
resolved of
Just RCombs
cmbs -> RCombs
cmbs
Maybe RCombs
Nothing -> [Char] -> RCombs
forall a. HasCallStack => [Char] -> a
error ([Char] -> RCombs) -> [Char] -> RCombs
forall a b. (a -> b) -> a -> b
$ [Char]
"unknown combinator `" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"`."
in case Word64 -> RCombs -> Maybe (GComb RComb)
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
i RCombs
cmbs of
Just GComb RComb
cmb -> CombIx -> GComb RComb -> RComb
RComb CombIx
cix GComb RComb
cmb
Maybe (GComb RComb)
Nothing ->
[Char] -> RComb
forall a. HasCallStack => [Char] -> a
error ([Char] -> RComb) -> [Char] -> RComb
forall a b. (a -> b) -> a -> b
$
[Char]
"unknown section `"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
i
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"` of combinator `"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
n
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"`."
in EnumMap Word64 RCombs
resolved
data Counted a = C !Int !Int a
deriving ((forall a b. (a -> b) -> Counted a -> Counted b)
-> (forall a b. a -> Counted b -> Counted a) -> Functor Counted
forall a b. a -> Counted b -> Counted a
forall a b. (a -> b) -> Counted a -> Counted b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Counted a -> Counted b
fmap :: forall a b. (a -> b) -> Counted a -> Counted b
$c<$ :: forall a b. a -> Counted b -> Counted a
<$ :: forall a b. a -> Counted b -> Counted a
Functor)
instance Applicative Counted where
pure :: forall a. a -> Counted a
pure = Int -> Int -> a -> Counted a
forall a. Int -> Int -> a -> Counted a
C Int
0 Int
0
C Int
u0 Int
b0 a -> b
f <*> :: forall a b. Counted (a -> b) -> Counted a -> Counted b
<*> C Int
u1 Int
b1 a
x = Int -> Int -> b -> Counted b
forall a. Int -> Int -> a -> Counted a
C (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
u0 Int
u1) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
b0 Int
b1) (a -> b
f a
x)
newtype Emit a
= EM (Word64 -> (EC.EnumMap Word64 Comb, Counted a))
deriving ((forall a b. (a -> b) -> Emit a -> Emit b)
-> (forall a b. a -> Emit b -> Emit a) -> Functor Emit
forall a b. a -> Emit b -> Emit a
forall a b. (a -> b) -> Emit a -> Emit b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Emit a -> Emit b
fmap :: forall a b. (a -> b) -> Emit a -> Emit b
$c<$ :: forall a b. a -> Emit b -> Emit a
<$ :: forall a b. a -> Emit b -> Emit a
Functor)
runEmit :: Word64 -> Emit a -> EC.EnumMap Word64 Comb
runEmit :: forall a. Word64 -> Emit a -> EnumMap Word64 Comb
runEmit Word64
w (EM Word64 -> (EnumMap Word64 Comb, Counted a)
e) = (EnumMap Word64 Comb, Counted a) -> EnumMap Word64 Comb
forall a b. (a, b) -> a
fst ((EnumMap Word64 Comb, Counted a) -> EnumMap Word64 Comb)
-> (EnumMap Word64 Comb, Counted a) -> EnumMap Word64 Comb
forall a b. (a -> b) -> a -> b
$ Word64 -> (EnumMap Word64 Comb, Counted a)
e Word64
w
instance Applicative Emit where
pure :: forall a. a -> Emit a
pure = (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a)
-> (a -> Word64 -> (EnumMap Word64 Comb, Counted a)) -> a -> Emit a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap Word64 Comb, Counted a)
-> Word64 -> (EnumMap Word64 Comb, Counted a)
forall a. a -> Word64 -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((EnumMap Word64 Comb, Counted a)
-> Word64 -> (EnumMap Word64 Comb, Counted a))
-> (a -> (EnumMap Word64 Comb, Counted a))
-> a
-> Word64
-> (EnumMap Word64 Comb, Counted a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Counted a -> (EnumMap Word64 Comb, Counted a)
forall a. a -> (EnumMap Word64 Comb, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Counted a -> (EnumMap Word64 Comb, Counted a))
-> (a -> Counted a) -> a -> (EnumMap Word64 Comb, Counted a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Counted a
forall a. a -> Counted a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
EM Word64 -> (EnumMap Word64 Comb, Counted (a -> b))
ef <*> :: forall a b. Emit (a -> b) -> Emit a -> Emit b
<*> EM Word64 -> (EnumMap Word64 Comb, Counted a)
ex = (Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b)
-> (Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b
forall a b. (a -> b) -> a -> b
$ (((EnumMap Word64 Comb, Counted (a -> b))
-> (EnumMap Word64 Comb, Counted a)
-> (EnumMap Word64 Comb, Counted b))
-> (Word64 -> (EnumMap Word64 Comb, Counted (a -> b)))
-> (Word64 -> (EnumMap Word64 Comb, Counted a))
-> Word64
-> (EnumMap Word64 Comb, Counted b)
forall a b c.
(a -> b -> c) -> (Word64 -> a) -> (Word64 -> b) -> Word64 -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (((EnumMap Word64 Comb, Counted (a -> b))
-> (EnumMap Word64 Comb, Counted a)
-> (EnumMap Word64 Comb, Counted b))
-> (Word64 -> (EnumMap Word64 Comb, Counted (a -> b)))
-> (Word64 -> (EnumMap Word64 Comb, Counted a))
-> Word64
-> (EnumMap Word64 Comb, Counted b))
-> ((Counted (a -> b) -> Counted a -> Counted b)
-> (EnumMap Word64 Comb, Counted (a -> b))
-> (EnumMap Word64 Comb, Counted a)
-> (EnumMap Word64 Comb, Counted b))
-> (Counted (a -> b) -> Counted a -> Counted b)
-> (Word64 -> (EnumMap Word64 Comb, Counted (a -> b)))
-> (Word64 -> (EnumMap Word64 Comb, Counted a))
-> Word64
-> (EnumMap Word64 Comb, Counted b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Counted (a -> b) -> Counted a -> Counted b)
-> (EnumMap Word64 Comb, Counted (a -> b))
-> (EnumMap Word64 Comb, Counted a)
-> (EnumMap Word64 Comb, Counted b)
forall a b c.
(a -> b -> c)
-> (EnumMap Word64 Comb, a)
-> (EnumMap Word64 Comb, b)
-> (EnumMap Word64 Comb, c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2) Counted (a -> b) -> Counted a -> Counted b
forall a b. Counted (a -> b) -> Counted a -> Counted b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) Word64 -> (EnumMap Word64 Comb, Counted (a -> b))
ef Word64 -> (EnumMap Word64 Comb, Counted a)
ex
counted :: Counted a -> Emit a
counted :: forall a. Counted a -> Emit a
counted = (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a)
-> (Counted a -> Word64 -> (EnumMap Word64 Comb, Counted a))
-> Counted a
-> Emit a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap Word64 Comb, Counted a)
-> Word64 -> (EnumMap Word64 Comb, Counted a)
forall a. a -> Word64 -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((EnumMap Word64 Comb, Counted a)
-> Word64 -> (EnumMap Word64 Comb, Counted a))
-> (Counted a -> (EnumMap Word64 Comb, Counted a))
-> Counted a
-> Word64
-> (EnumMap Word64 Comb, Counted a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Counted a -> (EnumMap Word64 Comb, Counted a)
forall a. a -> (EnumMap Word64 Comb, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
onCount :: (Counted a -> Counted b) -> Emit a -> Emit b
onCount :: forall a b. (Counted a -> Counted b) -> Emit a -> Emit b
onCount Counted a -> Counted b
f (EM Word64 -> (EnumMap Word64 Comb, Counted a)
e) = (Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b)
-> (Word64 -> (EnumMap Word64 Comb, Counted b)) -> Emit b
forall a b. (a -> b) -> a -> b
$ (Counted a -> Counted b)
-> (EnumMap Word64 Comb, Counted a)
-> (EnumMap Word64 Comb, Counted b)
forall a b.
(a -> b) -> (EnumMap Word64 Comb, a) -> (EnumMap Word64 Comb, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Counted a -> Counted b
f ((EnumMap Word64 Comb, Counted a)
-> (EnumMap Word64 Comb, Counted b))
-> (Word64 -> (EnumMap Word64 Comb, Counted a))
-> Word64
-> (EnumMap Word64 Comb, Counted b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> (EnumMap Word64 Comb, Counted a)
e
letIndex :: Word16 -> Word64 -> Word64
letIndex :: Word16 -> Word64 -> Word64
letIndex Word16
l Word64
c = Word64
c Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
l
record :: Ctx v -> Word16 -> Emit Section -> Emit Word64
record :: forall v. Ctx v -> Word16 -> Emit Section -> Emit Word64
record Ctx v
ctx Word16
l (EM Word64 -> (EnumMap Word64 Comb, Counted Section)
es) = (Word64 -> (EnumMap Word64 Comb, Counted Word64)) -> Emit Word64
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted Word64)) -> Emit Word64)
-> (Word64 -> (EnumMap Word64 Comb, Counted Word64)) -> Emit Word64
forall a b. (a -> b) -> a -> b
$ \Word64
c ->
let (EnumMap Word64 Comb
m, C Int
u Int
b Section
s) = Word64 -> (EnumMap Word64 Comb, Counted Section)
es Word64
c
(Int
au, Int
ab) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 Int
0 Int
0 Ctx v
ctx
n :: Word64
n = Word16 -> Word64 -> Word64
letIndex Word16
l Word64
c
in (Word64 -> Comb -> EnumMap Word64 Comb -> EnumMap Word64 Comb
forall k a. EnumKey k => k -> a -> EnumMap k a -> EnumMap k a
EC.mapInsert Word64
n (Int -> Int -> Int -> Int -> Section -> Comb
forall comb.
Int -> Int -> Int -> Int -> GSection comb -> GComb comb
Lam Int
au Int
ab Int
u Int
b Section
s) EnumMap Word64 Comb
m, Int -> Int -> Word64 -> Counted Word64
forall a. Int -> Int -> a -> Counted a
C Int
u Int
b Word64
n)
recordTop :: [v] -> Word16 -> Emit Section -> Emit ()
recordTop :: forall v. [v] -> Word16 -> Emit Section -> Emit ()
recordTop [v]
vs Word16
l (EM Word64 -> (EnumMap Word64 Comb, Counted Section)
e) = (Word64 -> (EnumMap Word64 Comb, Counted ())) -> Emit ()
forall a. (Word64 -> (EnumMap Word64 Comb, Counted a)) -> Emit a
EM ((Word64 -> (EnumMap Word64 Comb, Counted ())) -> Emit ())
-> (Word64 -> (EnumMap Word64 Comb, Counted ())) -> Emit ()
forall a b. (a -> b) -> a -> b
$ \Word64
c ->
let (EnumMap Word64 Comb
m, C Int
u Int
b Section
s) = Word64 -> (EnumMap Word64 Comb, Counted Section)
e Word64
c
ab :: Int
ab = [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs
n :: Word64
n = Word16 -> Word64 -> Word64
letIndex Word16
l Word64
c
in (Word64 -> Comb -> EnumMap Word64 Comb -> EnumMap Word64 Comb
forall k a. EnumKey k => k -> a -> EnumMap k a -> EnumMap k a
EC.mapInsert Word64
n (Int -> Int -> Int -> Int -> Section -> Comb
forall comb.
Int -> Int -> Int -> Int -> GSection comb -> GComb comb
Lam Int
0 Int
ab Int
u Int
b Section
s) EnumMap Word64 Comb
m, Int -> Int -> () -> Counted ()
forall a. Int -> Int -> a -> Counted a
C Int
u Int
b ())
countCtx :: Ctx v -> a -> Emit a
countCtx :: forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx = Counted a -> Emit a
forall a. Counted a -> Emit a
counted (Counted a -> Emit a) -> (a -> Counted a) -> a -> Emit a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> a -> Counted a
forall a. Int -> Int -> a -> Counted a
C Int
u Int
b where (Int
u, Int
b) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 Int
0 Int
0 Ctx v
ctx
countCtx0 :: Int -> Int -> Ctx v -> (Int, Int)
countCtx0 :: forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 !Int
ui !Int
bi (Var v
_ Mem
UN Ctx v
ctx) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 (Int
ui Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
bi Ctx v
ctx
countCtx0 Int
ui Int
bi (Var v
_ Mem
BX Ctx v
ctx) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 Int
ui (Int
bi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ctx v
ctx
countCtx0 Int
ui Int
bi (Tag Ctx v
ctx) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 (Int
ui Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
bi Ctx v
ctx
countCtx0 Int
ui Int
bi (Block Ctx v
ctx) = Int -> Int -> Ctx v -> (Int, Int)
forall v. Int -> Int -> Ctx v -> (Int, Int)
countCtx0 Int
ui Int
bi Ctx v
ctx
countCtx0 Int
ui Int
bi Ctx v
ECtx = (Int
ui, Int
bi)
emitComb ::
(Var v) =>
RefNums ->
Reference ->
Word64 ->
RCtx v ->
(Word64, SuperNormal v) ->
EC.EnumMap Word64 Comb
emitComb :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> (Word64, SuperNormal v)
-> EnumMap Word64 Comb
emitComb RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (Word64
n, Lambda [Mem]
ccs (TAbss [v]
vs Term ANormalF v
bd)) =
Word64 -> Emit () -> EnumMap Word64 Comb
forall a. Word64 -> Emit a -> EnumMap Word64 Comb
runEmit Word64
n
(Emit () -> EnumMap Word64 Comb)
-> (Emit Section -> Emit ()) -> Emit Section -> EnumMap Word64 Comb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Word16 -> Emit Section -> Emit ()
forall v. [v] -> Word16 -> Emit Section -> Emit ()
recordTop [v]
vs Word16
0
(Emit Section -> EnumMap Word64 Comb)
-> Emit Section -> EnumMap Word64 Comb
forall a b. (a -> b) -> a -> b
$ RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Term ANormalF v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec ([v] -> [Mem] -> Ctx v
forall v. [v] -> [Mem] -> Ctx v
ctx [v]
vs [Mem]
ccs) Term ANormalF v
bd
addCount :: Int -> Int -> Emit a -> Emit a
addCount :: forall a. Int -> Int -> Emit a -> Emit a
addCount Int
i Int
j = (Counted a -> Counted a) -> Emit a -> Emit a
forall a b. (Counted a -> Counted b) -> Emit a -> Emit b
onCount ((Counted a -> Counted a) -> Emit a -> Emit a)
-> (Counted a -> Counted a) -> Emit a -> Emit a
forall a b. (a -> b) -> a -> b
$ \(C Int
u Int
b a
x) -> Int -> Int -> a -> Counted a
forall a. Int -> Int -> a -> Counted a
C (Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) a
x
emitSection ::
(Var v) =>
RefNums ->
Reference ->
Word64 ->
RCtx v ->
Ctx v ->
ANormal v ->
Emit Section
emitSection :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TLets Direction Word16
d [v]
us [Mem]
ms ANormal v
bu ANormal v
bo) =
RefNums
-> Reference
-> Word64
-> RCtx v
-> Direction Word16
-> [(v, Mem)]
-> Ctx v
-> ANormal v
-> Emit Section
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Direction Word16
-> [(v, Mem)]
-> Ctx v
-> ANormal v
-> Emit Section
-> Emit Section
emitLet RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Direction Word16
d ([v] -> [Mem] -> [(v, Mem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
us [Mem]
ms) Ctx v
ctx ANormal v
bu (Emit Section -> Emit Section) -> Emit Section -> Emit Section
forall a b. (a -> b) -> a -> b
$
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ectx ANormal v
bo
where
ectx :: Ctx v
ectx = [(v, Mem)] -> Ctx v -> Ctx v
forall v. [(v, Mem)] -> Ctx v -> Ctx v
pushCtx ([v] -> [Mem] -> [(v, Mem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
us [Mem]
ms) Ctx v
ctx
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TName v
u (Left Reference
f) [v]
args ANormal v
bo) =
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
forall v.
Var v =>
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
emitClosures Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx [v]
args ((Ctx v -> Args -> Emit Section) -> Emit Section)
-> (Ctx v -> Args -> Emit Section) -> Emit Section
forall a b. (a -> b) -> a -> b
$ \Ctx v
ctx Args
as ->
Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> Instr
forall comb. GRef comb -> Args -> GInstr comb
Name (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
f (RefNums -> Reference -> Word64
cnum RefNums
rns Reference
f) Word64
0)) Args
as)
(Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
u Mem
BX Ctx v
ctx) ANormal v
bo
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TName v
u (Right v
v) [v]
args ANormal v
bo)
| Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v =
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
forall v.
Var v =>
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
emitClosures Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx [v]
args ((Ctx v -> Args -> Emit Section) -> Emit Section)
-> (Ctx v -> Args -> Emit Section) -> Emit Section
forall a b. (a -> b) -> a -> b
$ \Ctx v
ctx Args
as ->
Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> Instr
forall comb. GRef comb -> Args -> GInstr comb
Name (Int -> GRef CombIx
forall comb. Int -> GRef comb
Stk Int
i) Args
as)
(Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
u Mem
BX Ctx v
ctx) ANormal v
bo
| Just Word64
n <- RCtx v -> v -> Maybe Word64
forall v. Var v => RCtx v -> v -> Maybe Word64
rctxResolve RCtx v
rec v
v =
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
forall v.
Var v =>
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
emitClosures Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx [v]
args ((Ctx v -> Args -> Emit Section) -> Emit Section)
-> (Ctx v -> Args -> Emit Section) -> Emit Section
forall a b. (a -> b) -> a -> b
$ \Ctx v
ctx Args
as ->
Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> Instr
forall comb. GRef comb -> Args -> GInstr comb
Name (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
n)) Args
as)
(Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
u Mem
BX Ctx v
ctx) ANormal v
bo
| Bool
otherwise = v -> Emit Section
forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
v
emitSection RefNums
_ Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TVar v
v)
| Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v = Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Int -> Args
BArg1 Int
i
| Just (Int
i, Mem
UN) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v = Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Int -> Args
UArg1 Int
i
| Just Word64
j <- RCtx v -> v -> Maybe Word64
forall v. Var v => RCtx v -> v -> Maybe Word64
rctxResolve RCtx v
rec v
v =
Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section) -> Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
j)) Args
ZArgs
| Bool
otherwise = v -> Emit Section
forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
v
emitSection RefNums
_ Reference
_ Word64
grpn RCtx v
_ Ctx v
ctx (TPrm POp
p [v]
args) =
Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
3 Int
3
(Emit Section -> Emit Section)
-> (Args -> Emit Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx
(Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (POp -> Args -> Instr
emitPOp POp
p (Args -> Instr) -> Args -> Instr
forall a b. (a -> b) -> a -> b
$ Word64 -> Ctx v -> [v] -> Args
forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args)
(Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield
(Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Args
DArgV Int
i Int
j
where
(Int
i, Int
j) = Ctx v -> (Int, Int)
forall v. Ctx v -> (Int, Int)
countBlock Ctx v
ctx
emitSection RefNums
_ Reference
_ Word64
grpn RCtx v
_ Ctx v
ctx (TFOp Word64
p [v]
args) =
Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
3 Int
3
(Emit Section -> Emit Section)
-> (Args -> Emit Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx
(Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Word64 -> Args -> Instr
emitFOp Word64
p (Args -> Instr) -> Args -> Instr
forall a b. (a -> b) -> a -> b
$ Word64 -> Ctx v -> [v] -> Args
forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args)
(Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield
(Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Args
DArgV Int
i Int
j
where
(Int
i, Int
j) = Ctx v -> (Int, Int)
forall v. Ctx v -> (Int, Int)
countBlock Ctx v
ctx
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TApp Func v
f [v]
args) =
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
forall v.
Var v =>
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
emitClosures Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx [v]
args ((Ctx v -> Args -> Emit Section) -> Emit Section)
-> (Ctx v -> Args -> Emit Section) -> Emit Section
forall a b. (a -> b) -> a -> b
$ \Ctx v
ctx Args
as ->
Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section) -> Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Func v
-> Args
-> Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Func v
-> Args
-> Section
emitFunction RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx Func v
f Args
as
emitSection RefNums
_ Reference
_ Word64
_ RCtx v
_ Ctx v
ctx (TLit Lit
l) =
Emit Section -> Emit Section
c (Emit Section -> Emit Section)
-> (Args -> Emit Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Lit -> Instr
emitLit Lit
l) (Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Lit -> Args
litArg Lit
l
where
c :: Emit Section -> Emit Section
c
| ANF.T {} <- Lit
l = Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
0 Int
1
| ANF.LM {} <- Lit
l = Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
0 Int
1
| ANF.LY {} <- Lit
l = Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
0 Int
1
| Bool
otherwise = Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
1 Int
0
emitSection RefNums
_ Reference
_ Word64
_ RCtx v
_ Ctx v
ctx (TBLit Lit
l) =
Int -> Int -> Emit Section -> Emit Section
forall a. Int -> Int -> Emit a -> Emit a
addCount Int
0 Int
1 (Emit Section -> Emit Section)
-> (Args -> Emit Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section)
-> (Args -> Section) -> Args -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Lit -> Instr
emitBLit Lit
l) (Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Int -> Args
BArg1 Int
0
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TMatch v
v Branched (ANormal v)
bs)
| Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
MatchData Reference
r EnumMap CTag ([Mem], ANormal v)
cs Maybe (ANormal v)
df <- Branched (ANormal v)
bs =
Maybe Reference -> Int -> GBranch CombIx -> Section
forall comb.
Maybe Reference -> Int -> GBranch comb -> GSection comb
DMatch (Reference -> Maybe Reference
forall a. a -> Maybe a
Just Reference
r) Int
i
(GBranch CombIx -> Section)
-> Emit (GBranch CombIx) -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Emit (GBranch CombIx)
forall v.
Var v =>
Reference
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Emit (GBranch CombIx)
emitDataMatching Reference
r RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx EnumMap CTag ([Mem], ANormal v)
cs Maybe (ANormal v)
df
| Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
MatchRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
hs0 ANormal v
df <- Branched (ANormal v)
bs,
EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
hs <- [(Word64, EnumMap CTag ([Mem], ANormal v))]
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList ([(Word64, EnumMap CTag ([Mem], ANormal v))]
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v)))
-> [(Word64, EnumMap CTag ([Mem], ANormal v))]
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
forall a b. (a -> b) -> a -> b
$ (Reference -> Word64)
-> (Reference, EnumMap CTag ([Mem], ANormal v))
-> (Word64, EnumMap CTag ([Mem], ANormal v))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (RefNums -> Reference -> Word64
dnum RefNums
rns) ((Reference, EnumMap CTag ([Mem], ANormal v))
-> (Word64, EnumMap CTag ([Mem], ANormal v)))
-> [(Reference, EnumMap CTag ([Mem], ANormal v))]
-> [(Word64, EnumMap CTag ([Mem], ANormal v))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Reference (EnumMap CTag ([Mem], ANormal v))
-> [(Reference, EnumMap CTag ([Mem], ANormal v))]
forall k a. Map k a -> [(k, a)]
M.toList Map Reference (EnumMap CTag ([Mem], ANormal v))
hs0 =
(Section -> EnumMap Word64 (GBranch CombIx) -> Section)
-> (Section, EnumMap Word64 (GBranch CombIx)) -> Section
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Section -> EnumMap Word64 (GBranch CombIx) -> Section
forall comb.
Int
-> GSection comb -> EnumMap Word64 (GBranch comb) -> GSection comb
RMatch Int
i)
((Section, EnumMap Word64 (GBranch CombIx)) -> Section)
-> Emit (Section, EnumMap Word64 (GBranch CombIx)) -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
-> ANormal v
-> Emit (Section, EnumMap Word64 (GBranch CombIx))
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
-> ANormal v
-> Emit (Section, EnumMap Word64 (GBranch CombIx))
emitRequestMatching RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
hs ANormal v
df
| Just (Int
i, Mem
UN) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
MatchIntegral EnumMap Word64 (ANormal v)
cs Maybe (ANormal v)
df <- Branched (ANormal v)
bs =
(Int -> Section -> EnumMap Word64 Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> EnumMap Word64 (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
forall v (f :: * -> *).
(Var v, Traversable f) =>
(Int -> Section -> f Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> f (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
emitLitMatching
Int -> Section -> EnumMap Word64 Section -> Section
forall comb.
Int
-> GSection comb -> EnumMap Word64 (GSection comb) -> GSection comb
MatchW
[Char]
"missing integral case"
RefNums
rns
Reference
grpr
Word64
grpn
RCtx v
rec
Ctx v
ctx
Int
i
EnumMap Word64 (ANormal v)
cs
Maybe (ANormal v)
df
| Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
MatchNumeric Reference
r EnumMap Word64 (ANormal v)
cs Maybe (ANormal v)
df <- Branched (ANormal v)
bs =
(Int -> Section -> EnumMap Word64 Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> EnumMap Word64 (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
forall v (f :: * -> *).
(Var v, Traversable f) =>
(Int -> Section -> f Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> f (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
emitLitMatching
(Maybe Reference
-> Int -> Section -> EnumMap Word64 Section -> Section
forall comb.
Maybe Reference
-> Int
-> GSection comb
-> EnumMap Word64 (GSection comb)
-> GSection comb
NMatchW (Reference -> Maybe Reference
forall a. a -> Maybe a
Just Reference
r))
[Char]
"missing integral case"
RefNums
rns
Reference
grpr
Word64
grpn
RCtx v
rec
Ctx v
ctx
Int
i
EnumMap Word64 (ANormal v)
cs
Maybe (ANormal v)
df
| Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
MatchText Map Text (ANormal v)
cs Maybe (ANormal v)
df <- Branched (ANormal v)
bs =
(Int -> Section -> Map Text Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> Map Text (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
forall v (f :: * -> *).
(Var v, Traversable f) =>
(Int -> Section -> f Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> f (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
emitLitMatching
Int -> Section -> Map Text Section -> Section
forall comb.
Int -> GSection comb -> Map Text (GSection comb) -> GSection comb
MatchT
[Char]
"missing text case"
RefNums
rns
Reference
grpr
Word64
grpn
RCtx v
rec
Ctx v
ctx
Int
i
Map Text (ANormal v)
cs
Maybe (ANormal v)
df
| Just (Int
i, Mem
UN) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v,
MatchSum EnumMap Word64 ([Mem], ANormal v)
cs <- Branched (ANormal v)
bs =
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> Int
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> Int
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit Section
emitSumMatching RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx v
v Int
i EnumMap Word64 ([Mem], ANormal v)
cs
| Just (Int
_, Mem
cc) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v =
[Char] -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section) -> [Char] -> Emit Section
forall a b. (a -> b) -> a -> b
$
[Char]
"emitSection: mismatched calling convention for match: "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Mem -> Branched (ANormal v) -> [Char]
forall v. Mem -> Branched v -> [Char]
matchCallingError Mem
cc Branched (ANormal v)
bs
| Bool
otherwise =
[Char] -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section) -> [Char] -> Emit Section
forall a b. (a -> b) -> a -> b
$
[Char]
"emitSection: could not resolve match variable: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Ctx v, v) -> [Char]
forall a. Show a => a -> [Char]
show (Ctx v
ctx, v
v)
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (THnd [Reference]
rs v
h ANormal v
b)
| Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
h =
Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (EnumSet Word64 -> Instr
forall comb. EnumSet Word64 -> GInstr comb
Reset ([Word64] -> EnumSet Word64
forall k. EnumKey k => [k] -> EnumSet k
EC.setFromList [Word64]
ws))
(Section -> Section) -> (Section -> Section) -> Section -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Section -> [Word64] -> Section) -> [Word64] -> Section -> Section
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Word64 -> Section -> Section) -> Section -> [Word64] -> Section
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Word64
r -> Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Word64 -> Int -> Instr
forall comb. Word64 -> Int -> GInstr comb
SetDyn Word64
r Int
i))) [Word64]
ws
(Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx ANormal v
b
| Bool
otherwise = v -> Emit Section
forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
h
where
ws :: [Word64]
ws = RefNums -> Reference -> Word64
dnum RefNums
rns (Reference -> Word64) -> [Reference] -> [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Reference]
rs
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (TShift Reference
r v
v ANormal v
e) =
Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Word64 -> Instr
forall comb. Word64 -> GInstr comb
Capture (Word64 -> Instr) -> Word64 -> Instr
forall a b. (a -> b) -> a -> b
$ RefNums -> Reference -> Word64
dnum RefNums
rns Reference
r)
(Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
v Mem
BX Ctx v
ctx) ANormal v
e
emitSection RefNums
_ Reference
_ Word64
_ RCtx v
_ Ctx v
ctx (TFrc v
v)
| Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v =
Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section) -> Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (Int -> GRef CombIx
forall comb. Int -> GRef comb
Stk Int
i) Args
ZArgs
| Just (Int, Mem)
_ <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v =
[Char] -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section) -> [Char] -> Emit Section
forall a b. (a -> b) -> a -> b
$
[Char]
"emitSection: values to be forced must be boxed: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> [Char]
forall a. Show a => a -> [Char]
show v
v
| Bool
otherwise = v -> Emit Section
forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
v
emitSection RefNums
_ Reference
_ Word64
_ RCtx v
_ Ctx v
_ ANormal v
tm =
[Char] -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section) -> [Char] -> Emit Section
forall a b. (a -> b) -> a -> b
$ [Char]
"emitSection: unhandled code: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ANormal v -> [Char]
forall a. Show a => a -> [Char]
show ANormal v
tm
emitFunction ::
(Var v) =>
RefNums ->
Reference ->
Word64 ->
RCtx v ->
Ctx v ->
Func v ->
Args ->
Section
emitFunction :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Func v
-> Args
-> Section
emitFunction RefNums
_ Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (FVar v
v) Args
as
| Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
v =
Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (Int -> GRef CombIx
forall comb. Int -> GRef comb
Stk Int
i) Args
as
| Just Word64
j <- RCtx v -> v -> Maybe Word64
forall v. Var v => RCtx v -> v -> Maybe Word64
rctxResolve RCtx v
rec v
v =
Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
j)) Args
as
| Bool
otherwise = v -> Section
forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
v
emitFunction RefNums
rns Reference
_grpr Word64
_ RCtx v
_ Ctx v
_ (FComb Reference
r) Args
as
| Bool
otherwise
=
Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
False (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
r Word64
n Word64
0)) Args
as
where
n :: Word64
n = RefNums -> Reference -> Word64
cnum RefNums
rns Reference
r
emitFunction RefNums
rns Reference
_grpr Word64
_ RCtx v
_ Ctx v
_ (FCon Reference
r CTag
t) Args
as =
Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Reference -> Word64 -> Args -> Instr
forall comb. Reference -> Word64 -> Args -> GInstr comb
Pack Reference
r (RTag -> CTag -> Word64
packTags RTag
rt CTag
t) Args
as)
(Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Section
forall comb. Args -> GSection comb
Yield
(Args -> Section) -> Args -> Section
forall a b. (a -> b) -> a -> b
$ Int -> Args
BArg1 Int
0
where
rt :: RTag
rt = Int -> RTag
forall a. Enum a => Int -> a
toEnum (Int -> RTag) -> (Word64 -> Int) -> Word64 -> RTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RTag) -> Word64 -> RTag
forall a b. (a -> b) -> a -> b
$ RefNums -> Reference -> Word64
dnum RefNums
rns Reference
r
emitFunction RefNums
rns Reference
_grpr Word64
_ RCtx v
_ Ctx v
_ (FReq Reference
r CTag
e) Args
as =
Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Reference -> Word64 -> Args -> Instr
forall comb. Reference -> Word64 -> Args -> GInstr comb
Pack Reference
r (RTag -> CTag -> Word64
packTags RTag
rt CTag
e) Args
as)
(Section -> Section) -> (Args -> Section) -> Args -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GRef CombIx -> Args -> Section
forall comb. Bool -> GRef comb -> Args -> GSection comb
App Bool
True (Word64 -> GRef CombIx
forall comb. Word64 -> GRef comb
Dyn Word64
a)
(Args -> Section) -> Args -> Section
forall a b. (a -> b) -> a -> b
$ Int -> Args
BArg1 Int
0
where
a :: Word64
a = RefNums -> Reference -> Word64
dnum RefNums
rns Reference
r
rt :: RTag
rt = Int -> RTag
forall a. Enum a => Int -> a
toEnum (Int -> RTag) -> (Word64 -> Int) -> Word64 -> RTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RTag) -> Word64 -> RTag
forall a b. (a -> b) -> a -> b
$ Word64
a
emitFunction RefNums
_ Reference
_grpr Word64
_ RCtx v
_ Ctx v
ctx (FCont v
k) Args
as
| Just (Int
i, Mem
BX) <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
k = Int -> Args -> Section
forall comb. Int -> Args -> GSection comb
Jump Int
i Args
as
| Maybe (Int, Mem)
Nothing <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
k = v -> Section
forall v a. (Var v, HasCallStack) => v -> a
emitFunctionVErr v
k
| Bool
otherwise = [Char] -> Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Section) -> [Char] -> Section
forall a b. (a -> b) -> a -> b
$ [Char]
"emitFunction: continuations are boxed"
emitFunction RefNums
_ Reference
_grpr Word64
_ RCtx v
_ Ctx v
_ (FPrim Either POp Word64
_) Args
_ =
[Char] -> Section
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"emitFunction: impossible"
countBlock :: Ctx v -> (Int, Int)
countBlock :: forall v. Ctx v -> (Int, Int)
countBlock = Int -> Int -> Ctx v -> (Int, Int)
forall {a} {b} {v}. (Num a, Num b) => a -> b -> Ctx v -> (a, b)
go Int
0 Int
0
where
go :: a -> b -> Ctx v -> (a, b)
go !a
ui !b
bi (Var v
_ Mem
UN Ctx v
ctx) = a -> b -> Ctx v -> (a, b)
go (a
ui a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) b
bi Ctx v
ctx
go a
ui b
bi (Var v
_ Mem
BX Ctx v
ctx) = a -> b -> Ctx v -> (a, b)
go a
ui (b
bi b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) Ctx v
ctx
go a
ui b
bi (Tag Ctx v
ctx) = a -> b -> Ctx v -> (a, b)
go (a
ui a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) b
bi Ctx v
ctx
go a
ui b
bi Ctx v
_ = (a
ui, b
bi)
matchCallingError :: Mem -> Branched v -> String
matchCallingError :: forall v. Mem -> Branched v -> [Char]
matchCallingError Mem
cc Branched v
b = [Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Mem -> [Char]
forall a. Show a => a -> [Char]
show Mem
cc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
brs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
where
brs :: [Char]
brs
| MatchData Reference
_ EnumMap CTag ([Mem], v)
_ Maybe v
_ <- Branched v
b = [Char]
"MatchData"
| Branched v
MatchEmpty <- Branched v
b = [Char]
"MatchEmpty"
| MatchIntegral EnumMap Word64 v
_ Maybe v
_ <- Branched v
b = [Char]
"MatchIntegral"
| MatchNumeric Reference
_ EnumMap Word64 v
_ Maybe v
_ <- Branched v
b = [Char]
"MatchNumeric"
| MatchRequest Map Reference (EnumMap CTag ([Mem], v))
_ v
_ <- Branched v
b = [Char]
"MatchRequest"
| MatchSum EnumMap Word64 ([Mem], v)
_ <- Branched v
b = [Char]
"MatchSum"
| MatchText Map Text v
_ Maybe v
_ <- Branched v
b = [Char]
"MatchText"
emitSectionVErr :: (Var v, HasCallStack) => v -> a
emitSectionVErr :: forall v a. (Var v, HasCallStack) => v -> a
emitSectionVErr v
v =
[Char] -> a
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$
[Char]
"emitSection: could not resolve function variable: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> [Char]
forall a. Show a => a -> [Char]
show v
v
emitFunctionVErr :: (Var v, HasCallStack) => v -> a
emitFunctionVErr :: forall v a. (Var v, HasCallStack) => v -> a
emitFunctionVErr v
v =
[Char] -> a
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$
[Char]
"emitFunction: could not resolve function variable: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> [Char]
forall a. Show a => a -> [Char]
show v
v
litArg :: ANF.Lit -> Args
litArg :: Lit -> Args
litArg ANF.T {} = Int -> Args
BArg1 Int
0
litArg ANF.LM {} = Int -> Args
BArg1 Int
0
litArg ANF.LY {} = Int -> Args
BArg1 Int
0
litArg Lit
_ = Int -> Args
UArg1 Int
0
emitLet ::
(Var v) =>
RefNums ->
Reference ->
Word64 ->
RCtx v ->
Direction Word16 ->
[(v, Mem)] ->
Ctx v ->
ANormal v ->
Emit Section ->
Emit Section
emitLet :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Direction Word16
-> [(v, Mem)]
-> Ctx v
-> ANormal v
-> Emit Section
-> Emit Section
emitLet RefNums
_ Reference
_ Word64
_ RCtx v
_ Direction Word16
_ [(v, Mem)]
_ Ctx v
_ (TLit Lit
l) =
(Section -> Section) -> Emit Section -> Emit Section
forall a b. (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Instr -> Section -> Section) -> Instr -> Section -> Section
forall a b. (a -> b) -> a -> b
$ Lit -> Instr
emitLit Lit
l)
emitLet RefNums
_ Reference
_ Word64
_ RCtx v
_ Direction Word16
_ [(v, Mem)]
_ Ctx v
_ (TBLit Lit
l) =
(Section -> Section) -> Emit Section -> Emit Section
forall a b. (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Instr -> Section -> Section) -> Instr -> Section -> Section
forall a b. (a -> b) -> a -> b
$ Lit -> Instr
emitBLit Lit
l)
emitLet RefNums
rns Reference
_ Word64
grpn RCtx v
_ Direction Word16
_ [(v, Mem)]
_ Ctx v
ctx (TApp (FCon Reference
r CTag
n) [v]
args) =
(Section -> Section) -> Emit Section -> Emit Section
forall a b. (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Instr -> Section -> Section)
-> (Args -> Instr) -> Args -> Section -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Word64 -> Args -> Instr
forall comb. Reference -> Word64 -> Args -> GInstr comb
Pack Reference
r (RTag -> CTag -> Word64
packTags RTag
rt CTag
n) (Args -> Section -> Section) -> Args -> Section -> Section
forall a b. (a -> b) -> a -> b
$ Word64 -> Ctx v -> [v] -> Args
forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args)
where
rt :: RTag
rt = Int -> RTag
forall a. Enum a => Int -> a
toEnum (Int -> RTag) -> (Word64 -> Int) -> Word64 -> RTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> RTag) -> Word64 -> RTag
forall a b. (a -> b) -> a -> b
$ RefNums -> Reference -> Word64
dnum RefNums
rns Reference
r
emitLet RefNums
_ Reference
_ Word64
grpn RCtx v
_ Direction Word16
_ [(v, Mem)]
_ Ctx v
ctx (TApp (FPrim Either POp Word64
p) [v]
args) =
(Section -> Section) -> Emit Section -> Emit Section
forall a b. (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (Instr -> Section -> Section)
-> (Args -> Instr) -> Args -> Section -> Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POp -> Args -> Instr)
-> (Word64 -> Args -> Instr) -> Either POp Word64 -> Args -> Instr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either POp -> Args -> Instr
emitPOp Word64 -> Args -> Instr
emitFOp Either POp Word64
p (Args -> Section -> Section) -> Args -> Section -> Section
forall a b. (a -> b) -> a -> b
$ Word64 -> Ctx v -> [v] -> Args
forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args)
emitLet RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Direction Word16
d [(v, Mem)]
vcs Ctx v
ctx ANormal v
bnd
| Direction Word16
Direct <- Direction Word16
d =
[Char] -> Emit Section -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section -> Emit Section)
-> [Char] -> Emit Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ [Char]
"unsupported compound direct let: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ANormal v -> [Char]
forall a. Show a => a -> [Char]
show ANormal v
bnd
| Indirect Word16
w <- Direction Word16
d =
\Emit Section
esect ->
Section -> Word64 -> Section
f
(Section -> Word64 -> Section)
-> Emit Section -> Emit (Word64 -> Section)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (Ctx v -> Ctx v
forall v. Ctx v -> Ctx v
Block Ctx v
ctx) ANormal v
bnd
Emit (Word64 -> Section) -> Emit Word64 -> Emit Section
forall a b. Emit (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ctx v -> Word16 -> Emit Section -> Emit Word64
forall v. Ctx v -> Word16 -> Emit Section -> Emit Word64
record ([(v, Mem)] -> Ctx v -> Ctx v
forall v. [(v, Mem)] -> Ctx v -> Ctx v
pushCtx [(v, Mem)]
vcs Ctx v
ctx) Word16
w Emit Section
esect
where
f :: Section -> Word64 -> Section
f Section
s Word64
w = Section -> CombIx -> Section
forall comb. GSection comb -> comb -> GSection comb
Let Section
s (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
w)
emitPOp :: ANF.POp -> Args -> Instr
emitPOp :: POp -> Args -> Instr
emitPOp POp
ANF.ADDI = UPrim2 -> Args -> Instr
emitP2 UPrim2
ADDI
emitPOp POp
ANF.ADDN = UPrim2 -> Args -> Instr
emitP2 UPrim2
ADDI
emitPOp POp
ANF.SUBI = UPrim2 -> Args -> Instr
emitP2 UPrim2
SUBI
emitPOp POp
ANF.SUBN = UPrim2 -> Args -> Instr
emitP2 UPrim2
SUBI
emitPOp POp
ANF.MULI = UPrim2 -> Args -> Instr
emitP2 UPrim2
MULI
emitPOp POp
ANF.MULN = UPrim2 -> Args -> Instr
emitP2 UPrim2
MULI
emitPOp POp
ANF.DIVI = UPrim2 -> Args -> Instr
emitP2 UPrim2
DIVI
emitPOp POp
ANF.DIVN = UPrim2 -> Args -> Instr
emitP2 UPrim2
DIVN
emitPOp POp
ANF.MODI = UPrim2 -> Args -> Instr
emitP2 UPrim2
MODI
emitPOp POp
ANF.MODN = UPrim2 -> Args -> Instr
emitP2 UPrim2
MODN
emitPOp POp
ANF.POWI = UPrim2 -> Args -> Instr
emitP2 UPrim2
POWI
emitPOp POp
ANF.POWN = UPrim2 -> Args -> Instr
emitP2 UPrim2
POWI
emitPOp POp
ANF.SHLI = UPrim2 -> Args -> Instr
emitP2 UPrim2
SHLI
emitPOp POp
ANF.SHLN = UPrim2 -> Args -> Instr
emitP2 UPrim2
SHLI
emitPOp POp
ANF.SHRI = UPrim2 -> Args -> Instr
emitP2 UPrim2
SHRI
emitPOp POp
ANF.SHRN = UPrim2 -> Args -> Instr
emitP2 UPrim2
SHRN
emitPOp POp
ANF.LEQI = UPrim2 -> Args -> Instr
emitP2 UPrim2
LEQI
emitPOp POp
ANF.LEQN = UPrim2 -> Args -> Instr
emitP2 UPrim2
LEQN
emitPOp POp
ANF.EQLI = UPrim2 -> Args -> Instr
emitP2 UPrim2
EQLI
emitPOp POp
ANF.EQLN = UPrim2 -> Args -> Instr
emitP2 UPrim2
EQLI
emitPOp POp
ANF.SGNI = UPrim1 -> Args -> Instr
emitP1 UPrim1
SGNI
emitPOp POp
ANF.NEGI = UPrim1 -> Args -> Instr
emitP1 UPrim1
NEGI
emitPOp POp
ANF.INCI = UPrim1 -> Args -> Instr
emitP1 UPrim1
INCI
emitPOp POp
ANF.INCN = UPrim1 -> Args -> Instr
emitP1 UPrim1
INCI
emitPOp POp
ANF.DECI = UPrim1 -> Args -> Instr
emitP1 UPrim1
DECI
emitPOp POp
ANF.DECN = UPrim1 -> Args -> Instr
emitP1 UPrim1
DECI
emitPOp POp
ANF.TZRO = UPrim1 -> Args -> Instr
emitP1 UPrim1
TZRO
emitPOp POp
ANF.LZRO = UPrim1 -> Args -> Instr
emitP1 UPrim1
LZRO
emitPOp POp
ANF.POPC = UPrim1 -> Args -> Instr
emitP1 UPrim1
POPC
emitPOp POp
ANF.ANDN = UPrim2 -> Args -> Instr
emitP2 UPrim2
ANDN
emitPOp POp
ANF.IORN = UPrim2 -> Args -> Instr
emitP2 UPrim2
IORN
emitPOp POp
ANF.XORN = UPrim2 -> Args -> Instr
emitP2 UPrim2
XORN
emitPOp POp
ANF.COMN = UPrim1 -> Args -> Instr
emitP1 UPrim1
COMN
emitPOp POp
ANF.ADDF = UPrim2 -> Args -> Instr
emitP2 UPrim2
ADDF
emitPOp POp
ANF.SUBF = UPrim2 -> Args -> Instr
emitP2 UPrim2
SUBF
emitPOp POp
ANF.MULF = UPrim2 -> Args -> Instr
emitP2 UPrim2
MULF
emitPOp POp
ANF.DIVF = UPrim2 -> Args -> Instr
emitP2 UPrim2
DIVF
emitPOp POp
ANF.LEQF = UPrim2 -> Args -> Instr
emitP2 UPrim2
LEQF
emitPOp POp
ANF.EQLF = UPrim2 -> Args -> Instr
emitP2 UPrim2
EQLF
emitPOp POp
ANF.MINF = UPrim2 -> Args -> Instr
emitP2 UPrim2
MINF
emitPOp POp
ANF.MAXF = UPrim2 -> Args -> Instr
emitP2 UPrim2
MAXF
emitPOp POp
ANF.POWF = UPrim2 -> Args -> Instr
emitP2 UPrim2
POWF
emitPOp POp
ANF.EXPF = UPrim1 -> Args -> Instr
emitP1 UPrim1
EXPF
emitPOp POp
ANF.ABSF = UPrim1 -> Args -> Instr
emitP1 UPrim1
ABSF
emitPOp POp
ANF.SQRT = UPrim1 -> Args -> Instr
emitP1 UPrim1
SQRT
emitPOp POp
ANF.LOGF = UPrim1 -> Args -> Instr
emitP1 UPrim1
LOGF
emitPOp POp
ANF.LOGB = UPrim2 -> Args -> Instr
emitP2 UPrim2
LOGB
emitPOp POp
ANF.CEIL = UPrim1 -> Args -> Instr
emitP1 UPrim1
CEIL
emitPOp POp
ANF.FLOR = UPrim1 -> Args -> Instr
emitP1 UPrim1
FLOR
emitPOp POp
ANF.TRNF = UPrim1 -> Args -> Instr
emitP1 UPrim1
TRNF
emitPOp POp
ANF.RNDF = UPrim1 -> Args -> Instr
emitP1 UPrim1
RNDF
emitPOp POp
ANF.COSF = UPrim1 -> Args -> Instr
emitP1 UPrim1
COSF
emitPOp POp
ANF.SINF = UPrim1 -> Args -> Instr
emitP1 UPrim1
SINF
emitPOp POp
ANF.TANF = UPrim1 -> Args -> Instr
emitP1 UPrim1
TANF
emitPOp POp
ANF.COSH = UPrim1 -> Args -> Instr
emitP1 UPrim1
COSH
emitPOp POp
ANF.SINH = UPrim1 -> Args -> Instr
emitP1 UPrim1
SINH
emitPOp POp
ANF.TANH = UPrim1 -> Args -> Instr
emitP1 UPrim1
TANH
emitPOp POp
ANF.ACOS = UPrim1 -> Args -> Instr
emitP1 UPrim1
ACOS
emitPOp POp
ANF.ATAN = UPrim1 -> Args -> Instr
emitP1 UPrim1
ATAN
emitPOp POp
ANF.ASIN = UPrim1 -> Args -> Instr
emitP1 UPrim1
ASIN
emitPOp POp
ANF.ACSH = UPrim1 -> Args -> Instr
emitP1 UPrim1
ACSH
emitPOp POp
ANF.ASNH = UPrim1 -> Args -> Instr
emitP1 UPrim1
ASNH
emitPOp POp
ANF.ATNH = UPrim1 -> Args -> Instr
emitP1 UPrim1
ATNH
emitPOp POp
ANF.ATN2 = UPrim2 -> Args -> Instr
emitP2 UPrim2
ATN2
emitPOp POp
ANF.ITOF = UPrim1 -> Args -> Instr
emitP1 UPrim1
ITOF
emitPOp POp
ANF.NTOF = UPrim1 -> Args -> Instr
emitP1 UPrim1
NTOF
emitPOp POp
ANF.ITOT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
ITOT
emitPOp POp
ANF.NTOT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
NTOT
emitPOp POp
ANF.FTOT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
FTOT
emitPOp POp
ANF.TTON = BPrim1 -> Args -> Instr
emitBP1 BPrim1
TTON
emitPOp POp
ANF.TTOI = BPrim1 -> Args -> Instr
emitBP1 BPrim1
TTOI
emitPOp POp
ANF.TTOF = BPrim1 -> Args -> Instr
emitBP1 BPrim1
TTOF
emitPOp POp
ANF.CATT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
CATT
emitPOp POp
ANF.TAKT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
TAKT
emitPOp POp
ANF.DRPT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
DRPT
emitPOp POp
ANF.IXOT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
IXOT
emitPOp POp
ANF.SIZT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
SIZT
emitPOp POp
ANF.UCNS = BPrim1 -> Args -> Instr
emitBP1 BPrim1
UCNS
emitPOp POp
ANF.USNC = BPrim1 -> Args -> Instr
emitBP1 BPrim1
USNC
emitPOp POp
ANF.EQLT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
EQLT
emitPOp POp
ANF.LEQT = BPrim2 -> Args -> Instr
emitBP2 BPrim2
LEQT
emitPOp POp
ANF.PAKT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
PAKT
emitPOp POp
ANF.UPKT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
UPKT
emitPOp POp
ANF.CATS = BPrim2 -> Args -> Instr
emitBP2 BPrim2
CATS
emitPOp POp
ANF.TAKS = BPrim2 -> Args -> Instr
emitBP2 BPrim2
TAKS
emitPOp POp
ANF.DRPS = BPrim2 -> Args -> Instr
emitBP2 BPrim2
DRPS
emitPOp POp
ANF.SIZS = BPrim1 -> Args -> Instr
emitBP1 BPrim1
SIZS
emitPOp POp
ANF.CONS = BPrim2 -> Args -> Instr
emitBP2 BPrim2
CONS
emitPOp POp
ANF.SNOC = BPrim2 -> Args -> Instr
emitBP2 BPrim2
SNOC
emitPOp POp
ANF.IDXS = BPrim2 -> Args -> Instr
emitBP2 BPrim2
IDXS
emitPOp POp
ANF.VWLS = BPrim1 -> Args -> Instr
emitBP1 BPrim1
VWLS
emitPOp POp
ANF.VWRS = BPrim1 -> Args -> Instr
emitBP1 BPrim1
VWRS
emitPOp POp
ANF.SPLL = BPrim2 -> Args -> Instr
emitBP2 BPrim2
SPLL
emitPOp POp
ANF.SPLR = BPrim2 -> Args -> Instr
emitBP2 BPrim2
SPLR
emitPOp POp
ANF.PAKB = BPrim1 -> Args -> Instr
emitBP1 BPrim1
PAKB
emitPOp POp
ANF.UPKB = BPrim1 -> Args -> Instr
emitBP1 BPrim1
UPKB
emitPOp POp
ANF.TAKB = BPrim2 -> Args -> Instr
emitBP2 BPrim2
TAKB
emitPOp POp
ANF.DRPB = BPrim2 -> Args -> Instr
emitBP2 BPrim2
DRPB
emitPOp POp
ANF.IXOB = BPrim2 -> Args -> Instr
emitBP2 BPrim2
IXOB
emitPOp POp
ANF.IDXB = BPrim2 -> Args -> Instr
emitBP2 BPrim2
IDXB
emitPOp POp
ANF.SIZB = BPrim1 -> Args -> Instr
emitBP1 BPrim1
SIZB
emitPOp POp
ANF.FLTB = BPrim1 -> Args -> Instr
emitBP1 BPrim1
FLTB
emitPOp POp
ANF.CATB = BPrim2 -> Args -> Instr
emitBP2 BPrim2
CATB
emitPOp POp
ANF.EQLU = BPrim2 -> Args -> Instr
emitBP2 BPrim2
EQLU
emitPOp POp
ANF.CMPU = BPrim2 -> Args -> Instr
emitBP2 BPrim2
CMPU
emitPOp POp
ANF.MISS = BPrim1 -> Args -> Instr
emitBP1 BPrim1
MISS
emitPOp POp
ANF.CACH = BPrim1 -> Args -> Instr
emitBP1 BPrim1
CACH
emitPOp POp
ANF.LKUP = BPrim1 -> Args -> Instr
emitBP1 BPrim1
LKUP
emitPOp POp
ANF.TLTT = BPrim1 -> Args -> Instr
emitBP1 BPrim1
TLTT
emitPOp POp
ANF.CVLD = BPrim1 -> Args -> Instr
emitBP1 BPrim1
CVLD
emitPOp POp
ANF.LOAD = BPrim1 -> Args -> Instr
emitBP1 BPrim1
LOAD
emitPOp POp
ANF.VALU = BPrim1 -> Args -> Instr
emitBP1 BPrim1
VALU
emitPOp POp
ANF.SDBX = BPrim2 -> Args -> Instr
emitBP2 BPrim2
SDBX
emitPOp POp
ANF.SDBL = BPrim1 -> Args -> Instr
emitBP1 BPrim1
SDBL
emitPOp POp
ANF.SDBV = BPrim2 -> Args -> Instr
emitBP2 BPrim2
SDBV
emitPOp POp
ANF.EROR = BPrim2 -> Args -> Instr
emitBP2 BPrim2
THRO
emitPOp POp
ANF.TRCE = BPrim2 -> Args -> Instr
emitBP2 BPrim2
TRCE
emitPOp POp
ANF.DBTX = BPrim1 -> Args -> Instr
emitBP1 BPrim1
DBTX
emitPOp POp
ANF.BLDS = Args -> Instr
forall comb. Args -> GInstr comb
Seq
emitPOp POp
ANF.FORK = \case
BArg1 Int
i -> Int -> Instr
forall comb. Int -> GInstr comb
Fork Int
i
Args
_ -> [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"fork takes exactly one boxed argument"
emitPOp POp
ANF.ATOM = \case
BArg1 Int
i -> Int -> Instr
forall comb. Int -> GInstr comb
Atomically Int
i
Args
_ -> [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"atomically takes exactly one boxed argument"
emitPOp POp
ANF.PRNT = \case
BArg1 Int
i -> Int -> Instr
forall comb. Int -> GInstr comb
Print Int
i
Args
_ -> [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"print takes exactly one boxed argument"
emitPOp POp
ANF.INFO = \case
Args
ZArgs -> [Char] -> Instr
forall comb. [Char] -> GInstr comb
Info [Char]
"debug"
Args
_ -> [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"info takes no arguments"
emitPOp POp
ANF.TFRC = \case
BArg1 Int
i -> Int -> Instr
forall comb. Int -> GInstr comb
TryForce Int
i
Args
_ -> [Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug [Char]
"tryEval takes exactly one boxed argument"
emitFOp :: ANF.FOp -> Args -> Instr
emitFOp :: Word64 -> Args -> Instr
emitFOp Word64
fop = Bool -> Word64 -> Args -> Instr
forall comb. Bool -> Word64 -> Args -> GInstr comb
ForeignCall Bool
True (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a. Enum a => a -> Int
fromEnum Word64
fop)
emitP1 :: UPrim1 -> Args -> Instr
emitP1 :: UPrim1 -> Args -> Instr
emitP1 UPrim1
p (UArg1 Int
i) = UPrim1 -> Int -> Instr
forall comb. UPrim1 -> Int -> GInstr comb
UPrim1 UPrim1
p Int
i
emitP1 UPrim1
p Args
a =
[Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Instr) -> [Char] -> Instr
forall a b. (a -> b) -> a -> b
$
[Char]
"wrong number of args for unary unboxed primop: "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (UPrim1, Args) -> [Char]
forall a. Show a => a -> [Char]
show (UPrim1
p, Args
a)
emitP2 :: UPrim2 -> Args -> Instr
emitP2 :: UPrim2 -> Args -> Instr
emitP2 UPrim2
p (UArg2 Int
i Int
j) = UPrim2 -> Int -> Int -> Instr
forall comb. UPrim2 -> Int -> Int -> GInstr comb
UPrim2 UPrim2
p Int
i Int
j
emitP2 UPrim2
p Args
a =
[Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Instr) -> [Char] -> Instr
forall a b. (a -> b) -> a -> b
$
[Char]
"wrong number of args for binary unboxed primop: "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (UPrim2, Args) -> [Char]
forall a. Show a => a -> [Char]
show (UPrim2
p, Args
a)
emitBP1 :: BPrim1 -> Args -> Instr
emitBP1 :: BPrim1 -> Args -> Instr
emitBP1 BPrim1
p (UArg1 Int
i) = BPrim1 -> Int -> Instr
forall comb. BPrim1 -> Int -> GInstr comb
BPrim1 BPrim1
p Int
i
emitBP1 BPrim1
p (BArg1 Int
i) = BPrim1 -> Int -> Instr
forall comb. BPrim1 -> Int -> GInstr comb
BPrim1 BPrim1
p Int
i
emitBP1 BPrim1
p Args
a =
[Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Instr) -> [Char] -> Instr
forall a b. (a -> b) -> a -> b
$
[Char]
"wrong number of args for unary boxed primop: "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (BPrim1, Args) -> [Char]
forall a. Show a => a -> [Char]
show (BPrim1
p, Args
a)
emitBP2 :: BPrim2 -> Args -> Instr
emitBP2 :: BPrim2 -> Args -> Instr
emitBP2 BPrim2
p (UArg2 Int
i Int
j) = BPrim2 -> Int -> Int -> Instr
forall comb. BPrim2 -> Int -> Int -> GInstr comb
BPrim2 BPrim2
p Int
i Int
j
emitBP2 BPrim2
p (BArg2 Int
i Int
j) = BPrim2 -> Int -> Int -> Instr
forall comb. BPrim2 -> Int -> Int -> GInstr comb
BPrim2 BPrim2
p Int
i Int
j
emitBP2 BPrim2
p (DArg2 Int
i Int
j) = BPrim2 -> Int -> Int -> Instr
forall comb. BPrim2 -> Int -> Int -> GInstr comb
BPrim2 BPrim2
p Int
i Int
j
emitBP2 BPrim2
p Args
a =
[Char] -> Instr
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Instr) -> [Char] -> Instr
forall a b. (a -> b) -> a -> b
$
[Char]
"wrong number of args for binary boxed primop: "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (BPrim2, Args) -> [Char]
forall a. Show a => a -> [Char]
show (BPrim2
p, Args
a)
emitDataMatching ::
(Var v) =>
Reference ->
RefNums ->
Reference ->
Word64 ->
RCtx v ->
Ctx v ->
EnumMap CTag ([Mem], ANormal v) ->
Maybe (ANormal v) ->
Emit Branch
emitDataMatching :: forall v.
Var v =>
Reference
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Emit (GBranch CombIx)
emitDataMatching Reference
r RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx EnumMap CTag ([Mem], ANormal v)
cs Maybe (ANormal v)
df =
Section -> EnumMap Word64 Section -> GBranch CombIx
forall comb.
GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
TestW (Section -> EnumMap Word64 Section -> GBranch CombIx)
-> Emit Section -> Emit (EnumMap Word64 Section -> GBranch CombIx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emit Section
edf Emit (EnumMap Word64 Section -> GBranch CombIx)
-> Emit (EnumMap Word64 Section) -> Emit (GBranch CombIx)
forall a b. Emit (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([Mem], ANormal v) -> Emit Section)
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit (EnumMap Word64 Section)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse (RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
emitCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx) (EnumMap CTag ([Mem], ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
forall a b. Coercible a b => a -> b
coerce EnumMap CTag ([Mem], ANormal v)
cs)
where
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)
emitSumMatching ::
(Var v) =>
RefNums ->
Reference ->
Word64 ->
RCtx v ->
Ctx v ->
v ->
Int ->
EnumMap Word64 ([Mem], ANormal v) ->
Emit Section
emitSumMatching :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> Int
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit Section
emitSumMatching RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx v
v Int
i EnumMap Word64 ([Mem], ANormal v)
cs =
Int -> Section -> EnumMap Word64 Section -> Section
forall comb.
Int
-> GSection comb -> EnumMap Word64 (GSection comb) -> GSection comb
MatchW Int
i Section
forall {comb}. GSection comb
edf (EnumMap Word64 Section -> Section)
-> Emit (EnumMap Word64 Section) -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Mem], ANormal v) -> Emit Section)
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit (EnumMap Word64 Section)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse (RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> ([Mem], ANormal v)
-> Emit Section
emitSumCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx v
v) EnumMap Word64 ([Mem], ANormal v)
cs
where
edf :: GSection comb
edf = [Char] -> GSection comb
forall comb. [Char] -> GSection comb
Die [Char]
"uncovered unboxed sum case"
emitRequestMatching ::
(Var v) =>
RefNums ->
Reference ->
Word64 ->
RCtx v ->
Ctx v ->
EnumMap Word64 (EnumMap CTag ([Mem], ANormal v)) ->
ANormal v ->
Emit (Section, EnumMap Word64 Branch)
emitRequestMatching :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
-> ANormal v
-> Emit (Section, EnumMap Word64 (GBranch CombIx))
emitRequestMatching RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
hs ANormal v
df = (,) (Section
-> EnumMap Word64 (GBranch CombIx)
-> (Section, EnumMap Word64 (GBranch CombIx)))
-> Emit Section
-> Emit
(EnumMap Word64 (GBranch CombIx)
-> (Section, EnumMap Word64 (GBranch CombIx)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emit Section
pur Emit
(EnumMap Word64 (GBranch CombIx)
-> (Section, EnumMap Word64 (GBranch CombIx)))
-> Emit (EnumMap Word64 (GBranch CombIx))
-> Emit (Section, EnumMap Word64 (GBranch CombIx))
forall a b. Emit (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Emit (EnumMap Word64 (GBranch CombIx))
tops
where
pur :: Emit Section
pur = RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
emitCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx ([Mem
BX], ANormal v
df)
tops :: Emit (EnumMap Word64 (GBranch CombIx))
tops = (EnumMap Word64 ([Mem], ANormal v) -> Emit (GBranch CombIx))
-> EnumMap Word64 (EnumMap Word64 ([Mem], ANormal v))
-> Emit (EnumMap Word64 (GBranch CombIx))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse EnumMap Word64 ([Mem], ANormal v) -> Emit (GBranch CombIx)
f (EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
-> EnumMap Word64 (EnumMap Word64 ([Mem], ANormal v))
forall a b. Coercible a b => a -> b
coerce EnumMap Word64 (EnumMap CTag ([Mem], ANormal v))
hs)
f :: EnumMap Word64 ([Mem], ANormal v) -> Emit (GBranch CombIx)
f EnumMap Word64 ([Mem], ANormal v)
cs = Section -> EnumMap Word64 Section -> GBranch CombIx
forall comb.
GSection comb -> EnumMap Word64 (GSection comb) -> GBranch comb
TestW Section
forall {comb}. GSection comb
edf (EnumMap Word64 Section -> GBranch CombIx)
-> Emit (EnumMap Word64 Section) -> Emit (GBranch CombIx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Mem], ANormal v) -> Emit Section)
-> EnumMap Word64 ([Mem], ANormal v)
-> Emit (EnumMap Word64 Section)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EnumMap Word64 a -> f (EnumMap Word64 b)
traverse (RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
emitCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx) EnumMap Word64 ([Mem], ANormal v)
cs
edf :: GSection comb
edf = [Char] -> GSection comb
forall comb. [Char] -> GSection comb
Die [Char]
"unhandled ability"
emitLitMatching ::
(Var v) =>
(Traversable f) =>
(Int -> Section -> f Section -> Section) ->
String ->
RefNums ->
Reference ->
Word64 ->
RCtx v ->
Ctx v ->
Int ->
f (ANormal v) ->
Maybe (ANormal v) ->
Emit Section
emitLitMatching :: forall v (f :: * -> *).
(Var v, Traversable f) =>
(Int -> Section -> f Section -> Section)
-> [Char]
-> RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> Int
-> f (ANormal v)
-> Maybe (ANormal v)
-> Emit Section
emitLitMatching Int -> Section -> f Section -> Section
con [Char]
err RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx Int
i f (ANormal v)
cs Maybe (ANormal v)
df =
Int -> Section -> f Section -> Section
con Int
i (Section -> f Section -> Section)
-> Emit Section -> Emit (f Section -> Section)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Emit Section
edf Emit (f Section -> Section) -> Emit (f Section) -> Emit Section
forall a b. Emit (a -> b) -> Emit a -> Emit b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ANormal v -> Emit Section) -> f (ANormal v) -> Emit (f Section)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse (RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
emitCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx (([Mem], ANormal v) -> Emit Section)
-> (ANormal v -> ([Mem], ANormal v)) -> ANormal v -> Emit Section
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],)) f (ANormal v)
cs
where
edf :: Emit Section
edf
| Just ANormal v
co <- Maybe (ANormal v)
df = RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx ANormal v
co
| Bool
otherwise = Ctx v -> Section -> Emit Section
forall v a. Ctx v -> a -> Emit a
countCtx Ctx v
ctx (Section -> Emit Section) -> Section -> Emit Section
forall a b. (a -> b) -> a -> b
$ [Char] -> Section
forall comb. [Char] -> GSection comb
Die [Char]
err
emitCase ::
(Var v) =>
RefNums ->
Reference ->
Word64 ->
RCtx v ->
Ctx v ->
([Mem], ANormal v) ->
Emit Section
emitCase :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ([Mem], ANormal v)
-> Emit Section
emitCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx ([Mem]
ccs, TAbss [v]
vs ANormal v
bo) =
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec ([(v, Mem)] -> Ctx v -> Ctx v
forall v. [(v, Mem)] -> Ctx v -> Ctx v
pushCtx ([v] -> [Mem] -> [(v, Mem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs [Mem]
ccs) Ctx v
ctx) ANormal v
bo
emitSumCase ::
(Var v) =>
RefNums ->
Reference ->
Word64 ->
RCtx v ->
Ctx v ->
v ->
([Mem], ANormal v) ->
Emit Section
emitSumCase :: forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> v
-> ([Mem], ANormal v)
-> Emit Section
emitSumCase RefNums
rns Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx v
v ([Mem]
ccs, TAbss [v]
vs ANormal v
bo) =
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
forall v.
Var v =>
RefNums
-> Reference
-> Word64
-> RCtx v
-> Ctx v
-> ANormal v
-> Emit Section
emitSection RefNums
rns Reference
grpr Word64
grpn RCtx v
rec (Ctx v -> v -> [(v, Mem)] -> Ctx v
forall v. Var v => Ctx v -> v -> [(v, Mem)] -> Ctx v
sumCtx Ctx v
ctx v
v ([(v, Mem)] -> Ctx v) -> [(v, Mem)] -> Ctx v
forall a b. (a -> b) -> a -> b
$ [v] -> [Mem] -> [(v, Mem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs [Mem]
ccs) ANormal v
bo
litToMLit :: ANF.Lit -> MLit
litToMLit :: Lit -> MLit
litToMLit (ANF.I Int64
i) = Int -> MLit
MI (Int -> MLit) -> Int -> MLit
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
litToMLit (ANF.N Word64
n) = Int -> MLit
MI (Int -> MLit) -> Int -> MLit
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
litToMLit (ANF.C Char
c) = Int -> MLit
MI (Int -> MLit) -> Int -> MLit
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c
litToMLit (ANF.F Double
d) = Double -> MLit
MD Double
d
litToMLit (ANF.T Text
t) = Text -> MLit
MT Text
t
litToMLit (ANF.LM Referent
r) = Referent -> MLit
MM Referent
r
litToMLit (ANF.LY Reference
r) = Reference -> MLit
MY Reference
r
emitLit :: ANF.Lit -> Instr
emitLit :: Lit -> Instr
emitLit = MLit -> Instr
forall comb. MLit -> GInstr comb
Lit (MLit -> Instr) -> (Lit -> MLit) -> Lit -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> MLit
litToMLit
doubleToInt :: Double -> Int
doubleToInt :: Double -> Int
doubleToInt Double
d = ByteArray -> Int -> Int
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ([Double] -> ByteArray
forall a. Prim a => [a] -> ByteArray
byteArrayFromList [Double
d]) Int
0
emitBLit :: ANF.Lit -> Instr
emitBLit :: Lit -> Instr
emitBLit Lit
l = case Lit
l of
(ANF.F Double
d) -> Reference -> Word64 -> MLit -> Instr
forall comb. Reference -> Word64 -> MLit -> GInstr comb
BLit Reference
lRef Word64
builtinTypeTag (Int -> MLit
MI (Int -> MLit) -> Int -> MLit
forall a b. (a -> b) -> a -> b
$ Double -> Int
doubleToInt Double
d)
Lit
_ -> Reference -> Word64 -> MLit -> Instr
forall comb. Reference -> Word64 -> MLit -> GInstr comb
BLit Reference
lRef Word64
builtinTypeTag (Lit -> MLit
litToMLit Lit
l)
where
lRef :: Reference
lRef = Lit -> Reference
ANF.litRef Lit
l
builtinTypeTag :: Word64
builtinTypeTag :: Word64
builtinTypeTag =
case Reference -> Map Reference Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Lit -> Reference
ANF.litRef Lit
l) Map Reference Word64
builtinTypeNumbering of
Maybe Word64
Nothing -> [Char] -> Word64
forall a. HasCallStack => [Char] -> a
error [Char]
"emitBLit: unknown builtin type reference"
Just Word64
n ->
let rt :: RTag
rt = Int -> RTag
forall a. Enum a => Int -> a
toEnum (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
in (RTag -> CTag -> Word64
packTags RTag
rt CTag
0)
emitClosures ::
(Var v) =>
Reference ->
Word64 ->
RCtx v ->
Ctx v ->
[v] ->
(Ctx v -> Args -> Emit Section) ->
Emit Section
emitClosures :: forall v.
Var v =>
Reference
-> Word64
-> RCtx v
-> Ctx v
-> [v]
-> (Ctx v -> Args -> Emit Section)
-> Emit Section
emitClosures Reference
grpr Word64
grpn RCtx v
rec Ctx v
ctx [v]
args Ctx v -> Args -> Emit Section
k =
Ctx v -> [v] -> (Ctx v -> Emit Section) -> Emit Section
allocate Ctx v
ctx [v]
args ((Ctx v -> Emit Section) -> Emit Section)
-> (Ctx v -> Emit Section) -> Emit Section
forall a b. (a -> b) -> a -> b
$ \Ctx v
ctx -> Ctx v -> Args -> Emit Section
k Ctx v
ctx (Args -> Emit Section) -> Args -> Emit Section
forall a b. (a -> b) -> a -> b
$ Word64 -> Ctx v -> [v] -> Args
forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args
where
allocate :: Ctx v -> [v] -> (Ctx v -> Emit Section) -> Emit Section
allocate Ctx v
ctx [] Ctx v -> Emit Section
k = Ctx v -> Emit Section
k Ctx v
ctx
allocate Ctx v
ctx (v
a : [v]
as) Ctx v -> Emit Section
k
| Just (Int, Mem)
_ <- Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx v
a = Ctx v -> [v] -> (Ctx v -> Emit Section) -> Emit Section
allocate Ctx v
ctx [v]
as Ctx v -> Emit Section
k
| Just Word64
n <- RCtx v -> v -> Maybe Word64
forall v. Var v => RCtx v -> v -> Maybe Word64
rctxResolve RCtx v
rec v
a =
Instr -> Section -> Section
forall comb. GInstr comb -> GSection comb -> GSection comb
Ins (GRef CombIx -> Args -> Instr
forall comb. GRef comb -> Args -> GInstr comb
Name (CombIx -> GRef CombIx
forall comb. comb -> GRef comb
Env (Reference -> Word64 -> Word64 -> CombIx
CIx Reference
grpr Word64
grpn Word64
n)) Args
ZArgs) (Section -> Section) -> Emit Section -> Emit Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx v -> [v] -> (Ctx v -> Emit Section) -> Emit Section
allocate (v -> Mem -> Ctx v -> Ctx v
forall v. v -> Mem -> Ctx v -> Ctx v
Var v
a Mem
BX Ctx v
ctx) [v]
as Ctx v -> Emit Section
k
| Bool
otherwise =
[Char] -> Emit Section
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Emit Section) -> [Char] -> Emit Section
forall a b. (a -> b) -> a -> b
$ [Char]
"emitClosures: unknown reference: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> [Char]
forall a. Show a => a -> [Char]
show v
a
emitArgs :: (Var v) => Word64 -> Ctx v -> [v] -> Args
emitArgs :: forall v. Var v => Word64 -> Ctx v -> [v] -> Args
emitArgs Word64
grpn Ctx v
ctx [v]
args
| Just [(Int, Mem)]
l <- (v -> Maybe (Int, Mem)) -> [v] -> Maybe [(Int, Mem)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ctx v -> v -> Maybe (Int, Mem)
forall v. Var v => Ctx v -> v -> Maybe (Int, Mem)
ctxResolve Ctx v
ctx) [v]
args = [(Int, Mem)] -> Args
demuxArgs [(Int, Mem)]
l
| Bool
otherwise =
[Char] -> Args
forall a. HasCallStack => [Char] -> a
internalBug ([Char] -> Args) -> [Char] -> Args
forall a b. (a -> b) -> a -> b
$
[Char]
"emitArgs["
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
grpn
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]: "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"could not resolve argument variables: "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [v] -> [Char]
forall a. Show a => a -> [Char]
show [v]
args
demuxArgs :: [(Int, Mem)] -> Args
demuxArgs :: [(Int, Mem)] -> Args
demuxArgs [(Int, Mem)]
as0 =
case ([(Int, Mem)] -> [Int])
-> ([(Int, Mem)] -> [Int])
-> ([(Int, Mem)], [(Int, Mem)])
-> ([Int], [Int])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (((Int, Mem) -> Int) -> [(Int, Mem)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Mem) -> Int
forall a b. (a, b) -> a
fst) (((Int, Mem) -> Int) -> [(Int, Mem)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Mem) -> Int
forall a b. (a, b) -> a
fst) (([(Int, Mem)], [(Int, Mem)]) -> ([Int], [Int]))
-> ([(Int, Mem)], [(Int, Mem)]) -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ ((Int, Mem) -> Bool)
-> [(Int, Mem)] -> ([(Int, Mem)], [(Int, Mem)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Mem -> Mem -> Bool
forall a. Eq a => a -> a -> Bool
== Mem
UN) (Mem -> Bool) -> ((Int, Mem) -> Mem) -> (Int, Mem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Mem) -> Mem
forall a b. (a, b) -> b
snd) [(Int, Mem)]
as0 of
([], []) -> Args
ZArgs
([], [Int
i]) -> Int -> Args
BArg1 Int
i
([], [Int
i, Int
j]) -> Int -> Int -> Args
BArg2 Int
i Int
j
([Int
i], []) -> Int -> Args
UArg1 Int
i
([Int
i, Int
j], []) -> Int -> Int -> Args
UArg2 Int
i Int
j
([Int
i], [Int
j]) -> Int -> Int -> Args
DArg2 Int
i Int
j
([], [Int]
bs) -> PrimArray Int -> Args
BArgN (PrimArray Int -> Args) -> PrimArray Int -> Args
forall a b. (a -> b) -> a -> b
$ [Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
bs
([Int]
us, []) -> PrimArray Int -> Args
UArgN (PrimArray Int -> Args) -> PrimArray Int -> Args
forall a b. (a -> b) -> a -> b
$ [Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
us
([Int]
us, [Int]
bs) -> PrimArray Int -> PrimArray Int -> Args
DArgN ([Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
us) ([Int] -> PrimArray Int
forall a. Prim a => [a] -> PrimArray a
primArrayFromList [Int]
bs)
combDeps :: Comb -> [Word64]
combDeps :: Comb -> [Word64]
combDeps (Lam Int
_ Int
_ Int
_ Int
_ Section
s) = Section -> [Word64]
sectionDeps Section
s
combTypes :: Comb -> [Word64]
combTypes :: Comb -> [Word64]
combTypes (Lam Int
_ Int
_ Int
_ Int
_ Section
s) = Section -> [Word64]
sectionTypes Section
s
sectionDeps :: Section -> [Word64]
sectionDeps :: Section -> [Word64]
sectionDeps (App Bool
_ (Env (CIx Reference
_ Word64
w Word64
_)) Args
_) = [Word64
w]
sectionDeps (Call Bool
_ (CIx Reference
_ Word64
w Word64
_) Args
_) = [Word64
w]
sectionDeps (Match Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchDeps GBranch CombIx
br
sectionDeps (DMatch Maybe Reference
_ Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchDeps GBranch CombIx
br
sectionDeps (RMatch Int
_ Section
pu EnumMap Word64 (GBranch CombIx)
br) =
Section -> [Word64]
sectionDeps Section
pu [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (GBranch CombIx -> [Word64])
-> EnumMap Word64 (GBranch CombIx) -> [Word64]
forall m a. Monoid m => (a -> m) -> EnumMap Word64 a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GBranch CombIx -> [Word64]
branchDeps EnumMap Word64 (GBranch CombIx)
br
sectionDeps (NMatch Maybe Reference
_ Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchDeps GBranch CombIx
br
sectionDeps (Ins Instr
i Section
s)
| Name (Env (CIx Reference
_ Word64
w Word64
_)) Args
_ <- Instr
i = Word64
w Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: Section -> [Word64]
sectionDeps Section
s
| Bool
otherwise = Section -> [Word64]
sectionDeps Section
s
sectionDeps (Let Section
s (CIx Reference
_ Word64
w Word64
_)) = Word64
w Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: Section -> [Word64]
sectionDeps Section
s
sectionDeps Section
_ = []
sectionTypes :: Section -> [Word64]
sectionTypes :: Section -> [Word64]
sectionTypes (Ins Instr
i Section
s) = Instr -> [Word64]
instrTypes Instr
i [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionTypes Section
s
sectionTypes (Let Section
s CombIx
_) = Section -> [Word64]
sectionTypes Section
s
sectionTypes (Match Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchTypes GBranch CombIx
br
sectionTypes (DMatch Maybe Reference
_ Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchTypes GBranch CombIx
br
sectionTypes (NMatch Maybe Reference
_ Int
_ GBranch CombIx
br) = GBranch CombIx -> [Word64]
branchTypes GBranch CombIx
br
sectionTypes (RMatch Int
_ Section
pu EnumMap Word64 (GBranch CombIx)
br) =
Section -> [Word64]
sectionTypes Section
pu [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (GBranch CombIx -> [Word64])
-> EnumMap Word64 (GBranch CombIx) -> [Word64]
forall m a. Monoid m => (a -> m) -> EnumMap Word64 a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GBranch CombIx -> [Word64]
branchTypes EnumMap Word64 (GBranch CombIx)
br
sectionTypes Section
_ = []
instrTypes :: Instr -> [Word64]
instrTypes :: Instr -> [Word64]
instrTypes (Pack Reference
_ Word64
w Args
_) = [Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16]
instrTypes (Reset EnumSet Word64
ws) = EnumSet Word64 -> [Word64]
forall k. EnumKey k => EnumSet k -> [k]
setToList EnumSet Word64
ws
instrTypes (Capture Word64
w) = [Word64
w]
instrTypes (SetDyn Word64
w Int
_) = [Word64
w]
instrTypes Instr
_ = []
branchDeps :: Branch -> [Word64]
branchDeps :: GBranch CombIx -> [Word64]
branchDeps (Test1 Word64
_ Section
s1 Section
d) = Section -> [Word64]
sectionDeps Section
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionDeps Section
d
branchDeps (Test2 Word64
_ Section
s1 Word64
_ Section
s2 Section
d) =
Section -> [Word64]
sectionDeps Section
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionDeps Section
s2 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionDeps Section
d
branchDeps (TestW Section
d EnumMap Word64 Section
m) =
Section -> [Word64]
sectionDeps Section
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (Section -> [Word64]) -> EnumMap Word64 Section -> [Word64]
forall m a. Monoid m => (a -> m) -> EnumMap Word64 a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Section -> [Word64]
sectionDeps EnumMap Word64 Section
m
branchDeps (TestT Section
d Map Text Section
m) =
Section -> [Word64]
sectionDeps Section
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (Section -> [Word64]) -> Map Text Section -> [Word64]
forall m a. Monoid m => (a -> m) -> Map Text a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Section -> [Word64]
sectionDeps Map Text Section
m
branchTypes :: Branch -> [Word64]
branchTypes :: GBranch CombIx -> [Word64]
branchTypes (Test1 Word64
_ Section
s1 Section
d) = Section -> [Word64]
sectionTypes Section
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionTypes Section
d
branchTypes (Test2 Word64
_ Section
s1 Word64
_ Section
s2 Section
d) =
Section -> [Word64]
sectionTypes Section
s1 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionTypes Section
s2 [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ Section -> [Word64]
sectionTypes Section
d
branchTypes (TestW Section
d EnumMap Word64 Section
m) =
Section -> [Word64]
sectionTypes Section
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (Section -> [Word64]) -> EnumMap Word64 Section -> [Word64]
forall m a. Monoid m => (a -> m) -> EnumMap Word64 a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Section -> [Word64]
sectionTypes EnumMap Word64 Section
m
branchTypes (TestT Section
d Map Text Section
m) =
Section -> [Word64]
sectionTypes Section
d [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ (Section -> [Word64]) -> Map Text Section -> [Word64]
forall m a. Monoid m => (a -> m) -> Map Text a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Section -> [Word64]
sectionTypes Map Text Section
m
indent :: Int -> ShowS
indent :: Int -> ShowS
indent Int
ind = [Char] -> ShowS
showString (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' ')
prettyCombs ::
Word64 ->
EnumMap Word64 Comb ->
ShowS
prettyCombs :: Word64 -> EnumMap Word64 Comb -> ShowS
prettyCombs Word64
w EnumMap Word64 Comb
es =
((Word64, Comb) -> ShowS -> ShowS)
-> ShowS -> [(Word64, Comb)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\(Word64
i, Comb
c) ShowS
r -> Word64 -> Word64 -> Comb -> ShowS
prettyComb Word64
w Word64
i Comb
c ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r)
ShowS
forall a. a -> a
id
(EnumMap Word64 Comb -> [(Word64, Comb)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 Comb
es)
prettyComb :: Word64 -> Word64 -> Comb -> ShowS
prettyComb :: Word64 -> Word64 -> Comb -> ShowS
prettyComb Word64
w Word64
i (Lam Int
ua Int
ba Int
_ Int
_ Section
s) =
Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
w
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
":"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
i
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
ua, Int
ba]
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
":\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection Int
2 Section
s
prettySection :: Int -> Section -> ShowS
prettySection :: Int -> Section -> ShowS
prettySection Int
ind Section
sec =
Int -> ShowS
indent Int
ind ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Section
sec of
App Bool
_ GRef CombIx
r Args
as ->
[Char] -> ShowS
showString [Char]
"App "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GRef CombIx -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
12 GRef CombIx
r
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> ShowS
prettyArgs Args
as
Call Bool
_ CombIx
i Args
as ->
[Char] -> ShowS
showString [Char]
"Call " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CombIx -> ShowS
forall a. Show a => a -> ShowS
shows CombIx
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> ShowS
prettyArgs Args
as
Jump Int
i Args
as ->
[Char] -> ShowS
showString [Char]
"Jump " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> ShowS
prettyArgs Args
as
Match Int
i GBranch CombIx
bs ->
[Char] -> ShowS
showString [Char]
"Match "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GBranch CombIx -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch CombIx
bs
Yield Args
as -> [Char] -> ShowS
showString [Char]
"Yield " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> ShowS
prettyArgs Args
as
Ins Instr
i Section
nx ->
Instr -> ShowS
prettyIns Instr
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection Int
ind Section
nx
Let Section
s CombIx
n ->
[Char] -> ShowS
showString [Char]
"Let\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Section
s
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
ind
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CombIx -> ShowS
prettyIx CombIx
n
Die [Char]
s -> [Char] -> ShowS
showString ([Char] -> ShowS) -> [Char] -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
"Die " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s
Section
Exit -> [Char] -> ShowS
showString [Char]
"Exit"
DMatch Maybe Reference
_ Int
i GBranch CombIx
bs ->
[Char] -> ShowS
showString [Char]
"DMatch "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GBranch CombIx -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch CombIx
bs
NMatch Maybe Reference
_ Int
i GBranch CombIx
bs ->
[Char] -> ShowS
showString [Char]
"NMatch "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GBranch CombIx -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch CombIx
bs
RMatch Int
i Section
pu EnumMap Word64 (GBranch CombIx)
bs ->
[Char] -> ShowS
showString [Char]
"RMatch "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\nPUR ->\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Section
pu
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, GBranch CombIx) -> ShowS -> ShowS)
-> ShowS -> [(Word64, GBranch CombIx)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Word64, GBranch CombIx)
p ShowS
r -> (Word64, GBranch CombIx) -> ShowS
rqc (Word64, GBranch CombIx)
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id (EnumMap Word64 (GBranch CombIx) -> [(Word64, GBranch CombIx)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 (GBranch CombIx)
bs)
where
rqc :: (Word64, GBranch CombIx) -> ShowS
rqc (Word64
i, GBranch CombIx
e) =
[Char] -> ShowS
showString [Char]
"\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
i
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" ->\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GBranch CombIx -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GBranch CombIx
e
prettyIx :: CombIx -> ShowS
prettyIx :: CombIx -> ShowS
prettyIx (CIx Reference
_ Word64
c Word64
s) =
[Char] -> ShowS
showString [Char]
"Resume["
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
c
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
","
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
s
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"]"
prettyBranches :: Int -> Branch -> ShowS
prettyBranches :: Int -> GBranch CombIx -> ShowS
prettyBranches Int
ind GBranch CombIx
bs =
case GBranch CombIx
bs of
Test1 Word64
i Section
e Section
df -> Section -> ShowS
pdf Section
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Section -> ShowS
picase Word64
i Section
e
Test2 Word64
i Section
ei Word64
j Section
ej Section
df -> Section -> ShowS
pdf Section
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Section -> ShowS
picase Word64
i Section
ei ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Section -> ShowS
picase Word64
j Section
ej
TestW Section
df EnumMap Word64 Section
m ->
Section -> ShowS
pdf Section
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, Section) -> ShowS -> ShowS)
-> ShowS -> [(Word64, Section)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Word64
i, Section
e) ShowS
r -> Word64 -> Section -> ShowS
picase Word64
i Section
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id (EnumMap Word64 Section -> [(Word64, Section)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 Section
m)
TestT Section
df Map Text Section
m ->
Section -> ShowS
pdf Section
df ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Section) -> ShowS -> ShowS)
-> ShowS -> [(Text, Section)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Text
i, Section
e) ShowS
r -> Text -> Section -> ShowS
ptcase Text
i Section
e ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id (Map Text Section -> [(Text, Section)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Section
m)
where
pdf :: Section -> ShowS
pdf Section
e = Int -> ShowS
indent Int
ind ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"DFLT ->\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Section
e
ptcase :: Text -> Section -> ShowS
ptcase Text
t Section
e =
[Char] -> ShowS
showString [Char]
"\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
ind
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShowS
forall a. Show a => a -> ShowS
shows Text
t
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" ->\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Section
e
picase :: Word64 -> Section -> ShowS
picase Word64
i Section
e =
[Char] -> ShowS
showString [Char]
"\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
ind
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
i
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" ->\n"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Section -> ShowS
prettySection (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Section
e
un :: ShowS
un :: ShowS
un = (Char
'U' Char -> ShowS
forall a. a -> [a] -> [a]
:)
bx :: ShowS
bx :: ShowS
bx = (Char
'B' Char -> ShowS
forall a. a -> [a] -> [a]
:)
prettyIns :: Instr -> ShowS
prettyIns :: Instr -> ShowS
prettyIns (Pack Reference
r Word64
i Args
as) =
[Char] -> ShowS
showString [Char]
"Pack "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Reference -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 Reference
r
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
i
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> ShowS
prettyArgs Args
as
prettyIns Instr
i = Instr -> ShowS
forall a. Show a => a -> ShowS
shows Instr
i
prettyArgs :: Args -> ShowS
prettyArgs :: Args -> ShowS
prettyArgs Args
ZArgs = forall a. Show a => a -> ShowS
shows @[Int] []
prettyArgs (UArg1 Int
i) = ShowS
un ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i]
prettyArgs (BArg1 Int
i) = ShowS
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i]
prettyArgs (UArg2 Int
i Int
j) = ShowS
un ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i, Int
j]
prettyArgs (BArg2 Int
i Int
j) = ShowS
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i, Int
j]
prettyArgs (DArg2 Int
i Int
j) = ShowS
un ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i] ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
j]
prettyArgs (UArgR Int
i Int
l) = ShowS
un ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
Prelude.take Int
l [Int
i ..])
prettyArgs (BArgR Int
i Int
l) = ShowS
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
Prelude.take Int
l [Int
i ..])
prettyArgs (DArgR Int
i Int
l Int
j Int
k) =
ShowS
un
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
Prelude.take Int
l [Int
i ..])
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
bx
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
Prelude.take Int
k [Int
j ..])
prettyArgs (UArgN PrimArray Int
v) = ShowS
un ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
v)
prettyArgs (BArgN PrimArray Int
v) = ShowS
bx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
v)
prettyArgs (DArgN PrimArray Int
u PrimArray Int
b) =
ShowS
un
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
u)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
bx
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (PrimArray Int -> [Int]
forall a. Prim a => PrimArray a -> [a]
primArrayToList PrimArray Int
b)
prettyArgs (DArgV Int
i Int
j) = (Char
'V' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int
i, Int
j]