module Unison.Runtime.ANF.Serialize.CodeV4 where

import Control.Monad
import Data.Binary.Get qualified as BGet
import Data.Binary.Put qualified as BPut
import Data.Bytes.Get hiding (getBytes)
import Data.Bytes.Put
import Data.Foldable (traverse_)
import Data.Functor ((<&>))
import Data.Map as Map (Map, fromList, lookup)
import Data.Serialize.Get qualified as SGet
import Data.Serialize.Put qualified as SPut
import Data.Word (Word16, 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.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] -> String -> v
forall a. HasCallStack => [Word] -> String -> a
exn [] String
"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 :: (MonadPut m) => Word64 -> m ()
putIndex :: forall (m :: * -> *). MonadPut m => Word64 -> m ()
putIndex = Word64 -> m ()
forall (m :: * -> *) a.
(MonadPut m, Integral a, Integral (Unsigned a),
 Bits (Unsigned a)) =>
a -> m ()
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 :: (MonadPut m) => (Eq v) => [v] -> v -> m ()
putVar :: forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
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 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putIndex Word64
i
  | Bool
otherwise = [Word] -> String -> m ()
forall a. HasCallStack => [Word] -> String -> a
exn [] String
"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 :: (MonadPut m) => (Eq v) => [v] -> [v] -> m ()
putArgs :: forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> [v] -> m ()
putArgs [v]
ctx [v]
is = (v -> m ()) -> [v] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable ([v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
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 :: (MonadPut m) => [Mem] -> m ()
putCCs :: forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs = Int -> m ()
forall (m :: * -> *) n.
(MonadPut m, Integral n, Integral (Unsigned n), Bits n,
 Bits (Unsigned n)) =>
n -> m ()
putLength Int
n m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Mem -> m ()) -> [Mem] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Mem -> m ()
forall {m :: * -> *}. MonadPut m => Mem -> m ()
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 -> m ()
putCC Mem
UN = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0
    putCC Mem
BX = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 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] -> String -> Mem
forall a. HasCallStack => [Word] -> String -> a
exn [] String
"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 ::
  (MonadPut m) =>
  (Var v) =>
  Bool ->
  SuperGroup RefNum v ->
  m ()
putGroup :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> SuperGroup RefNum v -> m ()
putGroup Bool
fops (Rec [(v, SuperNormal RefNum v)]
bs SuperNormal RefNum v
e) =
  Int -> m ()
forall (m :: * -> *) n.
(MonadPut m, Integral n, Integral (Unsigned n), Bits n,
 Bits (Unsigned n)) =>
n -> m ()
putLength Int
n
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SuperNormal RefNum v -> m ()) -> [SuperNormal RefNum v] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool -> [v] -> SuperNormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> SuperNormal RefNum v -> m ()
putComb Bool
fops [v]
ctx) [SuperNormal RefNum v]
cs
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> SuperNormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> SuperNormal RefNum v -> m ()
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 :: (MonadPut m) => Bool -> (Code RefNum) -> m ()
putCode :: forall (m :: * -> *). MonadPut m => Bool -> Code RefNum -> m ()
putCode Bool
fops (CodeRep SuperGroup RefNum Symbol
g Cacheability
c) =
  Bool -> SuperGroup RefNum Symbol -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> SuperGroup RefNum v -> m ()
putGroup Bool
fops SuperGroup RefNum Symbol
g m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Cacheability -> m ()
forall (m :: * -> *). MonadPut m => Cacheability -> m ()
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 ::
  (MonadPut m) => [Reference] -> [Reference] -> Bool -> Code RefNum -> m ()
putCodeWithHeader :: forall (m :: * -> *).
MonadPut m =>
[Reference] -> [Reference] -> Bool -> Code RefNum -> m ()
putCodeWithHeader [Reference]
tyrs [Reference]
tmrs Bool
fops Code RefNum
co =
  (Reference -> m ()) -> [Reference] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference [Reference]
tyrs
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Reference -> m ()) -> [Reference] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference [Reference]
tmrs
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Code RefNum -> m ()
forall (m :: * -> *). MonadPut m => Bool -> Code RefNum -> m ()
putCode Bool
fops Code RefNum
co
{-# SPECIALIZE putCodeWithHeader ::
  [Reference] -> [Reference] -> Bool -> Code RefNum -> BPut.Put
  #-}
{-# SPECIALIZE putCodeWithHeader ::
  [Reference] -> [Reference] -> Bool -> Code RefNum -> SPut.Put
  #-}

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 :: (MonadPut m) => Cacheability -> m ()
putCacheability :: forall (m :: * -> *). MonadPut m => Cacheability -> m ()
putCacheability Cacheability
Uncacheable = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0
putCacheability Cacheability
Cacheable = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 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] -> String -> m Cacheability
forall a. HasCallStack => [Word] -> String -> a
exn [] (String -> m Cacheability) -> String -> m Cacheability
forall a b. (a -> b) -> a -> b
$ String
"getBLit: unrecognized cacheability byte: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n

putComb ::
  (MonadPut m) =>
  (Var v) =>
  Bool ->
  [v] ->
  SuperNormal RefNum v ->
  m ()
putComb :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> SuperNormal RefNum v -> m ()
putComb Bool
fops [v]
ctx (Lambda [Mem]
ccs (TAbss [v]
us Term (ANormalF RefNum) v
e)) =
  [Mem] -> m ()
forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> Term (ANormalF RefNum) v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
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 ::
  (MonadPut m) =>
  (Var v) =>
  Bool ->
  [v] ->
  ANormal RefNum v ->
  m ()
putNormal :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx ANormal RefNum v
tm = case ANormal RefNum v
tm of
  TVar v
v -> TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
VarT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
  TFrc v
v -> TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
ForceT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
  TApp Func RefNum v
f [v]
as -> TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
AppT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> Func RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
[v] -> Func RefNum v -> m ()
putFunc [v]
ctx Func RefNum v
f m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> [v] -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> [v] -> m ()
putArgs [v]
ctx [v]
as
  THnd [RefNum]
rs v
nh Maybe v
_ah ANormal RefNum v
e ->
    TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
HandleT
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (RefNum -> m ()) -> [RefNum] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable RefNum -> m ()
forall (m :: * -> *). MonadPut m => RefNum -> m ()
putRefNum [RefNum]
rs
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
nh
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx ANormal RefNum v
e
  TShift RefNum
r v
v ANormal RefNum v
e ->
    TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
ShiftT
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RefNum -> m ()
forall (m :: * -> *). MonadPut m => RefNum -> m ()
putRefNum RefNum
r
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
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 -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
MatchT
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> Branched RefNum (ANormal RefNum v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> Branched RefNum (ANormal RefNum v) -> m ()
putBranches Bool
fops [v]
ctx Branched RefNum (ANormal RefNum v)
bs
  TLit Lit RefNum
l -> TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
LitT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lit RefNum -> m ()
forall (m :: * -> *). MonadPut m => Lit RefNum -> m ()
putLit Lit RefNum
l
  TBLit Lit RefNum
l -> TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
BxLitT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lit RefNum -> m ()
forall (m :: * -> *). MonadPut m => Lit RefNum -> m ()
putLit Lit RefNum
l
  TName v
v (Left RefNum
r) [v]
as ANormal RefNum v
e ->
    TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
NameRefT
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RefNum -> m ()
forall (m :: * -> *). MonadPut m => RefNum -> m ()
putRefNum RefNum
r
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> [v] -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> [v] -> m ()
putArgs [v]
ctx [v]
as
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
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 -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
NameVarT
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
u
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> [v] -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> [v] -> m ()
putArgs [v]
ctx [v]
as
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
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 -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
LetDirT
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Mem] -> m ()
forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx ANormal RefNum v
l
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
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 -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
LetIndT
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16be Word16
w
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Mem] -> m ()
forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx ANormal RefNum v
l
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
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] -> String -> m ()
forall a. HasCallStack => [Word] -> String -> a
exn [] (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"putNormal: malformed term\n" String -> String -> String
forall v. [v] -> [v] -> [v]
++ ANormal RefNum v -> String
forall a. Show a => a -> String
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 ::
  (MonadPut m) =>
  (Var v) =>
  [v] ->
  Func RefNum v ->
  m ()
putFunc :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
[v] -> Func RefNum v -> m ()
putFunc [v]
ctx Func RefNum v
f = case Func RefNum v
f of
  FVar v
v -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FVarT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
  FComb RefNum
r -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FCombT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RefNum -> m ()
forall (m :: * -> *). MonadPut m => RefNum -> m ()
putRefNum RefNum
r
  FCont v
v -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FContT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
  FCon RefNum
r CTag
c -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FConT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RefNum -> m ()
forall (m :: * -> *). MonadPut m => RefNum -> m ()
putRefNum RefNum
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CTag -> m ()
forall (m :: * -> *). MonadPut m => CTag -> m ()
putCTag CTag
c
  FReq RefNum
r CTag
c -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FReqT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RefNum -> m ()
forall (m :: * -> *). MonadPut m => RefNum -> m ()
putRefNum RefNum
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CTag -> m ()
forall (m :: * -> *). MonadPut m => CTag -> m ()
putCTag CTag
c
  FPrim (Left POp
p) -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FPrimT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> POp -> m ()
forall (m :: * -> *). MonadPut m => POp -> m ()
putPOp POp
p
  FPrim (Right ForeignFunc
f) -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FForeignT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ForeignFunc -> m ()
forall (m :: * -> *). MonadPut m => ForeignFunc -> m ()
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 :: (MonadPut m) => ForeignFunc -> m ()
putFOp :: forall (m :: * -> *). MonadPut m => ForeignFunc -> m ()
putFOp = Int -> m ()
forall (m :: * -> *) a.
(MonadPut m, Integral a, Integral (Unsigned a),
 Bits (Unsigned a)) =>
a -> m ()
putVarInt (Int -> m ()) -> (ForeignFunc -> Int) -> ForeignFunc -> m ()
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 :: (MonadPut m) => POp -> m ()
putPOp :: forall (m :: * -> *). MonadPut m => POp -> m ()
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 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16be Word16
w
  | Bool
otherwise = [Word] -> String -> m ()
forall a. HasCallStack => [Word] -> String -> a
exn [] (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"putPOp: unknown POp: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ POp -> String
forall a. Show a => a -> String
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] -> String -> m POp
forall a. HasCallStack => [Word] -> String -> a
exn [] String
"getPOp: unknown enum code"

pOpCode :: POp -> Word16
pOpCode :: POp -> Word16
pOpCode POp
op = case POp
op of
  POp
ADDI -> Word16
0
  POp
SUBI -> Word16
1
  POp
MULI -> Word16
2
  POp
DIVI -> Word16
3
  POp
SGNI -> Word16
4
  POp
NEGI -> Word16
5
  POp
MODI -> Word16
6
  POp
POWI -> Word16
7
  POp
SHLI -> Word16
8
  POp
SHRI -> Word16
9
  POp
INCI -> Word16
10
  POp
DECI -> Word16
11
  POp
LEQI -> Word16
12
  POp
EQLI -> Word16
13
  POp
ADDN -> Word16
14
  POp
SUBN -> Word16
15
  POp
MULN -> Word16
16
  POp
DIVN -> Word16
17
  POp
MODN -> Word16
18
  POp
TZRO -> Word16
19
  POp
LZRO -> Word16
20
  POp
POWN -> Word16
21
  POp
SHLN -> Word16
22
  POp
SHRN -> Word16
23
  POp
ANDN -> Word16
24
  POp
IORN -> Word16
25
  POp
XORN -> Word16
26
  POp
COMN -> Word16
27
  POp
INCN -> Word16
28
  POp
DECN -> Word16
29
  POp
LEQN -> Word16
30
  POp
EQLN -> Word16
31
  POp
ADDF -> Word16
32
  POp
SUBF -> Word16
33
  POp
MULF -> Word16
34
  POp
DIVF -> Word16
35
  POp
MINF -> Word16
36
  POp
MAXF -> Word16
37
  POp
LEQF -> Word16
38
  POp
EQLF -> Word16
39
  POp
POWF -> Word16
40
  POp
EXPF -> Word16
41
  POp
SQRT -> Word16
42
  POp
LOGF -> Word16
43
  POp
LOGB -> Word16
44
  POp
ABSF -> Word16
45
  POp
CEIL -> Word16
46
  POp
FLOR -> Word16
47
  POp
TRNF -> Word16
48
  POp
RNDF -> Word16
49
  POp
COSF -> Word16
50
  POp
ACOS -> Word16
51
  POp
COSH -> Word16
52
  POp
ACSH -> Word16
53
  POp
SINF -> Word16
54
  POp
ASIN -> Word16
55
  POp
SINH -> Word16
56
  POp
ASNH -> Word16
57
  POp
TANF -> Word16
58
  POp
ATAN -> Word16
59
  POp
TANH -> Word16
60
  POp
ATNH -> Word16
61
  POp
ATN2 -> Word16
62
  POp
CATT -> Word16
63
  POp
TAKT -> Word16
64
  POp
DRPT -> Word16
65
  POp
SIZT -> Word16
66
  POp
UCNS -> Word16
67
  POp
USNC -> Word16
68
  POp
EQLT -> Word16
69
  POp
LEQT -> Word16
70
  POp
PAKT -> Word16
71
  POp
UPKT -> Word16
72
  POp
CATS -> Word16
73
  POp
TAKS -> Word16
74
  POp
DRPS -> Word16
75
  POp
SIZS -> Word16
76
  POp
CONS -> Word16
77
  POp
SNOC -> Word16
78
  POp
IDXS -> Word16
79
  POp
BLDS -> Word16
80
  POp
VWLS -> Word16
81
  POp
VWRS -> Word16
82
  POp
SPLL -> Word16
83
  POp
SPLR -> Word16
84
  POp
PAKB -> Word16
85
  POp
UPKB -> Word16
86
  POp
TAKB -> Word16
87
  POp
DRPB -> Word16
88
  POp
IDXB -> Word16
89
  POp
SIZB -> Word16
90
  POp
FLTB -> Word16
91
  POp
CATB -> Word16
92
  POp
ITOF -> Word16
93
  POp
NTOF -> Word16
94
  POp
ITOT -> Word16
95
  POp
NTOT -> Word16
96
  POp
TTOI -> Word16
97
  POp
TTON -> Word16
98
  POp
TTOF -> Word16
99
  POp
FTOT -> Word16
100
  POp
FORK -> Word16
101
  POp
EQLU -> Word16
102
  POp
CMPU -> Word16
103
  POp
EROR -> Word16
104
  POp
PRNT -> Word16
105
  POp
INFO -> Word16
106
  POp
POPC -> Word16
107
  POp
MISS -> Word16
108
  POp
CACH -> Word16
109
  POp
LKUP -> Word16
110
  POp
LOAD -> Word16
111
  POp
CVLD -> Word16
112
  POp
SDBX -> Word16
113
  POp
VALU -> Word16
114
  POp
TLTT -> Word16
115
  POp
TRCE -> Word16
116
  POp
ATOM -> Word16
117
  POp
TFRC -> Word16
118
  POp
DBTX -> Word16
119
  POp
IXOT -> Word16
120
  POp
IXOB -> Word16
121
  POp
SDBL -> Word16
122
  POp
SDBV -> Word16
123
  POp
CAST -> Word16
124
  POp
ANDI -> Word16
125
  POp
IORI -> Word16
126
  POp
XORI -> Word16
127
  POp
COMI -> Word16
128
  POp
DRPN -> Word16
129
  POp
TRNC -> Word16
130
  POp
REFN -> Word16
131
  POp
REFR -> Word16
132
  POp
REFW -> Word16
133
  POp
RCAS -> Word16
134
  POp
RRFC -> Word16
135
  POp
TIKR -> Word16
136
  POp
LESI -> Word16
137
  POp
NEQI -> Word16
138
  POp
LESN -> Word16
139
  POp
NEQN -> Word16
140
  POp
LESF -> Word16
141
  POp
NEQF -> Word16
142
  POp
LEQU -> Word16
143
  POp
LESU -> Word16
144
  POp
NOTB -> Word16
145
  POp
ANDB -> Word16
146
  POp
IORB -> Word16
147

pOpAssoc :: [(POp, Word16)]
pOpAssoc :: [(POp, Word16)]
pOpAssoc = (POp -> (POp, Word16)) -> [POp] -> [(POp, Word16)]
forall a b. (a -> b) -> [a] -> [b]
map (\POp
op -> (POp
op, POp -> Word16
pOpCode POp
op)) [POp
forall a. Bounded a => a
minBound .. POp
forall a. Bounded a => a
maxBound]

pop2word :: Map POp Word16
pop2word :: Map POp Word16
pop2word = [(POp, Word16)] -> Map POp Word16
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(POp, Word16)]
pOpAssoc

word2pop :: Map Word16 POp
word2pop :: Map Word16 POp
word2pop = [(Word16, POp)] -> Map Word16 POp
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Word16, POp)] -> Map Word16 POp)
-> [(Word16, POp)] -> Map Word16 POp
forall a b. (a -> b) -> a -> b
$ (POp, Word16) -> (Word16, POp)
forall {b} {a}. (b, a) -> (a, b)
swap ((POp, Word16) -> (Word16, POp))
-> [(POp, Word16)] -> [(Word16, POp)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(POp, Word16)]
pOpAssoc
  where
    swap :: (b, a) -> (a, b)
swap (b
x, a
y) = (a
y, b
x)

putLit :: (MonadPut m) => Lit RefNum -> m ()
putLit :: forall (m :: * -> *). MonadPut m => Lit RefNum -> m ()
putLit = \case
  I Int64
i -> LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
IT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int64 -> m ()
forall (m :: * -> *). MonadPut m => Int64 -> m ()
putInt Int64
i
  N Word64
n -> LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
NT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putNat Word64
n
  F Double
f -> LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
FT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Double -> m ()
forall (m :: * -> *). MonadPut m => Double -> m ()
putFloat Double
f
  T Text
t -> LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
TT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> m ()
forall (m :: * -> *). MonadPut m => Text -> m ()
putText (Text -> Text
Util.Text.toText Text
t)
  C Char
c -> LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
CT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> m ()
forall (m :: * -> *). MonadPut m => Char -> m ()
putChar Char
c
  LM Referent' RefNum
r -> LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
LMT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Referent' RefNum -> m ()
forall (m :: * -> *). MonadPut m => Referent' RefNum -> m ()
putNumberedReferent Referent' RefNum
r
  LY RefNum
r -> LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
LYT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RefNum -> m ()
forall (m :: * -> *). MonadPut m => RefNum -> m ()
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 ::
  (MonadPut m) =>
  (Var v) =>
  Bool ->
  [v] ->
  Branched RefNum (ANormal RefNum v) ->
  m ()
putBranches :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> Branched RefNum (ANormal RefNum v) -> m ()
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 -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MEmptyT
  MatchIntegral EnumMap Word64 (ANormal RefNum v)
m Maybe (ANormal RefNum v)
df -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MIntT
    (Word64 -> m ())
-> (ANormal RefNum v -> m ())
-> EnumMap Word64 (ANormal RefNum v)
-> m ()
forall (m :: * -> *) k v.
(MonadPut m, EnumKey k) =>
(k -> m ()) -> (v -> m ()) -> EnumMap k v -> m ()
putEnumMap Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx) EnumMap Word64 (ANormal RefNum v)
m
    Maybe (ANormal RefNum v) -> (ANormal RefNum v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal RefNum v)
df ((ANormal RefNum v -> m ()) -> m ())
-> (ANormal RefNum v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx
  MatchText Map Text (ANormal RefNum v)
m Maybe (ANormal RefNum v)
df -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MTextT
    (Text -> m ())
-> (ANormal RefNum v -> m ())
-> Map Text (ANormal RefNum v)
-> m ()
forall (m :: * -> *) a b.
MonadPut m =>
(a -> m ()) -> (b -> m ()) -> Map a b -> m ()
putMap (Text -> m ()
forall (m :: * -> *). MonadPut m => Text -> m ()
putText (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.toText) (Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx) Map Text (ANormal RefNum v)
m
    Maybe (ANormal RefNum v) -> (ANormal RefNum v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal RefNum v)
df ((ANormal RefNum v -> m ()) -> m ())
-> (ANormal RefNum v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx
  MatchRequest [(RefNum, EnumMap CTag ([Mem], ANormal RefNum v))]
m (TAbs v
v ANormal RefNum v
df) -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MReqT
    (RefNum -> m ())
-> (EnumMap CTag ([Mem], ANormal RefNum v) -> m ())
-> [(RefNum, EnumMap CTag ([Mem], ANormal RefNum v))]
-> m ()
forall (m :: * -> *) a b.
MonadPut m =>
(a -> m ()) -> (b -> m ()) -> [(a, b)] -> m ()
putMapping
      RefNum -> m ()
forall (m :: * -> *). MonadPut m => RefNum -> m ()
putRefNum
      ((CTag -> m ())
-> (([Mem], ANormal RefNum v) -> m ())
-> EnumMap CTag ([Mem], ANormal RefNum v)
-> m ()
forall (m :: * -> *) k v.
(MonadPut m, EnumKey k) =>
(k -> m ()) -> (v -> m ()) -> EnumMap k v -> m ()
putEnumMap CTag -> m ()
forall (m :: * -> *). MonadPut m => CTag -> m ()
putCTag (Bool -> [v] -> ([Mem], ANormal RefNum v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ([Mem], ANormal RefNum v) -> m ()
putCase Bool
fops [v]
ctx))
      [(RefNum, EnumMap CTag ([Mem], ANormal RefNum v))]
m
    Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
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 -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MDataT
    RefNum -> m ()
forall (m :: * -> *). MonadPut m => RefNum -> m ()
putRefNum RefNum
r
    (CTag -> m ())
-> (([Mem], ANormal RefNum v) -> m ())
-> EnumMap CTag ([Mem], ANormal RefNum v)
-> m ()
forall (m :: * -> *) k v.
(MonadPut m, EnumKey k) =>
(k -> m ()) -> (v -> m ()) -> EnumMap k v -> m ()
putEnumMap CTag -> m ()
forall (m :: * -> *). MonadPut m => CTag -> m ()
putCTag (Bool -> [v] -> ([Mem], ANormal RefNum v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ([Mem], ANormal RefNum v) -> m ()
putCase Bool
fops [v]
ctx) EnumMap CTag ([Mem], ANormal RefNum v)
m
    Maybe (ANormal RefNum v) -> (ANormal RefNum v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal RefNum v)
df ((ANormal RefNum v -> m ()) -> m ())
-> (ANormal RefNum v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx
  MatchSum EnumMap Word64 ([Mem], ANormal RefNum v)
m -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MSumT
    (Word64 -> m ())
-> (([Mem], ANormal RefNum v) -> m ())
-> EnumMap Word64 ([Mem], ANormal RefNum v)
-> m ()
forall (m :: * -> *) k v.
(MonadPut m, EnumKey k) =>
(k -> m ()) -> (v -> m ()) -> EnumMap k v -> m ()
putEnumMap Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Bool -> [v] -> ([Mem], ANormal RefNum v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ([Mem], ANormal RefNum v) -> m ()
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 -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MNumT
    RefNum -> m ()
forall (m :: * -> *). MonadPut m => RefNum -> m ()
putRefNum RefNum
r
    (Word64 -> m ())
-> (ANormal RefNum v -> m ())
-> EnumMap Word64 (ANormal RefNum v)
-> m ()
forall (m :: * -> *) k v.
(MonadPut m, EnumKey k) =>
(k -> m ()) -> (v -> m ()) -> EnumMap k v -> m ()
putEnumMap Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx) EnumMap Word64 (ANormal RefNum v)
m
    Maybe (ANormal RefNum v) -> (ANormal RefNum v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal RefNum v)
df ((ANormal RefNum v -> m ()) -> m ())
-> (ANormal RefNum v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
putNormal Bool
fops [v]
ctx
  Branched RefNum (ANormal RefNum v)
_ -> [Word] -> String -> m ()
forall a. HasCallStack => [Word] -> String -> a
exn [] String
"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 ::
  (MonadPut m) =>
  (Var v) =>
  Bool ->
  [v] ->
  ([Mem], ANormal RefNum v) ->
  m ()
putCase :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ([Mem], ANormal RefNum v) -> m ()
putCase Bool
fops [v]
ctx ([Mem]
ccs, (TAbss [v]
us ANormal RefNum v
e)) =
  [Mem] -> m ()
forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> [v] -> ANormal RefNum v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Bool -> [v] -> ANormal RefNum v -> m ()
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 :: (MonadPut m) => CTag -> m ()
putCTag :: forall (m :: * -> *). MonadPut m => CTag -> m ()
putCTag CTag
c = Int -> m ()
forall (m :: * -> *) a.
(MonadPut m, Integral a, Integral (Unsigned a),
 Bits (Unsigned a)) =>
a -> m ()
putVarInt (Int -> m ()) -> Int -> m ()
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