module Unison.Runtime.ANF.Serialize.CodeV4 where

import Control.Monad
import Data.Binary.Get qualified as BGet
import Data.ByteString.Builder (Builder)
import Data.ByteString.Builder qualified as BU
import Data.Bytes.Get hiding (getBytes)
import Data.Functor ((<&>))
import Data.Map.Strict as Map (lookup)
import Data.Serialize.Get qualified as SGet
import Data.Word (Word64)
import GHC.Stack
import Unison.ABT.Normalized (Term (..))
import Unison.Reference (Reference)
import Unison.Runtime.ANF as ANF hiding (Tag)
import Unison.Runtime.ANF.POp as ANF
import Unison.Runtime.ANF.Serialize.Tags
import Unison.Runtime.Exception
import Unison.Runtime.Foreign.Function.Type (ForeignFunc)
import Unison.Runtime.Referenced
import Unison.Runtime.Serialize hiding
  ( getReferent,
    putReferent,
  )
import Unison.Util.Text qualified as Util.Text
import Unison.Var (Type (ANFBlank), Var (..))
import Prelude hiding (getChar, putChar)

pushCtx :: [v] -> [v] -> [v]
pushCtx :: forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
vs = [v] -> [v]
forall a. [a] -> [a]
reverse [v]
us [v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
++ [v]
vs

index :: (Eq v) => [v] -> v -> Maybe Word64
index :: forall v. Eq v => [v] -> v -> Maybe Word64
index [v]
ctx v
u = Word64 -> [v] -> Maybe Word64
go Word64
0 [v]
ctx
  where
    go :: Word64 -> [v] -> Maybe Word64
go !Word64
_ [] = Maybe Word64
forall a. Maybe a
Nothing
    go Word64
n (v
v : [v]
vs)
      | v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
u = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
n
      | Bool
otherwise = Word64 -> [v] -> Maybe Word64
go (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) [v]
vs

deindex :: (HasCallStack) => [v] -> Word64 -> v
deindex :: forall v. HasCallStack => [v] -> Word64 -> v
deindex [] Word64
_ = [Word] -> [Char] -> v
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"deindex: bad index"
deindex (v
v : [v]
vs) Word64
n
  | Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = v
v
  | Bool
otherwise = [v] -> Word64 -> v
forall v. HasCallStack => [v] -> Word64 -> v
deindex [v]
vs (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)

putIndex :: Word64 -> Builder
putIndex :: Word64 -> Builder
putIndex = Word64 -> Builder
forall a.
(Integral a, Integral (Unsigned a), Bits (Unsigned a)) =>
a -> Builder
putVarInt
{-# INLINE putIndex #-}

getIndex :: (MonadGet m) => m Word64
getIndex :: forall (m :: * -> *). MonadGet m => m Word64
getIndex = m Word64
forall (m :: * -> *) b. (MonadGet m, Num b, Bits b) => m b
getVarInt
{-# INLINE getIndex #-}

putVar :: (Eq v) => [v] -> v -> Builder
putVar :: forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
  | Just Word64
i <- [v] -> v -> Maybe Word64
forall v. Eq v => [v] -> v -> Maybe Word64
index [v]
ctx v
v = Word64 -> Builder
putIndex Word64
i
  | Bool
otherwise = [Word] -> [Char] -> Builder
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"putVar: variable not in context"

getVar :: (MonadGet m) => [v] -> m v
getVar :: forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx = [v] -> Word64 -> v
forall v. HasCallStack => [v] -> Word64 -> v
deindex [v]
ctx (Word64 -> v) -> m Word64 -> m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getIndex

putArgs :: (Eq v) => [v] -> [v] -> Builder
putArgs :: forall v. Eq v => [v] -> [v] -> Builder
putArgs [v]
ctx [v]
is = (v -> Builder) -> [v] -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable ([v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx) [v]
is

getArgs :: (MonadGet m) => [v] -> m [v]
getArgs :: forall (m :: * -> *) v. MonadGet m => [v] -> m [v]
getArgs [v]
ctx = m v -> m [v]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList ([v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx)

putCCs :: [Mem] -> Builder
putCCs :: [Mem] -> Builder
putCCs [Mem]
ccs = Int -> Builder
forall n.
(Integral n, Integral (Unsigned n), Bits n, Bits (Unsigned n)) =>
n -> Builder
putLength Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Mem -> Builder) -> [Mem] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Mem -> Builder
putCC [Mem]
ccs
  where
    n :: Int
n = [Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs
    putCC :: Mem -> Builder
putCC Mem
UN = Word8 -> Builder
BU.word8 Word8
0
    putCC Mem
BX = Word8 -> Builder
BU.word8 Word8
1

getCCs :: (MonadGet m) => m [Mem]
getCCs :: forall (m :: * -> *). MonadGet m => m [Mem]
getCCs =
  m Mem -> m [Mem]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (m Mem -> m [Mem]) -> m Mem -> m [Mem]
forall a b. (a -> b) -> a -> b
$
    m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> Mem) -> m Mem
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Word8
0 -> Mem
UN
      Word8
1 -> Mem
BX
      Word8
_ -> [Word] -> [Char] -> Mem
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"getCCs: bad calling convention"

-- Serializes a `SuperGroup`.
--
-- The Reference map allows certain term references to be switched out
-- for a given 64 bit word. This is used when re-hashing intermediate
-- code. For actual serialization, the empty map should be used, so
-- that the process is reversible. The purpose of this is merely to
-- strip out (mutual/)self-references when producing a byte sequence
-- to recompute a hash of a connected component of intermediate
-- definitons, since it is infeasible to
--
-- The EnumMap associates 'foreign' operations with a textual name
-- that is used as the serialized representation. Since they are
-- generated somewhat dynamically, it is not easy to associate them
-- with a fixed numbering like we can with POps.
putGroup ::
  (Var v) =>
  Bool ->
  SuperGroup RefNum v ->
  Builder
putGroup :: forall v. Var v => Bool -> SuperGroup RefNum v -> Builder
putGroup Bool
fops (Rec [(v, SuperNormal RefNum v)]
bs SuperNormal RefNum v
e) =
  Int -> Builder
forall n.
(Integral n, Integral (Unsigned n), Bits n, Bits (Unsigned n)) =>
n -> Builder
putLength Int
n
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (SuperNormal RefNum v -> Builder)
-> [SuperNormal RefNum v] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> [v] -> SuperNormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> SuperNormal RefNum v -> Builder
putComb Bool
fops [v]
ctx) [SuperNormal RefNum v]
cs
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> SuperNormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> SuperNormal RefNum v -> Builder
putComb Bool
fops [v]
ctx SuperNormal RefNum v
e
  where
    n :: Int
n = [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
us
    ([v]
us, [SuperNormal RefNum v]
cs) = [(v, SuperNormal RefNum v)] -> ([v], [SuperNormal RefNum v])
forall a b. [(a, b)] -> ([a], [b])
unzip [(v, SuperNormal RefNum v)]
bs
    ctx :: [v]
ctx = [v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us []

getGroup ::
  (MonadGet m) =>
  (Var v) =>
  m (SuperGroup RefNum v)
getGroup :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
m (SuperGroup RefNum v)
getGroup = do
  Int
l <- m Int
forall (m :: * -> *) n.
(MonadGet m, Integral n, Integral (Unsigned n), Bits n,
 Bits (Unsigned n)) =>
m n
getLength
  let n :: Word64
n = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
      vs :: [v]
vs = Word64 -> v
forall v. Var v => Word64 -> v
getFresh (Word64 -> v) -> [Word64] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
l [Word64
0 ..]
      ctx :: [v]
ctx = [v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
vs []
  [SuperNormal RefNum v]
cs <- Int -> m (SuperNormal RefNum v) -> m [SuperNormal RefNum v]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
l ([v] -> Word64 -> m (SuperNormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (SuperNormal RefNum v)
getComb [v]
ctx Word64
n)
  [(v, SuperNormal RefNum v)]
-> SuperNormal RefNum v -> SuperGroup RefNum v
forall ref v.
[(v, SuperNormal ref v)] -> SuperNormal ref v -> SuperGroup ref v
Rec ([v] -> [SuperNormal RefNum v] -> [(v, SuperNormal RefNum v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs [SuperNormal RefNum v]
cs) (SuperNormal RefNum v -> SuperGroup RefNum v)
-> m (SuperNormal RefNum v) -> m (SuperGroup RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (SuperNormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (SuperNormal RefNum v)
getComb [v]
ctx Word64
n

putCode :: Bool -> (Code RefNum) -> Builder
putCode :: Bool -> Code RefNum -> Builder
putCode Bool
fops (CodeRep SuperGroup RefNum Symbol
g Cacheability
c) =
  Bool -> SuperGroup RefNum Symbol -> Builder
forall v. Var v => Bool -> SuperGroup RefNum v -> Builder
putGroup Bool
fops SuperGroup RefNum Symbol
g Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Cacheability -> Builder
putCacheability Cacheability
c

getCode :: (MonadGet m) => m (Code RefNum)
getCode :: forall (m :: * -> *). MonadGet m => m (Code RefNum)
getCode = SuperGroup RefNum Symbol -> Cacheability -> Code RefNum
forall ref. SuperGroup ref Symbol -> Cacheability -> Code ref
CodeRep (SuperGroup RefNum Symbol -> Cacheability -> Code RefNum)
-> m (SuperGroup RefNum Symbol) -> m (Cacheability -> Code RefNum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (SuperGroup RefNum Symbol)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
m (SuperGroup RefNum v)
getGroup m (Cacheability -> Code RefNum)
-> m Cacheability -> m (Code RefNum)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Cacheability
forall (m :: * -> *). MonadGet m => m Cacheability
getCacheability

putCodeWithHeader ::
  [Reference] -> [Reference] -> Bool -> Code RefNum -> Builder
putCodeWithHeader :: [Reference] -> [Reference] -> Bool -> Code RefNum -> Builder
putCodeWithHeader [Reference]
tyrs [Reference]
tmrs Bool
fops Code RefNum
co =
  (Reference -> Builder) -> [Reference] -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable Reference -> Builder
putReference [Reference]
tyrs
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Reference -> Builder) -> [Reference] -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable Reference -> Builder
putReference [Reference]
tmrs
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Code RefNum -> Builder
putCode Bool
fops Code RefNum
co

getCodeWithHeader :: (MonadGet m) => m (Referenced Code)
getCodeWithHeader :: forall (m :: * -> *). MonadGet m => m (Referenced Code)
getCodeWithHeader = do
  Int
tyl <- m Int
forall (m :: * -> *) n.
(MonadGet m, Integral n, Integral (Unsigned n), Bits n,
 Bits (Unsigned n)) =>
m n
getLength
  [Reference]
tys <- Int -> m Reference -> m [Reference]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
tyl m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
  Int
tml <- m Int
forall (m :: * -> *) n.
(MonadGet m, Integral n, Integral (Unsigned n), Bits n,
 Bits (Unsigned n)) =>
m n
getLength
  [Reference]
tms <- Int -> m Reference -> m [Reference]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
tml m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
  Code RefNum
co <- m (Code RefNum)
forall (m :: * -> *). MonadGet m => m (Code RefNum)
getCode
  pure ([Reference] -> [Reference] -> Code RefNum -> Referenced Code
forall (t :: * -> *).
[Reference] -> [Reference] -> t RefNum -> Referenced t
WithRefs [Reference]
tys [Reference]
tms Code RefNum
co)
{-# SPECIALIZE getCodeWithHeader :: BGet.Get (Referenced Code) #-}
{-# SPECIALIZE getCodeWithHeader :: SGet.Get (Referenced Code) #-}

putCacheability :: Cacheability -> Builder
putCacheability :: Cacheability -> Builder
putCacheability Cacheability
Uncacheable = Word8 -> Builder
BU.word8 Word8
0
putCacheability Cacheability
Cacheable = Word8 -> Builder
BU.word8 Word8
1

getCacheability :: (MonadGet m) => m Cacheability
getCacheability :: forall (m :: * -> *). MonadGet m => m Cacheability
getCacheability =
  m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m Cacheability) -> m Cacheability
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0 -> Cacheability -> m Cacheability
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cacheability
Uncacheable
    Word8
1 -> Cacheability -> m Cacheability
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cacheability
Cacheable
    Word8
n -> [Word] -> [Char] -> m Cacheability
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] ([Char] -> m Cacheability) -> [Char] -> m Cacheability
forall a b. (a -> b) -> a -> b
$ [Char]
"getBLit: unrecognized cacheability byte: " [Char] -> [Char] -> [Char]
forall v. [v] -> [v] -> [v]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
n

putComb ::
  (Var v) =>
  Bool ->
  [v] ->
  SuperNormal RefNum v ->
  Builder
putComb :: forall v. Var v => Bool -> [v] -> SuperNormal RefNum v -> Builder
putComb Bool
fops [v]
ctx (Lambda [Mem]
ccs (TAbss [v]
us Term (ANormalF RefNum) v
e)) =
  [Mem] -> Builder
putCCs [Mem]
ccs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> Term (ANormalF RefNum) v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Term (ANormalF RefNum) v
e

getFresh :: (Var v) => Word64 -> v
getFresh :: forall v. Var v => Word64 -> v
getFresh Word64
n = Word64 -> v -> v
forall v. Var v => Word64 -> v -> v
freshenId Word64
n (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ Type -> v
forall v. Var v => Type -> v
typed Type
ANFBlank

getComb ::
  (MonadGet m) =>
  (Var v) =>
  [v] ->
  Word64 ->
  m (SuperNormal RefNum v)
getComb :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (SuperNormal RefNum v)
getComb [v]
ctx Word64
frsh0 = do
  [Mem]
ccs <- m [Mem]
forall (m :: * -> *). MonadGet m => m [Mem]
getCCs
  let us :: [v]
us = (Mem -> Word64 -> v) -> [Mem] -> [Word64] -> [v]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Mem
_ -> Word64 -> v
forall v. Var v => Word64 -> v
getFresh) [Mem]
ccs [Word64
frsh0 ..]
      frsh :: Word64
frsh = Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs)
  [Mem] -> ANormal RefNum v -> SuperNormal RefNum v
forall ref v. [Mem] -> ANormal ref v -> SuperNormal ref v
Lambda [Mem]
ccs (ANormal RefNum v -> SuperNormal RefNum v)
-> (ANormal RefNum v -> ANormal RefNum v)
-> ANormal RefNum v
-> SuperNormal RefNum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal RefNum v -> ANormal RefNum v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v]
us (ANormal RefNum v -> SuperNormal RefNum v)
-> m (ANormal RefNum v) -> m (SuperNormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Word64
frsh

putNormal ::
  (Var v) =>
  Bool ->
  [v] ->
  ANormal RefNum v ->
  Builder
putNormal :: forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx ANormal RefNum v
tm = case ANormal RefNum v
tm of
  TVar v
v -> TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
VarT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
  TFrc v
v -> TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
ForceT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
  TApp Func RefNum v
f [v]
as -> TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
AppT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> Func RefNum v -> Builder
forall v. Var v => [v] -> Func RefNum v -> Builder
putFunc [v]
ctx Func RefNum v
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> [v] -> Builder
forall v. Eq v => [v] -> [v] -> Builder
putArgs [v]
ctx [v]
as
  THnd [RefNum]
rs v
nh Maybe v
_ah ANormal RefNum v
e ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
HandleT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (RefNum -> Builder) -> [RefNum] -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable RefNum -> Builder
putRefNum [RefNum]
rs
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
nh
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx ANormal RefNum v
e
  TShift RefNum
r v
v ANormal RefNum v
e ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
ShiftT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RefNum -> Builder
putRefNum RefNum
r
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal RefNum v
e
  TMatch v
v Branched RefNum (ANormal RefNum v)
bs ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
MatchT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> Branched RefNum (ANormal RefNum v) -> Builder
forall v.
Var v =>
Bool -> [v] -> Branched RefNum (ANormal RefNum v) -> Builder
putBranches Bool
fops [v]
ctx Branched RefNum (ANormal RefNum v)
bs
  TLit Lit RefNum
l -> TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
LitT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Lit RefNum -> Builder
putLit Lit RefNum
l
  TBLit Lit RefNum
l -> TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
BxLitT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Lit RefNum -> Builder
putLit Lit RefNum
l
  TName v
v (Left RefNum
r) [v]
as ANormal RefNum v
e ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
NameRefT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RefNum -> Builder
putRefNum RefNum
r
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> [v] -> Builder
forall v. Eq v => [v] -> [v] -> Builder
putArgs [v]
ctx [v]
as
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal RefNum v
e
  TName v
v (Right v
u) [v]
as ANormal RefNum v
e ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
NameVarT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
u
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> [v] -> Builder
forall v. Eq v => [v] -> [v] -> Builder
putArgs [v]
ctx [v]
as
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal RefNum v
e
  TLets Direction Word16
Direct [v]
us [Mem]
ccs ANormal RefNum v
l ANormal RefNum v
e ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
LetDirT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Mem] -> Builder
putCCs [Mem]
ccs
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx ANormal RefNum v
l
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal RefNum v
e
  TLets (Indirect Word16
w) [v]
us [Mem]
ccs ANormal RefNum v
l ANormal RefNum v
e ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
LetIndT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BU.word16BE Word16
w
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Mem] -> Builder
putCCs [Mem]
ccs
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx ANormal RefNum v
l
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal RefNum v
e
  ANormal RefNum v
v -> [Word] -> [Char] -> Builder
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ [Char]
"putNormal: malformed term\n" [Char] -> [Char] -> [Char]
forall v. [v] -> [v] -> [v]
++ ANormal RefNum v -> [Char]
forall a. Show a => a -> [Char]
show ANormal RefNum v
v

getNormal ::
  (MonadGet m) =>
  (Var v) =>
  [v] ->
  Word64 ->
  m (ANormal RefNum v)
getNormal :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0 =
  m TmTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m TmTag -> (TmTag -> m (ANormal RefNum v)) -> m (ANormal RefNum v)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    TmTag
VarT -> v -> ANormal RefNum v
forall v ref. Var v => v -> ANormal ref v
TVar (v -> ANormal RefNum v) -> m v -> m (ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
    TmTag
ForceT -> v -> ANormal RefNum v
forall v ref. Var v => v -> ANormal ref v
TFrc (v -> ANormal RefNum v) -> m v -> m (ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
    TmTag
AppT -> Func RefNum v -> [v] -> ANormal RefNum v
forall v ref. Var v => Func ref v -> [v] -> ANormal ref v
TApp (Func RefNum v -> [v] -> ANormal RefNum v)
-> m (Func RefNum v) -> m ([v] -> ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m (Func RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> m (Func RefNum v)
getFunc [v]
ctx m ([v] -> ANormal RefNum v) -> m [v] -> m (ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> m [v]
forall (m :: * -> *) v. MonadGet m => [v] -> m [v]
getArgs [v]
ctx
    TmTag
HandleT ->
      [RefNum] -> v -> Maybe v -> ANormal RefNum v -> ANormal RefNum v
forall v ref.
Var v =>
[ref] -> v -> Maybe v -> ANormal ref v -> ANormal ref v
THnd
        ([RefNum] -> v -> Maybe v -> ANormal RefNum v -> ANormal RefNum v)
-> m [RefNum]
-> m (v -> Maybe v -> ANormal RefNum v -> ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RefNum -> m [RefNum]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m RefNum
forall (m :: * -> *). MonadGet m => m RefNum
getRefNum
        m (v -> Maybe v -> ANormal RefNum v -> ANormal RefNum v)
-> m v -> m (Maybe v -> ANormal RefNum v -> ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
        m (Maybe v -> ANormal RefNum v -> ANormal RefNum v)
-> m (Maybe v) -> m (ANormal RefNum v -> ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe v -> m (Maybe v)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe v
forall a. Maybe a
Nothing
        m (ANormal RefNum v -> ANormal RefNum v)
-> m (ANormal RefNum v) -> m (ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0
    TmTag
ShiftT ->
      (RefNum -> v -> ANormal RefNum v -> ANormal RefNum v)
-> v -> RefNum -> ANormal RefNum v -> ANormal RefNum v
forall a b c. (a -> b -> c) -> b -> a -> c
flip RefNum -> v -> ANormal RefNum v -> ANormal RefNum v
forall v ref. Var v => ref -> v -> ANormal ref v -> ANormal ref v
TShift v
v
        (RefNum -> ANormal RefNum v -> ANormal RefNum v)
-> m RefNum -> m (ANormal RefNum v -> ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RefNum
forall (m :: * -> *). MonadGet m => m RefNum
getRefNum
        m (ANormal RefNum v -> ANormal RefNum v)
-> m (ANormal RefNum v) -> m (ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) (Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
      where
        v :: v
v = Word64 -> v
forall v. Var v => Word64 -> v
getFresh Word64
frsh0
    TmTag
MatchT -> v -> Branched RefNum (ANormal RefNum v) -> ANormal RefNum v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch (v -> Branched RefNum (ANormal RefNum v) -> ANormal RefNum v)
-> m v
-> m (Branched RefNum (ANormal RefNum v) -> ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx m (Branched RefNum (ANormal RefNum v) -> ANormal RefNum v)
-> m (Branched RefNum (ANormal RefNum v)) -> m (ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (Branched RefNum (ANormal RefNum v))
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (Branched RefNum (ANormal RefNum v))
getBranches [v]
ctx Word64
frsh0
    TmTag
LitT -> Lit RefNum -> ANormal RefNum v
forall v ref. Var v => Lit ref -> ANormal ref v
TLit (Lit RefNum -> ANormal RefNum v)
-> m (Lit RefNum) -> m (ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Lit RefNum)
forall (m :: * -> *). MonadGet m => m (Lit RefNum)
getLit
    TmTag
BxLitT -> Lit RefNum -> ANormal RefNum v
forall v ref. Var v => Lit ref -> ANormal ref v
TBLit (Lit RefNum -> ANormal RefNum v)
-> m (Lit RefNum) -> m (ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Lit RefNum)
forall (m :: * -> *). MonadGet m => m (Lit RefNum)
getLit
    TmTag
NameRefT ->
      v -> Either RefNum v -> [v] -> ANormal RefNum v -> ANormal RefNum v
forall v ref.
Var v =>
v -> Either ref v -> [v] -> ANormal ref v -> ANormal ref v
TName v
v (Either RefNum v -> [v] -> ANormal RefNum v -> ANormal RefNum v)
-> (RefNum -> Either RefNum v)
-> RefNum
-> [v]
-> ANormal RefNum v
-> ANormal RefNum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefNum -> Either RefNum v
forall a b. a -> Either a b
Left
        (RefNum -> [v] -> ANormal RefNum v -> ANormal RefNum v)
-> m RefNum -> m ([v] -> ANormal RefNum v -> ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RefNum
forall (m :: * -> *). MonadGet m => m RefNum
getRefNum
        m ([v] -> ANormal RefNum v -> ANormal RefNum v)
-> m [v] -> m (ANormal RefNum v -> ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> m [v]
forall (m :: * -> *) v. MonadGet m => [v] -> m [v]
getArgs [v]
ctx
        m (ANormal RefNum v -> ANormal RefNum v)
-> m (ANormal RefNum v) -> m (ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) (Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
      where
        v :: v
v = Word64 -> v
forall v. Var v => Word64 -> v
getFresh Word64
frsh0
    TmTag
NameVarT ->
      v -> Either RefNum v -> [v] -> ANormal RefNum v -> ANormal RefNum v
forall v ref.
Var v =>
v -> Either ref v -> [v] -> ANormal ref v -> ANormal ref v
TName v
v (Either RefNum v -> [v] -> ANormal RefNum v -> ANormal RefNum v)
-> (v -> Either RefNum v)
-> v
-> [v]
-> ANormal RefNum v
-> ANormal RefNum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Either RefNum v
forall a b. b -> Either a b
Right
        (v -> [v] -> ANormal RefNum v -> ANormal RefNum v)
-> m v -> m ([v] -> ANormal RefNum v -> ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
        m ([v] -> ANormal RefNum v -> ANormal RefNum v)
-> m [v] -> m (ANormal RefNum v -> ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> m [v]
forall (m :: * -> *) v. MonadGet m => [v] -> m [v]
getArgs [v]
ctx
        m (ANormal RefNum v -> ANormal RefNum v)
-> m (ANormal RefNum v) -> m (ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) (Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
      where
        v :: v
v = Word64 -> v
forall v. Var v => Word64 -> v
getFresh Word64
frsh0
    TmTag
LetDirT -> do
      [Mem]
ccs <- m [Mem]
forall (m :: * -> *). MonadGet m => m [Mem]
getCCs
      let l :: Int
l = [Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs
          frsh :: Word64
frsh = Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
          us :: [v]
us = Word64 -> v
forall v. Var v => Word64 -> v
getFresh (Word64 -> v) -> [Word64] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
l [Word64
frsh0 ..]
      Direction Word16
-> [v]
-> [Mem]
-> ANormal RefNum v
-> ANormal RefNum v
-> ANormal RefNum v
forall v ref.
Var v =>
Direction Word16
-> [v] -> [Mem] -> ANormal ref v -> ANormal ref v -> ANormal ref v
TLets Direction Word16
forall a. Direction a
Direct [v]
us [Mem]
ccs
        (ANormal RefNum v -> ANormal RefNum v -> ANormal RefNum v)
-> m (ANormal RefNum v) -> m (ANormal RefNum v -> ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0
        m (ANormal RefNum v -> ANormal RefNum v)
-> m (ANormal RefNum v) -> m (ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Word64
frsh
    TmTag
LetIndT -> do
      Word16
w <- m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16be
      [Mem]
ccs <- m [Mem]
forall (m :: * -> *). MonadGet m => m [Mem]
getCCs
      let l :: Int
l = [Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs
          frsh :: Word64
frsh = Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
          us :: [v]
us = Word64 -> v
forall v. Var v => Word64 -> v
getFresh (Word64 -> v) -> [Word64] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
l [Word64
frsh0 ..]
      Direction Word16
-> [v]
-> [Mem]
-> ANormal RefNum v
-> ANormal RefNum v
-> ANormal RefNum v
forall v ref.
Var v =>
Direction Word16
-> [v] -> [Mem] -> ANormal ref v -> ANormal ref v -> ANormal ref v
TLets (Word16 -> Direction Word16
forall a. a -> Direction a
Indirect Word16
w) [v]
us [Mem]
ccs
        (ANormal RefNum v -> ANormal RefNum v -> ANormal RefNum v)
-> m (ANormal RefNum v) -> m (ANormal RefNum v -> ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0
        m (ANormal RefNum v -> ANormal RefNum v)
-> m (ANormal RefNum v) -> m (ANormal RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Word64
frsh

putFunc ::
  (Var v) =>
  [v] ->
  Func RefNum v ->
  Builder
putFunc :: forall v. Var v => [v] -> Func RefNum v -> Builder
putFunc [v]
ctx Func RefNum v
f = case Func RefNum v
f of
  FVar v
v -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FVarT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
  FComb RefNum
r -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FCombT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RefNum -> Builder
putRefNum RefNum
r
  FCont v
v -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FContT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
  FCon RefNum
r CTag
c -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FConT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RefNum -> Builder
putRefNum RefNum
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CTag -> Builder
putCTag CTag
c
  FReq RefNum
r CTag
c -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FReqT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RefNum -> Builder
putRefNum RefNum
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CTag -> Builder
putCTag CTag
c
  FPrim (Left POp
p) -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FPrimT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> POp -> Builder
putPOp POp
p
  FPrim (Right ForeignFunc
f) -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FForeignT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ForeignFunc -> Builder
putFOp ForeignFunc
f

getFunc :: (MonadGet m, Var v) => [v] -> m (Func RefNum v)
getFunc :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> m (Func RefNum v)
getFunc [v]
ctx =
  m FnTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m FnTag -> (FnTag -> m (Func RefNum v)) -> m (Func RefNum v)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    FnTag
FVarT -> v -> Func RefNum v
forall ref v. v -> Func ref v
FVar (v -> Func RefNum v) -> m v -> m (Func RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
    FnTag
FCombT -> RefNum -> Func RefNum v
forall ref v. ref -> Func ref v
FComb (RefNum -> Func RefNum v) -> m RefNum -> m (Func RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RefNum
forall (m :: * -> *). MonadGet m => m RefNum
getRefNum
    FnTag
FContT -> v -> Func RefNum v
forall ref v. v -> Func ref v
FCont (v -> Func RefNum v) -> m v -> m (Func RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
    FnTag
FConT -> RefNum -> CTag -> Func RefNum v
forall ref v. ref -> CTag -> Func ref v
FCon (RefNum -> CTag -> Func RefNum v)
-> m RefNum -> m (CTag -> Func RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RefNum
forall (m :: * -> *). MonadGet m => m RefNum
getRefNum m (CTag -> Func RefNum v) -> m CTag -> m (Func RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m CTag
forall (m :: * -> *). MonadGet m => m CTag
getCTag
    FnTag
FReqT -> RefNum -> CTag -> Func RefNum v
forall ref v. ref -> CTag -> Func ref v
FReq (RefNum -> CTag -> Func RefNum v)
-> m RefNum -> m (CTag -> Func RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RefNum
forall (m :: * -> *). MonadGet m => m RefNum
getRefNum m (CTag -> Func RefNum v) -> m CTag -> m (Func RefNum v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m CTag
forall (m :: * -> *). MonadGet m => m CTag
getCTag
    FnTag
FPrimT -> Either POp ForeignFunc -> Func RefNum v
forall ref v. Either POp ForeignFunc -> Func ref v
FPrim (Either POp ForeignFunc -> Func RefNum v)
-> (POp -> Either POp ForeignFunc) -> POp -> Func RefNum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POp -> Either POp ForeignFunc
forall a b. a -> Either a b
Left (POp -> Func RefNum v) -> m POp -> m (Func RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m POp
forall (m :: * -> *). MonadGet m => m POp
getPOp
    FnTag
FForeignT -> Either POp ForeignFunc -> Func RefNum v
forall ref v. Either POp ForeignFunc -> Func ref v
FPrim (Either POp ForeignFunc -> Func RefNum v)
-> (ForeignFunc -> Either POp ForeignFunc)
-> ForeignFunc
-> Func RefNum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignFunc -> Either POp ForeignFunc
forall a b. b -> Either a b
Right (ForeignFunc -> Func RefNum v)
-> m ForeignFunc -> m (Func RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ForeignFunc
forall (m :: * -> *). MonadGet m => m ForeignFunc
getFOp

-- Note: this numbering is derived, and so not particularly stable.
-- However, foreign functions are not serialized for interchange. This
-- is for serializing optimization information for standalaone
-- programs.
putFOp :: ForeignFunc -> Builder
putFOp :: ForeignFunc -> Builder
putFOp = Int -> Builder
forall a.
(Integral a, Integral (Unsigned a), Bits (Unsigned a)) =>
a -> Builder
putVarInt (Int -> Builder) -> (ForeignFunc -> Int) -> ForeignFunc -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignFunc -> Int
forall a. Enum a => a -> Int
fromEnum

getFOp :: (MonadGet m) => m ForeignFunc
getFOp :: forall (m :: * -> *). MonadGet m => m ForeignFunc
getFOp = Int -> ForeignFunc
forall a. Enum a => Int -> a
toEnum (Int -> ForeignFunc) -> m Int -> m ForeignFunc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int
forall (m :: * -> *) b. (MonadGet m, Num b, Bits b) => m b
getVarInt

putPOp :: POp -> Builder
putPOp :: POp -> Builder
putPOp POp
op
  | Just Word16
w <- POp -> Map POp Word16 -> Maybe Word16
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup POp
op Map POp Word16
pop2word = Word16 -> Builder
BU.word16BE Word16
w
  | Bool
otherwise = [Word] -> [Char] -> Builder
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ [Char]
"putPOp: unknown POp: " [Char] -> [Char] -> [Char]
forall v. [v] -> [v] -> [v]
++ POp -> [Char]
forall a. Show a => a -> [Char]
show POp
op

getPOp :: (MonadGet m) => m POp
getPOp :: forall (m :: * -> *). MonadGet m => m POp
getPOp =
  m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16be m Word16 -> (Word16 -> m POp) -> m POp
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word16
w -> case Word16 -> Map Word16 POp -> Maybe POp
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word16
w Map Word16 POp
word2pop of
    Just POp
op -> POp -> m POp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure POp
op
    Maybe POp
Nothing -> [Word] -> [Char] -> m POp
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"getPOp: unknown enum code"

putLit :: Lit RefNum -> Builder
putLit :: Lit RefNum -> Builder
putLit = \case
  I Int64
i -> LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
IT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
putInt Int64
i
  N Word64
n -> LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
NT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
putNat Word64
n
  F Double
f -> LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
FT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
putFloat Double
f
  T Text
t -> LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
TT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
putText (Text -> Text
Util.Text.toText Text
t)
  C Char
c -> LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
CT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
putChar Char
c
  LM Referent' RefNum
r -> LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
LMT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Referent' RefNum -> Builder
putNumberedReferent Referent' RefNum
r
  LY RefNum
r -> LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
LYT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RefNum -> Builder
putRefNum RefNum
r

getLit :: (MonadGet m) => m (Lit RefNum)
getLit :: forall (m :: * -> *). MonadGet m => m (Lit RefNum)
getLit =
  m LtTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m LtTag -> (LtTag -> m (Lit RefNum)) -> m (Lit RefNum)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    LtTag
IT -> Int64 -> Lit RefNum
forall ref. Int64 -> Lit ref
I (Int64 -> Lit RefNum) -> m Int64 -> m (Lit RefNum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int64
forall (m :: * -> *). MonadGet m => m Int64
getInt
    LtTag
NT -> Word64 -> Lit RefNum
forall ref. Word64 -> Lit ref
N (Word64 -> Lit RefNum) -> m Word64 -> m (Lit RefNum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getNat
    LtTag
FT -> Double -> Lit RefNum
forall ref. Double -> Lit ref
F (Double -> Lit RefNum) -> m Double -> m (Lit RefNum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Double
forall (m :: * -> *). MonadGet m => m Double
getFloat
    LtTag
TT -> Text -> Lit RefNum
forall ref. Text -> Lit ref
T (Text -> Lit RefNum) -> (Text -> Text) -> Text -> Lit RefNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.fromText (Text -> Lit RefNum) -> m Text -> m (Lit RefNum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
forall (m :: * -> *). MonadGet m => m Text
getText
    LtTag
CT -> Char -> Lit RefNum
forall ref. Char -> Lit ref
C (Char -> Lit RefNum) -> m Char -> m (Lit RefNum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall (m :: * -> *). MonadGet m => m Char
getChar
    LtTag
LMT -> Referent' RefNum -> Lit RefNum
forall ref. Referent' ref -> Lit ref
LM (Referent' RefNum -> Lit RefNum)
-> m (Referent' RefNum) -> m (Lit RefNum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Referent' RefNum)
forall (m :: * -> *). MonadGet m => m (Referent' RefNum)
getNumberedReferent
    LtTag
LYT -> RefNum -> Lit RefNum
forall ref. ref -> Lit ref
LY (RefNum -> Lit RefNum) -> m RefNum -> m (Lit RefNum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RefNum
forall (m :: * -> *). MonadGet m => m RefNum
getRefNum

putBranches ::
  (Var v) =>
  Bool ->
  [v] ->
  Branched RefNum (ANormal RefNum v) ->
  Builder
putBranches :: forall v.
Var v =>
Bool -> [v] -> Branched RefNum (ANormal RefNum v) -> Builder
putBranches Bool
fops [v]
ctx Branched RefNum (ANormal RefNum v)
bs = case Branched RefNum (ANormal RefNum v)
bs of
  Branched RefNum (ANormal RefNum v)
MatchEmpty -> MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MEmptyT
  MatchIntegral EnumMap Word64 (ANormal RefNum v)
m Maybe (ANormal RefNum v)
df ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MIntT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Word64 -> Builder)
-> (ANormal RefNum v -> Builder)
-> EnumMap Word64 (ANormal RefNum v)
-> Builder
forall k v.
EnumKey k =>
(k -> Builder) -> (v -> Builder) -> EnumMap k v -> Builder
putEnumMap Word64 -> Builder
BU.word64BE (Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx) EnumMap Word64 (ANormal RefNum v)
m
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe (ANormal RefNum v)
-> (ANormal RefNum v -> Builder) -> Builder
forall a. Maybe a -> (a -> Builder) -> Builder
putMaybe Maybe (ANormal RefNum v)
df (Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx)
  MatchText Map Text (ANormal RefNum v)
m Maybe (ANormal RefNum v)
df ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MTextT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder)
-> (ANormal RefNum v -> Builder)
-> Map Text (ANormal RefNum v)
-> Builder
forall a b. (a -> Builder) -> (b -> Builder) -> Map a b -> Builder
putMap (Text -> Builder
putText (Text -> Builder) -> (Text -> Text) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.toText) (Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx) Map Text (ANormal RefNum v)
m
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe (ANormal RefNum v)
-> (ANormal RefNum v -> Builder) -> Builder
forall a. Maybe a -> (a -> Builder) -> Builder
putMaybe Maybe (ANormal RefNum v)
df (Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx)
  MatchRequest [(RefNum, EnumMap CTag ([Mem], ANormal RefNum v))]
m (TAbs v
v ANormal RefNum v
df) ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MReqT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (RefNum -> Builder)
-> (EnumMap CTag ([Mem], ANormal RefNum v) -> Builder)
-> [(RefNum, EnumMap CTag ([Mem], ANormal RefNum v))]
-> Builder
forall a b. (a -> Builder) -> (b -> Builder) -> [(a, b)] -> Builder
putMapping
        RefNum -> Builder
putRefNum
        ((CTag -> Builder)
-> (([Mem], ANormal RefNum v) -> Builder)
-> EnumMap CTag ([Mem], ANormal RefNum v)
-> Builder
forall k v.
EnumKey k =>
(k -> Builder) -> (v -> Builder) -> EnumMap k v -> Builder
putEnumMap CTag -> Builder
putCTag (Bool -> [v] -> ([Mem], ANormal RefNum v) -> Builder
forall v.
Var v =>
Bool -> [v] -> ([Mem], ANormal RefNum v) -> Builder
putCase Bool
fops [v]
ctx))
        [(RefNum, EnumMap CTag ([Mem], ANormal RefNum v))]
m
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal RefNum v
df
  MatchData RefNum
r EnumMap CTag ([Mem], ANormal RefNum v)
m Maybe (ANormal RefNum v)
df ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MDataT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RefNum -> Builder
putRefNum RefNum
r
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (CTag -> Builder)
-> (([Mem], ANormal RefNum v) -> Builder)
-> EnumMap CTag ([Mem], ANormal RefNum v)
-> Builder
forall k v.
EnumKey k =>
(k -> Builder) -> (v -> Builder) -> EnumMap k v -> Builder
putEnumMap CTag -> Builder
putCTag (Bool -> [v] -> ([Mem], ANormal RefNum v) -> Builder
forall v.
Var v =>
Bool -> [v] -> ([Mem], ANormal RefNum v) -> Builder
putCase Bool
fops [v]
ctx) EnumMap CTag ([Mem], ANormal RefNum v)
m
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe (ANormal RefNum v)
-> (ANormal RefNum v -> Builder) -> Builder
forall a. Maybe a -> (a -> Builder) -> Builder
putMaybe Maybe (ANormal RefNum v)
df (Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx)
  MatchSum EnumMap Word64 ([Mem], ANormal RefNum v)
m ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MSumT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Word64 -> Builder)
-> (([Mem], ANormal RefNum v) -> Builder)
-> EnumMap Word64 ([Mem], ANormal RefNum v)
-> Builder
forall k v.
EnumKey k =>
(k -> Builder) -> (v -> Builder) -> EnumMap k v -> Builder
putEnumMap Word64 -> Builder
BU.word64BE (Bool -> [v] -> ([Mem], ANormal RefNum v) -> Builder
forall v.
Var v =>
Bool -> [v] -> ([Mem], ANormal RefNum v) -> Builder
putCase Bool
fops [v]
ctx) EnumMap Word64 ([Mem], ANormal RefNum v)
m
  MatchNumeric RefNum
r EnumMap Word64 (ANormal RefNum v)
m Maybe (ANormal RefNum v)
df ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MNumT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RefNum -> Builder
putRefNum RefNum
r
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Word64 -> Builder)
-> (ANormal RefNum v -> Builder)
-> EnumMap Word64 (ANormal RefNum v)
-> Builder
forall k v.
EnumKey k =>
(k -> Builder) -> (v -> Builder) -> EnumMap k v -> Builder
putEnumMap Word64 -> Builder
BU.word64BE (Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx) EnumMap Word64 (ANormal RefNum v)
m
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe (ANormal RefNum v)
-> (ANormal RefNum v -> Builder) -> Builder
forall a. Maybe a -> (a -> Builder) -> Builder
putMaybe Maybe (ANormal RefNum v)
df (Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops [v]
ctx)
  Branched RefNum (ANormal RefNum v)
_ -> [Word] -> [Char] -> Builder
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"putBranches: malformed intermediate term"

getBranches ::
  (MonadGet m) =>
  (Var v) =>
  [v] ->
  Word64 ->
  m (Branched RefNum (ANormal RefNum v))
getBranches :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (Branched RefNum (ANormal RefNum v))
getBranches [v]
ctx Word64
frsh0 =
  m MtTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m MtTag
-> (MtTag -> m (Branched RefNum (ANormal RefNum v)))
-> m (Branched RefNum (ANormal RefNum v))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    MtTag
MEmptyT -> Branched RefNum (ANormal RefNum v)
-> m (Branched RefNum (ANormal RefNum v))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branched RefNum (ANormal RefNum v)
forall ref e. Branched ref e
MatchEmpty
    MtTag
MIntT ->
      EnumMap Word64 (ANormal RefNum v)
-> Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v)
forall ref e. EnumMap Word64 e -> Maybe e -> Branched ref e
MatchIntegral
        (EnumMap Word64 (ANormal RefNum v)
 -> Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v))
-> m (EnumMap Word64 (ANormal RefNum v))
-> m (Maybe (ANormal RefNum v)
      -> Branched RefNum (ANormal RefNum v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
-> m (ANormal RefNum v) -> m (EnumMap Word64 (ANormal RefNum v))
forall (m :: * -> *) k v.
(MonadGet m, EnumKey k) =>
m k -> m v -> m (EnumMap k v)
getEnumMap m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be ([v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0)
        m (Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v))
-> m (Maybe (ANormal RefNum v))
-> m (Branched RefNum (ANormal RefNum v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (ANormal RefNum v) -> m (Maybe (ANormal RefNum v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0)
    MtTag
MTextT ->
      Map Text (ANormal RefNum v)
-> Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v)
forall ref e. Map Text e -> Maybe e -> Branched ref e
MatchText
        (Map Text (ANormal RefNum v)
 -> Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v))
-> m (Map Text (ANormal RefNum v))
-> m (Maybe (ANormal RefNum v)
      -> Branched RefNum (ANormal RefNum v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text -> m (ANormal RefNum v) -> m (Map Text (ANormal RefNum v))
forall (m :: * -> *) a b.
(MonadGet m, Ord a) =>
m a -> m b -> m (Map a b)
getMap (Text -> Text
Util.Text.fromText (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
forall (m :: * -> *). MonadGet m => m Text
getText) ([v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0)
        m (Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v))
-> m (Maybe (ANormal RefNum v))
-> m (Branched RefNum (ANormal RefNum v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (ANormal RefNum v) -> m (Maybe (ANormal RefNum v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0)
    MtTag
MReqT ->
      [(RefNum, EnumMap CTag ([Mem], ANormal RefNum v))]
-> ANormal RefNum v -> Branched RefNum (ANormal RefNum v)
forall ref e.
[(ref, EnumMap CTag ([Mem], e))] -> e -> Branched ref e
MatchRequest
        ([(RefNum, EnumMap CTag ([Mem], ANormal RefNum v))]
 -> ANormal RefNum v -> Branched RefNum (ANormal RefNum v))
-> m [(RefNum, EnumMap CTag ([Mem], ANormal RefNum v))]
-> m (ANormal RefNum v -> Branched RefNum (ANormal RefNum v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RefNum
-> m (EnumMap CTag ([Mem], ANormal RefNum v))
-> m [(RefNum, EnumMap CTag ([Mem], ANormal RefNum v))]
forall (m :: * -> *) a b. MonadGet m => m a -> m b -> m [(a, b)]
getMapping
          m RefNum
forall (m :: * -> *). MonadGet m => m RefNum
getRefNum
          (m CTag
-> m ([Mem], ANormal RefNum v)
-> m (EnumMap CTag ([Mem], ANormal RefNum v))
forall (m :: * -> *) k v.
(MonadGet m, EnumKey k) =>
m k -> m v -> m (EnumMap k v)
getEnumMap m CTag
forall (m :: * -> *). MonadGet m => m CTag
getCTag ([v] -> Word64 -> m ([Mem], ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal RefNum v)
getCase [v]
ctx Word64
frsh0))
        m (ANormal RefNum v -> Branched RefNum (ANormal RefNum v))
-> m (ANormal RefNum v) -> m (Branched RefNum (ANormal RefNum v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (v -> ANormal RefNum v -> ANormal RefNum v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
v (ANormal RefNum v -> ANormal RefNum v)
-> m (ANormal RefNum v) -> m (ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) (Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1))
      where
        v :: v
v = Word64 -> v
forall v. Var v => Word64 -> v
getFresh Word64
frsh0
    MtTag
MDataT ->
      RefNum
-> EnumMap CTag ([Mem], ANormal RefNum v)
-> Maybe (ANormal RefNum v)
-> Branched RefNum (ANormal RefNum v)
forall ref e.
ref -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched ref e
MatchData
        (RefNum
 -> EnumMap CTag ([Mem], ANormal RefNum v)
 -> Maybe (ANormal RefNum v)
 -> Branched RefNum (ANormal RefNum v))
-> m RefNum
-> m (EnumMap CTag ([Mem], ANormal RefNum v)
      -> Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RefNum
forall (m :: * -> *). MonadGet m => m RefNum
getRefNum
        m (EnumMap CTag ([Mem], ANormal RefNum v)
   -> Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v))
-> m (EnumMap CTag ([Mem], ANormal RefNum v))
-> m (Maybe (ANormal RefNum v)
      -> Branched RefNum (ANormal RefNum v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m CTag
-> m ([Mem], ANormal RefNum v)
-> m (EnumMap CTag ([Mem], ANormal RefNum v))
forall (m :: * -> *) k v.
(MonadGet m, EnumKey k) =>
m k -> m v -> m (EnumMap k v)
getEnumMap m CTag
forall (m :: * -> *). MonadGet m => m CTag
getCTag ([v] -> Word64 -> m ([Mem], ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal RefNum v)
getCase [v]
ctx Word64
frsh0)
        m (Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v))
-> m (Maybe (ANormal RefNum v))
-> m (Branched RefNum (ANormal RefNum v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (ANormal RefNum v) -> m (Maybe (ANormal RefNum v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0)
    MtTag
MSumT -> EnumMap Word64 ([Mem], ANormal RefNum v)
-> Branched RefNum (ANormal RefNum v)
forall ref e. EnumMap Word64 ([Mem], e) -> Branched ref e
MatchSum (EnumMap Word64 ([Mem], ANormal RefNum v)
 -> Branched RefNum (ANormal RefNum v))
-> m (EnumMap Word64 ([Mem], ANormal RefNum v))
-> m (Branched RefNum (ANormal RefNum v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
-> m ([Mem], ANormal RefNum v)
-> m (EnumMap Word64 ([Mem], ANormal RefNum v))
forall (m :: * -> *) k v.
(MonadGet m, EnumKey k) =>
m k -> m v -> m (EnumMap k v)
getEnumMap m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be ([v] -> Word64 -> m ([Mem], ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal RefNum v)
getCase [v]
ctx Word64
frsh0)
    MtTag
MNumT ->
      RefNum
-> EnumMap Word64 (ANormal RefNum v)
-> Maybe (ANormal RefNum v)
-> Branched RefNum (ANormal RefNum v)
forall ref e. ref -> EnumMap Word64 e -> Maybe e -> Branched ref e
MatchNumeric
        (RefNum
 -> EnumMap Word64 (ANormal RefNum v)
 -> Maybe (ANormal RefNum v)
 -> Branched RefNum (ANormal RefNum v))
-> m RefNum
-> m (EnumMap Word64 (ANormal RefNum v)
      -> Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m RefNum
forall (m :: * -> *). MonadGet m => m RefNum
getRefNum
        m (EnumMap Word64 (ANormal RefNum v)
   -> Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v))
-> m (EnumMap Word64 (ANormal RefNum v))
-> m (Maybe (ANormal RefNum v)
      -> Branched RefNum (ANormal RefNum v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
-> m (ANormal RefNum v) -> m (EnumMap Word64 (ANormal RefNum v))
forall (m :: * -> *) k v.
(MonadGet m, EnumKey k) =>
m k -> m v -> m (EnumMap k v)
getEnumMap m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be ([v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0)
        m (Maybe (ANormal RefNum v) -> Branched RefNum (ANormal RefNum v))
-> m (Maybe (ANormal RefNum v))
-> m (Branched RefNum (ANormal RefNum v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (ANormal RefNum v) -> m (Maybe (ANormal RefNum v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal [v]
ctx Word64
frsh0)

putCase ::
  (Var v) =>
  Bool ->
  [v] ->
  ([Mem], ANormal RefNum v) ->
  Builder
putCase :: forall v.
Var v =>
Bool -> [v] -> ([Mem], ANormal RefNum v) -> Builder
putCase Bool
fops [v]
ctx ([Mem]
ccs, (TAbss [v]
us ANormal RefNum v
e)) =
  [Mem] -> Builder
putCCs [Mem]
ccs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [v] -> ANormal RefNum v -> Builder
forall v. Var v => Bool -> [v] -> ANormal RefNum v -> Builder
putNormal Bool
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal RefNum v
e

getCase ::
  (MonadGet m) =>
  (Var v) =>
  [v] ->
  Word64 ->
  m ([Mem], ANormal RefNum v)
getCase :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal RefNum v)
getCase [v]
ctx Word64
frsh0 = do
  [Mem]
ccs <- m [Mem]
forall (m :: * -> *). MonadGet m => m [Mem]
getCCs
  let l :: Int
l = [Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs
      frsh :: Word64
frsh = Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
      us :: [v]
us = Word64 -> v
forall v. Var v => Word64 -> v
getFresh (Word64 -> v) -> [Word64] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
l [Word64
frsh0 ..]
  (,) [Mem]
ccs (ANormal RefNum v -> ([Mem], ANormal RefNum v))
-> (ANormal RefNum v -> ANormal RefNum v)
-> ANormal RefNum v
-> ([Mem], ANormal RefNum v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal RefNum v -> ANormal RefNum v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v]
us (ANormal RefNum v -> ([Mem], ANormal RefNum v))
-> m (ANormal RefNum v) -> m ([Mem], ANormal RefNum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal RefNum v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal RefNum v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Word64
frsh

putCTag :: CTag -> Builder
putCTag :: CTag -> Builder
putCTag CTag
c = Int -> Builder
forall a.
(Integral a, Integral (Unsigned a), Bits (Unsigned a)) =>
a -> Builder
putVarInt (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ CTag -> Int
forall a. Enum a => a -> Int
fromEnum CTag
c

getCTag :: (MonadGet m) => m CTag
getCTag :: forall (m :: * -> *). MonadGet m => m CTag
getCTag = Int -> CTag
forall a. Enum a => Int -> a
toEnum (Int -> CTag) -> m Int -> m CTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int
forall (m :: * -> *) b. (MonadGet m, Num b, Bits b) => m b
getVarInt