{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}

module Unison.Runtime.ANF.Serialize where

import Control.Monad
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as L
import Data.Bytes.Get hiding (getBytes)
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Bytes.VarInt
import Data.Foldable (traverse_)
import Data.Functor ((<&>))
import Data.Map as Map (Map, fromList, lookup)
import Data.Maybe (mapMaybe)
import Data.Sequence qualified as Seq
import Data.Serialize.Put (runPutLazy)
import Data.Text (Text)
import Data.Word (Word16, Word32, Word64)
import GHC.IsList qualified (fromList)
import GHC.Stack
import Unison.ABT.Normalized (Term (..))
import Unison.Reference (Reference, Reference' (Builtin), pattern Derived)
import Unison.Runtime.ANF as ANF hiding (Tag)
import Unison.Runtime.Exception
import Unison.Runtime.Serialize
import Unison.Util.EnumContainers qualified as EC
import Unison.Util.Text qualified as Util.Text
import Unison.Var (Type (ANFBlank), Var (..))
import Prelude hiding (getChar, putChar)

type Version = Word32

data TmTag
  = VarT
  | ForceT
  | AppT
  | HandleT
  | ShiftT
  | MatchT
  | LitT
  | NameRefT
  | NameVarT
  | LetDirT
  | LetIndT
  | BxLitT

data FnTag
  = FVarT
  | FCombT
  | FContT
  | FConT
  | FReqT
  | FPrimT
  | FForeignT

data MtTag
  = MIntT
  | MTextT
  | MReqT
  | MEmptyT
  | MDataT
  | MSumT
  | MNumT

data LtTag
  = IT
  | NT
  | FT
  | TT
  | CT
  | LMT
  | LYT

data BLTag
  = TextT
  | ListT
  | TmLinkT
  | TyLinkT
  | BytesT
  | QuoteT
  | CodeT
  | BArrT
  | PosT
  | NegT
  | CharT
  | FloatT
  | ArrT

data VaTag = PartialT | DataT | ContT | BLitT

data CoTag = KET | MarkT | PushT

instance Tag TmTag where
  tag2word :: TmTag -> Word8
tag2word = \case
    TmTag
VarT -> Word8
1
    TmTag
ForceT -> Word8
2
    TmTag
AppT -> Word8
3
    TmTag
HandleT -> Word8
4
    TmTag
ShiftT -> Word8
5
    TmTag
MatchT -> Word8
6
    TmTag
LitT -> Word8
7
    TmTag
NameRefT -> Word8
8
    TmTag
NameVarT -> Word8
9
    TmTag
LetDirT -> Word8
10
    TmTag
LetIndT -> Word8
11
    TmTag
BxLitT -> Word8
12
  word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m TmTag
word2tag = \case
    Word8
1 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
VarT
    Word8
2 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
ForceT
    Word8
3 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
AppT
    Word8
4 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
HandleT
    Word8
5 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
ShiftT
    Word8
6 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
MatchT
    Word8
7 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
LitT
    Word8
8 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
NameRefT
    Word8
9 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
NameVarT
    Word8
10 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
LetDirT
    Word8
11 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
LetIndT
    Word8
12 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
BxLitT
    Word8
n -> String -> Word8 -> m TmTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"TmTag" Word8
n

instance Tag FnTag where
  tag2word :: FnTag -> Word8
tag2word = \case
    FnTag
FVarT -> Word8
0
    FnTag
FCombT -> Word8
1
    FnTag
FContT -> Word8
2
    FnTag
FConT -> Word8
3
    FnTag
FReqT -> Word8
4
    FnTag
FPrimT -> Word8
5
    FnTag
FForeignT -> Word8
6

  word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m FnTag
word2tag = \case
    Word8
0 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FVarT
    Word8
1 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FCombT
    Word8
2 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FContT
    Word8
3 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FConT
    Word8
4 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FReqT
    Word8
5 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FPrimT
    Word8
6 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FForeignT
    Word8
n -> String -> Word8 -> m FnTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"FnTag" Word8
n

instance Tag MtTag where
  tag2word :: MtTag -> Word8
tag2word = \case
    MtTag
MIntT -> Word8
0
    MtTag
MTextT -> Word8
1
    MtTag
MReqT -> Word8
2
    MtTag
MEmptyT -> Word8
3
    MtTag
MDataT -> Word8
4
    MtTag
MSumT -> Word8
5
    MtTag
MNumT -> Word8
6

  word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m MtTag
word2tag = \case
    Word8
0 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MIntT
    Word8
1 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MTextT
    Word8
2 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MReqT
    Word8
3 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MEmptyT
    Word8
4 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MDataT
    Word8
5 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MSumT
    Word8
6 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MNumT
    Word8
n -> String -> Word8 -> m MtTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"MtTag" Word8
n

instance Tag LtTag where
  tag2word :: LtTag -> Word8
tag2word = \case
    LtTag
IT -> Word8
0
    LtTag
NT -> Word8
1
    LtTag
FT -> Word8
2
    LtTag
TT -> Word8
3
    LtTag
CT -> Word8
4
    LtTag
LMT -> Word8
5
    LtTag
LYT -> Word8
6

  word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m LtTag
word2tag = \case
    Word8
0 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
IT
    Word8
1 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
NT
    Word8
2 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
FT
    Word8
3 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
TT
    Word8
4 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
CT
    Word8
5 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
LMT
    Word8
6 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
LYT
    Word8
n -> String -> Word8 -> m LtTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"LtTag" Word8
n

instance Tag BLTag where
  tag2word :: BLTag -> Word8
tag2word = \case
    BLTag
TextT -> Word8
0
    BLTag
ListT -> Word8
1
    BLTag
TmLinkT -> Word8
2
    BLTag
TyLinkT -> Word8
3
    BLTag
BytesT -> Word8
4
    BLTag
QuoteT -> Word8
5
    BLTag
CodeT -> Word8
6
    BLTag
BArrT -> Word8
7
    BLTag
PosT -> Word8
8
    BLTag
NegT -> Word8
9
    BLTag
CharT -> Word8
10
    BLTag
FloatT -> Word8
11
    BLTag
ArrT -> Word8
12

  word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m BLTag
word2tag = \case
    Word8
0 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
TextT
    Word8
1 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
ListT
    Word8
2 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
TmLinkT
    Word8
3 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
TyLinkT
    Word8
4 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
BytesT
    Word8
5 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
QuoteT
    Word8
6 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
CodeT
    Word8
7 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
BArrT
    Word8
8 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
PosT
    Word8
9 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
NegT
    Word8
10 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
CharT
    Word8
11 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
FloatT
    Word8
12 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
ArrT
    Word8
t -> String -> Word8 -> m BLTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"BLTag" Word8
t

instance Tag VaTag where
  tag2word :: VaTag -> Word8
tag2word = \case
    VaTag
PartialT -> Word8
0
    VaTag
DataT -> Word8
1
    VaTag
ContT -> Word8
2
    VaTag
BLitT -> Word8
3

  word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m VaTag
word2tag = \case
    Word8
0 -> VaTag -> m VaTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VaTag
PartialT
    Word8
1 -> VaTag -> m VaTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VaTag
DataT
    Word8
2 -> VaTag -> m VaTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VaTag
ContT
    Word8
3 -> VaTag -> m VaTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VaTag
BLitT
    Word8
t -> String -> Word8 -> m VaTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"VaTag" Word8
t

instance Tag CoTag where
  tag2word :: CoTag -> Word8
tag2word = \case
    CoTag
KET -> Word8
0
    CoTag
MarkT -> Word8
1
    CoTag
PushT -> Word8
2
  word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m CoTag
word2tag = \case
    Word8
0 -> CoTag -> m CoTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoTag
KET
    Word8
1 -> CoTag -> m CoTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoTag
MarkT
    Word8
2 -> CoTag -> m CoTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoTag
PushT
    Word8
t -> String -> Word8 -> m CoTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"CoTag" Word8
t

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
_ = String -> v
forall a. HasCallStack => 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)

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

putIndex :: (MonadPut m) => Word64 -> m ()
putIndex :: forall (m :: * -> *). MonadPut m => Word64 -> m ()
putIndex = VarInt Word64 -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => VarInt Word64 -> m ()
serialize (VarInt Word64 -> m ())
-> (Word64 -> VarInt Word64) -> Word64 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> VarInt Word64
forall n. n -> VarInt n
VarInt

getIndex :: (MonadGet m) => m Word64
getIndex :: forall (m :: * -> *). MonadGet m => m Word64
getIndex = VarInt Word64 -> Word64
forall n. VarInt n -> n
unVarInt (VarInt Word64 -> Word64) -> m (VarInt Word64) -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (VarInt Word64)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (VarInt Word64)
deserialize

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 = String -> m ()
forall a. HasCallStack => 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
_ -> String -> Mem
forall a. HasCallStack => 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) =>
  Map Reference Word64 ->
  EC.EnumMap FOp Text ->
  SuperGroup v ->
  m ()
putGroup :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
refrep EnumMap Word64 Text
fops (Rec [(v, SuperNormal v)]
bs SuperNormal 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 v -> m ()) -> [SuperNormal v] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> SuperNormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> SuperNormal v -> m ()
putComb Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) [SuperNormal 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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> SuperNormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> SuperNormal v -> m ()
putComb Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx SuperNormal 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 v]
cs) = [(v, SuperNormal v)] -> ([v], [SuperNormal v])
forall a b. [(a, b)] -> ([a], [b])
unzip [(v, SuperNormal v)]
bs
    ctx :: [v]
ctx = [v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us []

getGroup :: (MonadGet m) => (Var v) => m (SuperGroup v)
getGroup :: forall (m :: * -> *) v. (MonadGet m, Var v) => m (SuperGroup 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 v]
cs <- Int -> m (SuperNormal v) -> m [SuperNormal v]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
l ([v] -> Word64 -> m (SuperNormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (SuperNormal v)
getComb [v]
ctx Word64
n)
  [(v, SuperNormal v)] -> SuperNormal v -> SuperGroup v
forall v. [(v, SuperNormal v)] -> SuperNormal v -> SuperGroup v
Rec ([v] -> [SuperNormal v] -> [(v, SuperNormal v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs [SuperNormal v]
cs) (SuperNormal v -> SuperGroup v)
-> m (SuperNormal v) -> m (SuperGroup v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (SuperNormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (SuperNormal v)
getComb [v]
ctx Word64
n

putComb ::
  (MonadPut m) =>
  (Var v) =>
  Map Reference Word64 ->
  EC.EnumMap FOp Text ->
  [v] ->
  SuperNormal v ->
  m ()
putComb :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> SuperNormal v -> m ()
putComb Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx (Lambda [Mem]
ccs (TAbss [v]
us Term ANormalF 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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Term ANormalF v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Term ANormalF 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 v)
getComb :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (SuperNormal 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 v -> SuperNormal v
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem]
ccs (ANormal v -> SuperNormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> SuperNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v]
us (ANormal v -> SuperNormal v) -> m (ANormal v) -> m (SuperNormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Word64
frsh

putNormal ::
  (MonadPut m) =>
  (Var v) =>
  Map Reference Word64 ->
  EC.EnumMap FOp Text ->
  [v] ->
  ANormal v ->
  m ()
putNormal :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx ANormal v
tm = case ANormal 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 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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Func v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Func v -> m ()
putFunc Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx Func 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 [Reference]
rs v
h ANormal 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
*> [Reference] -> m ()
forall (m :: * -> *). MonadPut m => [Reference] -> m ()
putRefs [Reference]
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
h
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx ANormal v
e
  TShift Reference
r v
v ANormal 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
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal v
e
  TMatch v
v Branched (ANormal 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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Branched (ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Branched (ANormal v) -> m ()
putBranches Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx Branched (ANormal v)
bs
  TLit Lit
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 -> m ()
forall (m :: * -> *). MonadPut m => Lit -> m ()
putLit Lit
l
  TBLit Lit
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 -> m ()
forall (m :: * -> *). MonadPut m => Lit -> m ()
putLit Lit
l
  TName v
v (Left Reference
r) [v]
as ANormal 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
*> m ()
pr
      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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal v
e
    where
      pr :: m ()
pr
        | Just Word64
w <- Reference -> Map Reference Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
r Map Reference Word64
refrep = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
w
        | Bool
otherwise = Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
  TName v
v (Right v
u) [v]
as ANormal 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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal v
e
  TLets Direction Word16
Direct [v]
us [Mem]
ccs ANormal v
l ANormal 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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx ANormal 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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal v
e
  TLets (Indirect Word16
w) [v]
us [Mem]
ccs ANormal v
l ANormal 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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx ANormal 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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal v
e
  ANormal v
_ -> String -> m ()
forall a. HasCallStack => String -> a
exn String
"putNormal: malformed term"

getNormal :: (MonadGet m) => (Var v) => [v] -> Word64 -> m (ANormal v)
getNormal :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0 =
  m TmTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m TmTag -> (TmTag -> m (ANormal v)) -> m (ANormal 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 v
forall v. Var v => v -> Term ANormalF v
TVar (v -> ANormal v) -> m v -> m (ANormal 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 v
forall v. Var v => v -> Term ANormalF v
TFrc (v -> ANormal v) -> m v -> m (ANormal 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 v -> [v] -> ANormal v
forall v. Var v => Func v -> [v] -> Term ANormalF v
TApp (Func v -> [v] -> ANormal v) -> m (Func v) -> m ([v] -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m (Func v)
forall (m :: * -> *) v. (MonadGet m, Var v) => [v] -> m (Func v)
getFunc [v]
ctx m ([v] -> ANormal v) -> m [v] -> m (ANormal 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 -> [Reference] -> v -> ANormal v -> ANormal v
forall v.
Var v =>
[Reference] -> v -> Term ANormalF v -> Term ANormalF v
THnd ([Reference] -> v -> ANormal v -> ANormal v)
-> m [Reference] -> m (v -> ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Reference]
forall (m :: * -> *). MonadGet m => m [Reference]
getRefs m (v -> ANormal v -> ANormal v)
-> m v -> m (ANormal v -> ANormal 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 (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0
    TmTag
ShiftT ->
      (Reference -> v -> ANormal v -> ANormal v)
-> v -> Reference -> ANormal v -> ANormal v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reference -> v -> ANormal v -> ANormal v
forall v.
Var v =>
Reference -> v -> Term ANormalF v -> Term ANormalF v
TShift v
v (Reference -> ANormal v -> ANormal v)
-> m Reference -> m (ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal 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 (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch (v -> Branched (ANormal v) -> ANormal v)
-> m v -> m (Branched (ANormal v) -> ANormal 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 (ANormal v) -> ANormal v)
-> m (Branched (ANormal v)) -> m (ANormal 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 (ANormal v))
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (Branched (ANormal v))
getBranches [v]
ctx Word64
frsh0
    TmTag
LitT -> Lit -> ANormal v
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> ANormal v) -> m Lit -> m (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Lit
forall (m :: * -> *). MonadGet m => m Lit
getLit
    TmTag
BxLitT -> Lit -> ANormal v
forall v. Var v => Lit -> Term ANormalF v
TBLit (Lit -> ANormal v) -> m Lit -> m (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Lit
forall (m :: * -> *). MonadGet m => m Lit
getLit
    TmTag
NameRefT ->
      v -> Either Reference v -> [v] -> ANormal v -> ANormal v
forall v.
Var v =>
v
-> Either Reference v -> [v] -> Term ANormalF v -> Term ANormalF v
TName v
v (Either Reference v -> [v] -> ANormal v -> ANormal v)
-> (Reference -> Either Reference v)
-> Reference
-> [v]
-> ANormal v
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Either Reference v
forall a b. a -> Either a b
Left
        (Reference -> [v] -> ANormal v -> ANormal v)
-> m Reference -> m ([v] -> ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
        m ([v] -> ANormal v -> ANormal v)
-> m [v] -> m (ANormal v -> ANormal 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 v -> ANormal v) -> m (ANormal v) -> m (ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal 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 Reference v -> [v] -> ANormal v -> ANormal v
forall v.
Var v =>
v
-> Either Reference v -> [v] -> Term ANormalF v -> Term ANormalF v
TName v
v (Either Reference v -> [v] -> ANormal v -> ANormal v)
-> (v -> Either Reference v) -> v -> [v] -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Either Reference v
forall a b. b -> Either a b
Right
        (v -> [v] -> ANormal v -> ANormal v)
-> m v -> m ([v] -> ANormal v -> ANormal 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 v -> ANormal v)
-> m [v] -> m (ANormal v -> ANormal 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 v -> ANormal v) -> m (ANormal v) -> m (ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal 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 v -> ANormal v -> ANormal v
forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets Direction Word16
forall a. Direction a
Direct [v]
us [Mem]
ccs
        (ANormal v -> ANormal v -> ANormal v)
-> m (ANormal v) -> m (ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0
        m (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal 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 v -> ANormal v -> ANormal v
forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets (Word16 -> Direction Word16
forall a. a -> Direction a
Indirect Word16
w) [v]
us [Mem]
ccs
        (ANormal v -> ANormal v -> ANormal v)
-> m (ANormal v) -> m (ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0
        m (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Word64
frsh

putFunc ::
  (MonadPut m) =>
  (Var v) =>
  Map Reference Word64 ->
  EC.EnumMap FOp Text ->
  [v] ->
  Func v ->
  m ()
putFunc :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Func v -> m ()
putFunc Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx Func v
f = case Func 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 Reference
r
    | Just Word64
w <- Reference -> Map Reference Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
r Map Reference Word64
refrep -> 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
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
w
    | Bool
otherwise -> 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
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
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 Reference
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
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
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 Reference
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
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
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 Word64
f)
    | Just Text
nm <- Word64 -> EnumMap Word64 Text -> Maybe Text
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
f EnumMap Word64 Text
fops ->
        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
*> Text -> m ()
forall (m :: * -> *). MonadPut m => Text -> m ()
putText Text
nm
    | Bool
otherwise ->
        String -> m ()
forall a. HasCallStack => String -> a
exn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"putFunc: could not serialize foreign operation: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
f

getFunc :: (MonadGet m) => (Var v) => [v] -> m (Func v)
getFunc :: forall (m :: * -> *) v. (MonadGet m, Var v) => [v] -> m (Func v)
getFunc [v]
ctx =
  m FnTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m FnTag -> (FnTag -> m (Func v)) -> m (Func 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 v
forall v. v -> Func v
FVar (v -> Func v) -> m v -> m (Func 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 -> Reference -> Func v
forall v. Reference -> Func v
FComb (Reference -> Func v) -> m Reference -> m (Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
    FnTag
FContT -> v -> Func v
forall v. v -> Func v
FCont (v -> Func v) -> m v -> m (Func 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 -> Reference -> CTag -> Func v
forall v. Reference -> CTag -> Func v
FCon (Reference -> CTag -> Func v) -> m Reference -> m (CTag -> Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (CTag -> Func v) -> m CTag -> m (Func 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 -> Reference -> CTag -> Func v
forall v. Reference -> CTag -> Func v
FReq (Reference -> CTag -> Func v) -> m Reference -> m (CTag -> Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (CTag -> Func v) -> m CTag -> m (Func 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 Word64 -> Func v
forall v. Either POp Word64 -> Func v
FPrim (Either POp Word64 -> Func v)
-> (POp -> Either POp Word64) -> POp -> Func v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POp -> Either POp Word64
forall a b. a -> Either a b
Left (POp -> Func v) -> m POp -> m (Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m POp
forall (m :: * -> *). MonadGet m => m POp
getPOp
    FnTag
FForeignT -> String -> m (Func v)
forall a. HasCallStack => String -> a
exn String
"getFunc: can't deserialize a foreign func"

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 = String -> m ()
forall a. HasCallStack => 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 -> String -> m POp
forall a. HasCallStack => 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

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 -> m ()
putLit :: forall (m :: * -> *). MonadPut m => Lit -> m ()
putLit (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
putLit (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
putLit (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
putLit (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)
putLit (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
putLit (LM Referent
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 -> m ()
forall (m :: * -> *). MonadPut m => Referent -> m ()
putReferent Referent
r
putLit (LY Reference
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
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r

getLit :: (MonadGet m) => m Lit
getLit :: forall (m :: * -> *). MonadGet m => m Lit
getLit =
  m LtTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m LtTag -> (LtTag -> m Lit) -> m Lit
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
I (Int64 -> Lit) -> m Int64 -> m Lit
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
N (Word64 -> Lit) -> m Word64 -> m Lit
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
F (Double -> Lit) -> m Double -> m Lit
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
T (Text -> Lit) -> (Text -> Text) -> Text -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.fromText (Text -> Lit) -> m Text -> m Lit
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
C (Char -> Lit) -> m Char -> m Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall (m :: * -> *). MonadGet m => m Char
getChar
    LtTag
LMT -> Referent -> Lit
LM (Referent -> Lit) -> m Referent -> m Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Referent
forall (m :: * -> *). MonadGet m => m Referent
getReferent
    LtTag
LYT -> Reference -> Lit
LY (Reference -> Lit) -> m Reference -> m Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference

putBLit :: (MonadPut m) => BLit -> m ()
putBLit :: forall (m :: * -> *). MonadPut m => BLit -> m ()
putBLit (Text Text
t) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
TextT 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)
putBLit (List Seq Value
s) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
ListT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Value -> m ()) -> Seq Value -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Seq Value
s
putBLit (TmLink Referent
r) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
TmLinkT 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 -> m ()
forall (m :: * -> *). MonadPut m => Referent -> m ()
putReferent Referent
r
putBLit (TyLink Reference
r) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
TyLinkT 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 ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
putBLit (Bytes Bytes
b) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
BytesT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bytes -> m ()
forall (m :: * -> *). MonadPut m => Bytes -> m ()
putBytes Bytes
b
putBLit (Quote Value
v) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
QuoteT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Value
v
putBLit (Code SuperGroup Symbol
g) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
CodeT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> SuperGroup Symbol -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
forall a. Monoid a => a
mempty EnumMap Word64 Text
forall a. Monoid a => a
mempty SuperGroup Symbol
g
putBLit (BArr ByteArray
a) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
BArrT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteArray -> m ()
forall (m :: * -> *). MonadPut m => ByteArray -> m ()
putByteArray ByteArray
a
putBLit (Pos Word64
n) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
PosT 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 :: * -> *) n.
(MonadPut m, Bits n, Bits (Unsigned n), Integral n,
 Integral (Unsigned n)) =>
n -> m ()
putPositive Word64
n
putBLit (Neg Word64
n) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
NegT 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 :: * -> *) n.
(MonadPut m, Bits n, Bits (Unsigned n), Integral n,
 Integral (Unsigned n)) =>
n -> m ()
putPositive Word64
n
putBLit (Char Char
c) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
CharT 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
putBLit (Float Double
d) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
FloatT 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
d
putBLit (Arr Array Value
a) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
ArrT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Value -> m ()) -> Array Value -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Array Value
a

getBLit :: (MonadGet m) => Version -> m BLit
getBLit :: forall (m :: * -> *). MonadGet m => Word32 -> m BLit
getBLit Word32
v =
  m BLTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m BLTag -> (BLTag -> m BLit) -> m BLit
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    BLTag
TextT -> Text -> BLit
Text (Text -> BLit) -> (Text -> Text) -> Text -> BLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.fromText (Text -> BLit) -> m Text -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
forall (m :: * -> *). MonadGet m => m Text
getText
    BLTag
ListT -> Seq Value -> BLit
List (Seq Value -> BLit) -> ([Value] -> Seq Value) -> [Value] -> BLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Seq Value
forall a. [a] -> Seq a
Seq.fromList ([Value] -> BLit) -> m [Value] -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
    BLTag
TmLinkT -> Referent -> BLit
TmLink (Referent -> BLit) -> m Referent -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Referent
forall (m :: * -> *). MonadGet m => m Referent
getReferent
    BLTag
TyLinkT -> Reference -> BLit
TyLink (Reference -> BLit) -> m Reference -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
    BLTag
BytesT -> Bytes -> BLit
Bytes (Bytes -> BLit) -> m Bytes -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bytes
forall (m :: * -> *). MonadGet m => m Bytes
getBytes
    BLTag
QuoteT -> Value -> BLit
Quote (Value -> BLit) -> m Value -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v
    BLTag
CodeT -> SuperGroup Symbol -> BLit
Code (SuperGroup Symbol -> BLit) -> m (SuperGroup Symbol) -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (SuperGroup Symbol)
forall (m :: * -> *) v. (MonadGet m, Var v) => m (SuperGroup v)
getGroup
    BLTag
BArrT -> ByteArray -> BLit
BArr (ByteArray -> BLit) -> m ByteArray -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteArray
forall (m :: * -> *). MonadGet m => m ByteArray
getByteArray
    BLTag
PosT -> Word64 -> BLit
Pos (Word64 -> BLit) -> m Word64 -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *) n. (Bounded n, Integral n, MonadGet m) => m n
getPositive
    BLTag
NegT -> Word64 -> BLit
Neg (Word64 -> BLit) -> m Word64 -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *) n. (Bounded n, Integral n, MonadGet m) => m n
getPositive
    BLTag
CharT -> Char -> BLit
Char (Char -> BLit) -> m Char -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall (m :: * -> *). MonadGet m => m Char
getChar
    BLTag
FloatT -> Double -> BLit
Float (Double -> BLit) -> m Double -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Double
forall (m :: * -> *). MonadGet m => m Double
getFloat
    BLTag
ArrT -> Array Value -> BLit
Arr (Array Value -> BLit)
-> ([Value] -> Array Value) -> [Value] -> BLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (Array Value)] -> Array Value
[Value] -> Array Value
forall l. IsList l => [Item l] -> l
GHC.IsList.fromList ([Value] -> BLit) -> m [Value] -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)

putRefs :: (MonadPut m) => [Reference] -> m ()
putRefs :: forall (m :: * -> *). MonadPut m => [Reference] -> m ()
putRefs [Reference]
rs = (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]
rs

getRefs :: (MonadGet m) => m [Reference]
getRefs :: forall (m :: * -> *). MonadGet m => m [Reference]
getRefs = m Reference -> m [Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference

putBranches ::
  (MonadPut m) =>
  (Var v) =>
  Map Reference Word64 ->
  EC.EnumMap FOp Text ->
  [v] ->
  Branched (ANormal v) ->
  m ()
putBranches :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Branched (ANormal v) -> m ()
putBranches Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx Branched (ANormal v)
bs = case Branched (ANormal v)
bs of
  Branched (ANormal v)
MatchEmpty -> MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MEmptyT
  MatchIntegral EnumMap Word64 (ANormal v)
m Maybe (ANormal v)
df -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MIntT
    (Word64 -> m ())
-> (ANormal v -> m ()) -> EnumMap Word64 (ANormal 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 (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) EnumMap Word64 (ANormal v)
m
    Maybe (ANormal v) -> (ANormal v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal v)
df ((ANormal v -> m ()) -> m ()) -> (ANormal v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx
  MatchText Map Text (ANormal v)
m Maybe (ANormal v)
df -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MTextT
    (Text -> m ())
-> (ANormal v -> m ()) -> Map Text (ANormal 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) (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) Map Text (ANormal v)
m
    Maybe (ANormal v) -> (ANormal v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal v)
df ((ANormal v -> m ()) -> m ()) -> (ANormal v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx
  MatchRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
m (TAbs v
v ANormal v
df) -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MReqT
    (Reference -> m ())
-> (EnumMap CTag ([Mem], ANormal v) -> m ())
-> Map Reference (EnumMap CTag ([Mem], ANormal v))
-> m ()
forall (m :: * -> *) a b.
MonadPut m =>
(a -> m ()) -> (b -> m ()) -> Map a b -> m ()
putMap Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference ((CTag -> m ())
-> (([Mem], ANormal v) -> m ())
-> EnumMap CTag ([Mem], ANormal 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 (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx)) Map Reference (EnumMap CTag ([Mem], ANormal v))
m
    Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal v
df
  MatchData Reference
r EnumMap CTag ([Mem], ANormal v)
m Maybe (ANormal v)
df -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MDataT
    Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
    (CTag -> m ())
-> (([Mem], ANormal v) -> m ())
-> EnumMap CTag ([Mem], ANormal 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 (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) EnumMap CTag ([Mem], ANormal v)
m
    Maybe (ANormal v) -> (ANormal v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal v)
df ((ANormal v -> m ()) -> m ()) -> (ANormal v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx
  MatchSum EnumMap Word64 ([Mem], ANormal v)
m -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MSumT
    (Word64 -> m ())
-> (([Mem], ANormal v) -> m ())
-> EnumMap Word64 ([Mem], ANormal 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 (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) EnumMap Word64 ([Mem], ANormal v)
m
  MatchNumeric Reference
r EnumMap Word64 (ANormal v)
m Maybe (ANormal v)
df -> do
    MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MNumT
    Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
    (Word64 -> m ())
-> (ANormal v -> m ()) -> EnumMap Word64 (ANormal 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 (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) EnumMap Word64 (ANormal v)
m
    Maybe (ANormal v) -> (ANormal v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal v)
df ((ANormal v -> m ()) -> m ()) -> (ANormal v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx
  Branched (ANormal v)
_ -> String -> m ()
forall a. HasCallStack => String -> a
exn String
"putBranches: malformed intermediate term"

getBranches ::
  (MonadGet m) => (Var v) => [v] -> Word64 -> m (Branched (ANormal v))
getBranches :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (Branched (ANormal v))
getBranches [v]
ctx Word64
frsh0 =
  m MtTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m MtTag
-> (MtTag -> m (Branched (ANormal v))) -> m (Branched (ANormal 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 (ANormal v) -> m (Branched (ANormal v))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branched (ANormal v)
forall e. Branched e
MatchEmpty
    MtTag
MIntT ->
      EnumMap Word64 (ANormal v)
-> Maybe (ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral
        (EnumMap Word64 (ANormal v)
 -> Maybe (ANormal v) -> Branched (ANormal v))
-> m (EnumMap Word64 (ANormal v))
-> m (Maybe (ANormal v) -> Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64 -> m (ANormal v) -> m (EnumMap Word64 (ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
        m (Maybe (ANormal v) -> Branched (ANormal v))
-> m (Maybe (ANormal v)) -> m (Branched (ANormal 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 v) -> m (Maybe (ANormal v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
    MtTag
MTextT ->
      Map Text (ANormal v) -> Maybe (ANormal v) -> Branched (ANormal v)
forall e. Map Text e -> Maybe e -> Branched e
MatchText
        (Map Text (ANormal v) -> Maybe (ANormal v) -> Branched (ANormal v))
-> m (Map Text (ANormal v))
-> m (Maybe (ANormal v) -> Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text -> m (ANormal v) -> m (Map Text (ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
        m (Maybe (ANormal v) -> Branched (ANormal v))
-> m (Maybe (ANormal v)) -> m (Branched (ANormal 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 v) -> m (Maybe (ANormal v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
    MtTag
MReqT ->
      Map Reference (EnumMap CTag ([Mem], ANormal v))
-> ANormal v -> Branched (ANormal v)
forall e.
Map Reference (EnumMap CTag ([Mem], e)) -> e -> Branched e
MatchRequest
        (Map Reference (EnumMap CTag ([Mem], ANormal v))
 -> ANormal v -> Branched (ANormal v))
-> m (Map Reference (EnumMap CTag ([Mem], ANormal v)))
-> m (ANormal v -> Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
-> m (EnumMap CTag ([Mem], ANormal v))
-> m (Map Reference (EnumMap CTag ([Mem], ANormal v)))
forall (m :: * -> *) a b.
(MonadGet m, Ord a) =>
m a -> m b -> m (Map a b)
getMap m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference (m CTag
-> m ([Mem], ANormal v) -> m (EnumMap CTag ([Mem], ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal v)
getCase [v]
ctx Word64
frsh0))
        m (ANormal v -> Branched (ANormal v))
-> m (ANormal v) -> m (Branched (ANormal 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 v -> ANormal v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
v (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal 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 ->
      Reference
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Branched (ANormal v)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData
        (Reference
 -> EnumMap CTag ([Mem], ANormal v)
 -> Maybe (ANormal v)
 -> Branched (ANormal v))
-> m Reference
-> m (EnumMap CTag ([Mem], ANormal v)
      -> Maybe (ANormal v) -> Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
        m (EnumMap CTag ([Mem], ANormal v)
   -> Maybe (ANormal v) -> Branched (ANormal v))
-> m (EnumMap CTag ([Mem], ANormal v))
-> m (Maybe (ANormal v) -> Branched (ANormal 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 v) -> m (EnumMap CTag ([Mem], ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal v)
getCase [v]
ctx Word64
frsh0)
        m (Maybe (ANormal v) -> Branched (ANormal v))
-> m (Maybe (ANormal v)) -> m (Branched (ANormal 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 v) -> m (Maybe (ANormal v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
    MtTag
MSumT -> EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> m (EnumMap Word64 ([Mem], ANormal v))
-> m (Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
-> m ([Mem], ANormal v) -> m (EnumMap Word64 ([Mem], ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal v)
getCase [v]
ctx Word64
frsh0)
    MtTag
MNumT ->
      Reference
-> EnumMap Word64 (ANormal v)
-> Maybe (ANormal v)
-> Branched (ANormal v)
forall e. Reference -> EnumMap Word64 e -> Maybe e -> Branched e
MatchNumeric
        (Reference
 -> EnumMap Word64 (ANormal v)
 -> Maybe (ANormal v)
 -> Branched (ANormal v))
-> m Reference
-> m (EnumMap Word64 (ANormal v)
      -> Maybe (ANormal v) -> Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
        m (EnumMap Word64 (ANormal v)
   -> Maybe (ANormal v) -> Branched (ANormal v))
-> m (EnumMap Word64 (ANormal v))
-> m (Maybe (ANormal v) -> Branched (ANormal 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 v) -> m (EnumMap Word64 (ANormal 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 v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
        m (Maybe (ANormal v) -> Branched (ANormal v))
-> m (Maybe (ANormal v)) -> m (Branched (ANormal 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 v) -> m (Maybe (ANormal v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)

putCase ::
  (MonadPut m) =>
  (Var v) =>
  Map Reference Word64 ->
  EC.EnumMap FOp Text ->
  [v] ->
  ([Mem], ANormal v) ->
  m ()
putCase :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx ([Mem]
ccs, (TAbss [v]
us ANormal 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
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal v
e

getCase :: (MonadGet m) => (Var v) => [v] -> Word64 -> m ([Mem], ANormal v)
getCase :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal 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 v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v]
us (ANormal v -> ([Mem], ANormal v))
-> m (ANormal v) -> m ([Mem], ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal 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 = VarInt Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => VarInt Int -> m ()
serialize (Int -> VarInt Int
forall n. n -> VarInt n
VarInt (Int -> VarInt Int) -> Int -> VarInt Int
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) -> (VarInt Int -> Int) -> VarInt Int -> CTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt Int -> Int
forall n. VarInt n -> n
unVarInt (VarInt Int -> CTag) -> m (VarInt Int) -> m CTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (VarInt Int)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (VarInt Int)
deserialize

putGroupRef :: (MonadPut m) => GroupRef -> m ()
putGroupRef :: forall (m :: * -> *). MonadPut m => GroupRef -> m ()
putGroupRef (GR Reference
r Word64
i) =
  Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
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
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
i

getGroupRef :: (MonadGet m) => m GroupRef
getGroupRef :: forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef = Reference -> Word64 -> GroupRef
GR (Reference -> Word64 -> GroupRef)
-> m Reference -> m (Word64 -> GroupRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (Word64 -> GroupRef) -> m Word64 -> m GroupRef
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
forall (m :: * -> *). MonadGet m => m Word64
getWord64be

-- Notes
--
-- Starting with version 4 of the value format, it is expected that
-- unboxed data does not actually occur in the values being sent. For
-- most values this was not a problem:
--
--   - Partial applications had no way of directly including unboxed
--     values, because they all result from surface level unison
--     applications
--   - Unboxed values in Data only occurred to represent certain
--     builtin types. Those have been replaced by BLits.
--
-- However, some work was required to make sure no unboxed data ended
-- up in Cont. The runtime has been modified to avoid using the
-- unboxed stack in generated code, so now only builtins use it,
-- effectively. Since continuations are never captured inside builtins
-- (and even if we wanted to do that, we could arrange for a clean
-- unboxed stack), this is no longer a problem, either.
--
-- So, unboxed data is completely absent from the format. We are now
-- exchanging unison surface values, effectively.
putValue :: (MonadPut m) => Value -> m ()
putValue :: forall (m :: * -> *). MonadPut m => Value -> m ()
putValue (Partial GroupRef
gr [] [Value]
vs) =
  VaTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag VaTag
PartialT
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GroupRef -> m ()
forall (m :: * -> *). MonadPut m => GroupRef -> m ()
putGroupRef GroupRef
gr
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Value -> m ()) -> [Value] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue [Value]
vs
putValue Partial {} =
  String -> m ()
forall a. HasCallStack => String -> a
exn String
"putValue: Partial with unboxed values no longer supported"
putValue (Data Reference
r Word64
t [] [Value]
vs) =
  VaTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag VaTag
DataT
    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 ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
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
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
t
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Value -> m ()) -> [Value] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue [Value]
vs
putValue Data {} =
  String -> m ()
forall a. HasCallStack => String -> a
exn String
"putValue: Data with unboxed contents no longer supported"
putValue (Cont [] [Value]
bs Cont
k) =
  VaTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag VaTag
ContT
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Value -> m ()) -> [Value] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue [Value]
bs
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Cont -> m ()
forall (m :: * -> *). MonadPut m => Cont -> m ()
putCont Cont
k
putValue Cont {} =
  String -> m ()
forall a. HasCallStack => String -> a
exn String
"putValue: Cont with unboxed stack no longer supported"
putValue (BLit BLit
l) =
  VaTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag VaTag
BLitT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BLit -> m ()
forall (m :: * -> *). MonadPut m => BLit -> m ()
putBLit BLit
l

getValue :: (MonadGet m) => Version -> m Value
getValue :: forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v =
  m VaTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m VaTag -> (VaTag -> m Value) -> m Value
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    VaTag
PartialT
      | Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 ->
          GroupRef -> [Word64] -> [Value] -> Value
Partial (GroupRef -> [Word64] -> [Value] -> Value)
-> m GroupRef -> m ([Word64] -> [Value] -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef m ([Word64] -> [Value] -> Value)
-> m [Word64] -> m ([Value] -> Value)
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 [Word64]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be m ([Value] -> Value) -> m [Value] -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
      | Bool
otherwise ->
          (GroupRef -> [Word64] -> [Value] -> Value)
-> [Word64] -> GroupRef -> [Value] -> Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip GroupRef -> [Word64] -> [Value] -> Value
Partial [] (GroupRef -> [Value] -> Value)
-> m GroupRef -> m ([Value] -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef m ([Value] -> Value) -> m [Value] -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
    VaTag
DataT
      | Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 ->
          Reference -> Word64 -> [Word64] -> [Value] -> Value
Data
            (Reference -> Word64 -> [Word64] -> [Value] -> Value)
-> m Reference -> m (Word64 -> [Word64] -> [Value] -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
            m (Word64 -> [Word64] -> [Value] -> Value)
-> m Word64 -> m ([Word64] -> [Value] -> Value)
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
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m ([Word64] -> [Value] -> Value)
-> m [Word64] -> m ([Value] -> Value)
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 [Word64]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m ([Value] -> Value) -> m [Value] -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
      | Bool
otherwise ->
          (\Reference
r Word64
t -> Reference -> Word64 -> [Word64] -> [Value] -> Value
Data Reference
r Word64
t [])
            (Reference -> Word64 -> [Value] -> Value)
-> m Reference -> m (Word64 -> [Value] -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
            m (Word64 -> [Value] -> Value) -> m Word64 -> m ([Value] -> Value)
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
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m ([Value] -> Value) -> m [Value] -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
    VaTag
ContT
      | Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 ->
          [Word64] -> [Value] -> Cont -> Value
Cont ([Word64] -> [Value] -> Cont -> Value)
-> m [Word64] -> m ([Value] -> Cont -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64 -> m [Word64]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be m ([Value] -> Cont -> Value) -> m [Value] -> m (Cont -> Value)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v) m (Cont -> Value) -> m Cont -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
      | Bool
otherwise -> [Word64] -> [Value] -> Cont -> Value
Cont [] ([Value] -> Cont -> Value) -> m [Value] -> m (Cont -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v) m (Cont -> Value) -> m Cont -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
    VaTag
BLitT -> BLit -> Value
BLit (BLit -> Value) -> m BLit -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> m BLit
forall (m :: * -> *). MonadGet m => Word32 -> m BLit
getBLit Word32
v

putCont :: (MonadPut m) => Cont -> m ()
putCont :: forall (m :: * -> *). MonadPut m => Cont -> m ()
putCont Cont
KE = CoTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag CoTag
KET
putCont (Mark Word64
0 Word64
ba [Reference]
rs Map Reference Value
ds Cont
k) =
  CoTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag CoTag
MarkT
    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 ()
putWord64be Word64
ba
    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]
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
*> (Reference -> m ())
-> (Value -> m ()) -> Map Reference Value -> m ()
forall (m :: * -> *) a b.
MonadPut m =>
(a -> m ()) -> (b -> m ()) -> Map a b -> m ()
putMap Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Map Reference Value
ds
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Cont -> m ()
forall (m :: * -> *). MonadPut m => Cont -> m ()
putCont Cont
k
putCont Mark {} =
  String -> m ()
forall a. HasCallStack => String -> a
exn String
"putCont: Mark with unboxed args no longer supported"
putCont (Push Word64
0 Word64
j Word64
0 Word64
n GroupRef
gr Cont
k) =
  CoTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag CoTag
PushT
    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 ()
putWord64be Word64
j
    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 ()
putWord64be Word64
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
*> GroupRef -> m ()
forall (m :: * -> *). MonadPut m => GroupRef -> m ()
putGroupRef GroupRef
gr
    m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Cont -> m ()
forall (m :: * -> *). MonadPut m => Cont -> m ()
putCont Cont
k
putCont Push {} =
  String -> m ()
forall a. HasCallStack => String -> a
exn String
"putCont: Push with unboxed information no longer supported"

getCont :: (MonadGet m) => Version -> m Cont
getCont :: forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v =
  m CoTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m CoTag -> (CoTag -> m Cont) -> m Cont
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    CoTag
KET -> Cont -> m Cont
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cont
KE
    CoTag
MarkT
      | Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 ->
          Word64
-> Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont
Mark
            (Word64
 -> Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont)
-> m Word64
-> m (Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m (Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont)
-> m Word64
-> m ([Reference] -> Map Reference Value -> Cont -> Cont)
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
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m ([Reference] -> Map Reference Value -> Cont -> Cont)
-> m [Reference] -> m (Map Reference Value -> Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Reference -> m [Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
            m (Map Reference Value -> Cont -> Cont)
-> m (Map Reference Value) -> m (Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Reference -> m Value -> m (Map Reference Value)
forall (m :: * -> *) a b.
(MonadGet m, Ord a) =>
m a -> m b -> m (Map a b)
getMap m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
            m (Cont -> Cont) -> m Cont -> m Cont
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
      | Bool
otherwise ->
          Word64
-> Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont
Mark Word64
0
            (Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont)
-> m Word64
-> m ([Reference] -> Map Reference Value -> Cont -> Cont)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m ([Reference] -> Map Reference Value -> Cont -> Cont)
-> m [Reference] -> m (Map Reference Value -> Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Reference -> m [Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
            m (Map Reference Value -> Cont -> Cont)
-> m (Map Reference Value) -> m (Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Reference -> m Value -> m (Map Reference Value)
forall (m :: * -> *) a b.
(MonadGet m, Ord a) =>
m a -> m b -> m (Map a b)
getMap m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
            m (Cont -> Cont) -> m Cont -> m Cont
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
    CoTag
PushT
      | Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 ->
          Word64 -> Word64 -> Word64 -> Word64 -> GroupRef -> Cont -> Cont
Push
            (Word64 -> Word64 -> Word64 -> Word64 -> GroupRef -> Cont -> Cont)
-> m Word64
-> m (Word64 -> Word64 -> Word64 -> GroupRef -> Cont -> Cont)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m (Word64 -> Word64 -> Word64 -> GroupRef -> Cont -> Cont)
-> m Word64 -> m (Word64 -> Word64 -> GroupRef -> Cont -> Cont)
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
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m (Word64 -> Word64 -> GroupRef -> Cont -> Cont)
-> m Word64 -> m (Word64 -> GroupRef -> Cont -> Cont)
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
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m (Word64 -> GroupRef -> Cont -> Cont)
-> m Word64 -> m (GroupRef -> Cont -> Cont)
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
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m (GroupRef -> Cont -> Cont) -> m GroupRef -> m (Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef
            m (Cont -> Cont) -> m Cont -> m Cont
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
      | Bool
otherwise ->
          (\Word64
j Word64
n -> Word64 -> Word64 -> Word64 -> Word64 -> GroupRef -> Cont -> Cont
Push Word64
0 Word64
j Word64
0 Word64
n)
            (Word64 -> Word64 -> GroupRef -> Cont -> Cont)
-> m Word64 -> m (Word64 -> GroupRef -> Cont -> Cont)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m (Word64 -> GroupRef -> Cont -> Cont)
-> m Word64 -> m (GroupRef -> Cont -> Cont)
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
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            m (GroupRef -> Cont -> Cont) -> m GroupRef -> m (Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef
            m (Cont -> Cont) -> m Cont -> m Cont
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v

deserializeGroup :: (Var v) => ByteString -> Either String (SuperGroup v)
deserializeGroup :: forall v. Var v => ByteString -> Either String (SuperGroup v)
deserializeGroup ByteString
bs = Get (SuperGroup v) -> ByteString -> Either String (SuperGroup v)
forall a. Get a -> ByteString -> Either String a
runGetS (Get ()
getVersion Get () -> Get (SuperGroup v) -> Get (SuperGroup v)
forall a b. Get a -> Get b -> Get b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get (SuperGroup v)
forall (m :: * -> *) v. (MonadGet m, Var v) => m (SuperGroup v)
getGroup) ByteString
bs
  where
    getVersion :: Get ()
getVersion =
      Get Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be Get Word32 -> (Word32 -> Get ()) -> Get ()
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word32
1 -> () -> Get ()
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Word32
2 -> () -> Get ()
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Word32
n -> String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"deserializeGroup: unknown version: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n

serializeGroup ::
  (Var v) => EC.EnumMap FOp Text -> SuperGroup v -> ByteString
serializeGroup :: forall v.
Var v =>
EnumMap Word64 Text -> SuperGroup v -> ByteString
serializeGroup EnumMap Word64 Text
fops SuperGroup v
sg = Put -> ByteString
runPutS (Put
putVersion Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> Put
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
forall a. Monoid a => a
mempty EnumMap Word64 Text
fops SuperGroup v
sg)
  where
    putVersion :: Put
putVersion = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
codeVersion

-- | Serializes a `SuperGroup` for rehashing.
--
-- Expected as arguments are some code, and the `Reference` that
-- refers to it. In particular, if the code refers to itself by
-- reference, or if the code is part of a mututally-recursive set of
-- definitions (which have a common hash), the reference used as part
-- of that (mutual) recursion must be supplied.
--
-- Using that reference, we find all references in the code to that
-- connected component. In the resulting byte string, those references
-- are instead replaced by positions in a listing of the connected
-- component. This means that the byte string is independent of the
-- hash used for the self reference. Only the order matters (which is
-- determined by the `Reference`). Then the bytes can be re-hashed to
-- establish a new hash for the connected component. This operation
-- should be idempotent as long as the indexing is preserved.
--
-- Supplying a `Builtin` reference is not supported. Such code
-- shouldn't be subject to rehashing.
serializeGroupForRehash ::
  (Var v) =>
  EC.EnumMap FOp Text ->
  Reference ->
  SuperGroup v ->
  L.ByteString
serializeGroupForRehash :: forall v.
Var v =>
EnumMap Word64 Text -> Reference -> SuperGroup v -> ByteString
serializeGroupForRehash EnumMap Word64 Text
_ (Builtin Text
_) SuperGroup v
_ =
  String -> ByteString
forall a. HasCallStack => String -> a
error String
"serializeForRehash: builtin reference"
serializeGroupForRehash EnumMap Word64 Text
fops (Derived Hash
h Word64
_) SuperGroup v
sg =
  Put -> ByteString
runPutLazy (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> Put
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
refrep EnumMap Word64 Text
fops SuperGroup v
sg
  where
    f :: Reference -> Maybe (Reference, Word64)
f r :: Reference
r@(Derived Hash
h' Word64
i) | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h' = (Reference, Word64) -> Maybe (Reference, Word64)
forall a. a -> Maybe a
Just (Reference
r, Word64
i)
    f Reference
_ = Maybe (Reference, Word64)
forall a. Maybe a
Nothing
    refrep :: Map Reference Word64
refrep = [(Reference, Word64)] -> Map Reference Word64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, Word64)] -> Map Reference Word64)
-> ([Reference] -> [(Reference, Word64)])
-> [Reference]
-> Map Reference Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Maybe (Reference, Word64))
-> [Reference] -> [(Reference, Word64)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Reference -> Maybe (Reference, Word64)
f ([Reference] -> Map Reference Word64)
-> [Reference] -> Map Reference Word64
forall a b. (a -> b) -> a -> b
$ SuperGroup v -> [Reference]
forall v. Var v => SuperGroup v -> [Reference]
groupTermLinks SuperGroup v
sg

getVersionedValue :: (MonadGet m) => m Value
getVersionedValue :: forall (m :: * -> *). MonadGet m => m Value
getVersionedValue = m Word32
getVersion m Word32 -> (Word32 -> m Value) -> m Value
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue
  where
    getVersion :: m Word32
getVersion =
      m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be m Word32 -> (Word32 -> m Word32) -> m Word32
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Word32
n
          | Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
1 -> String -> m Word32
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Word32) -> String -> m Word32
forall a b. (a -> b) -> a -> b
$ String
"deserializeValue: unknown version: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n
          | Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
3 -> String -> m Word32
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Word32) -> String -> m Word32
forall a b. (a -> b) -> a -> b
$ String
"deserializeValue: unsupported version: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n
          | Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
4 -> Word32 -> m Word32
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
n
          | Bool
otherwise -> String -> m Word32
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Word32) -> String -> m Word32
forall a b. (a -> b) -> a -> b
$ String
"deserializeValue: unknown version: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n

deserializeValue :: ByteString -> Either String Value
deserializeValue :: ByteString -> Either String Value
deserializeValue ByteString
bs = Get Value -> ByteString -> Either String Value
forall a. Get a -> ByteString -> Either String a
runGetS Get Value
forall (m :: * -> *). MonadGet m => m Value
getVersionedValue ByteString
bs

serializeValue :: Value -> ByteString
serializeValue :: Value -> ByteString
serializeValue Value
v = Put -> ByteString
runPutS (Put
putVersion Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Put
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Value
v)
  where
    putVersion :: Put
putVersion = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
valueVersion

serializeValueLazy :: Value -> L.ByteString
serializeValueLazy :: Value -> ByteString
serializeValueLazy Value
v = Put -> ByteString
runPutLazy (Put
putVersion Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Put
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Value
v)
  where
    putVersion :: Put
putVersion = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
valueVersion

valueVersion :: Word32
valueVersion :: Word32
valueVersion = Word32
4

codeVersion :: Word32
codeVersion :: Word32
codeVersion = Word32
2