{-# 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.Foreign.Function.Type (ForeignFunc)
import Unison.Runtime.Serialize
import Unison.Util.Text qualified as Util.Text
import Unison.Var (Type (ANFBlank), Var (..))
import Prelude hiding (getChar, putChar)

-- Version information is threaded through to allow handling
-- different formats. Transfer means that it is for saving
-- code/values to be restored later. Hash means we're just getting
-- bytes for hashing, so we don't need perfect information.
data Version = Transfer Word32 | Hash Word32
  deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> String
show :: Version -> String
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show)

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
  | CachedCodeT

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
    BLTag
CachedCodeT -> Word8
13

  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
13 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
CachedCodeT
    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 ->
  Map ForeignFunc Text ->
  SuperGroup v ->
  m ()
putGroup :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> SuperNormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> SuperNormal v -> m ()
putComb Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> SuperNormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> SuperNormal v -> m ()
putComb Map Reference Word64
refrep Map ForeignFunc 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

putCode :: (MonadPut m) => Map ForeignFunc Text -> Code -> m ()
putCode :: forall (m :: * -> *).
MonadPut m =>
Map ForeignFunc Text -> Code -> m ()
putCode Map ForeignFunc Text
fops (CodeRep SuperGroup Symbol
g Cacheability
c) = Map Reference Word64
-> Map ForeignFunc Text -> SuperGroup Symbol -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
forall a. Monoid a => a
mempty Map ForeignFunc Text
fops SuperGroup Symbol
g m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Cacheability -> m ()
forall (m :: * -> *). MonadPut m => Cacheability -> m ()
putCacheability Cacheability
c

getCode :: (MonadGet m) => Word32 -> m Code
getCode :: forall (m :: * -> *). MonadGet m => Word32 -> m Code
getCode Word32
v = SuperGroup Symbol -> Cacheability -> Code
CodeRep (SuperGroup Symbol -> Cacheability -> Code)
-> m (SuperGroup Symbol) -> m (Cacheability -> Code)
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 m (Cacheability -> Code) -> m Cacheability -> m Code
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Cacheability
getCache
  where
    getCache :: m Cacheability
getCache
      | Word32
v Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
3 = m Cacheability
forall (m :: * -> *). MonadGet m => m Cacheability
getCacheability
      | Bool
otherwise = Cacheability -> m Cacheability
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cacheability
Uncacheable

putCacheability :: (MonadPut m) => Cacheability -> m ()
putCacheability :: forall (m :: * -> *). MonadPut m => Cacheability -> m ()
putCacheability Cacheability
Uncacheable = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0
putCacheability Cacheability
Cacheable = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
1

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

putComb ::
  (MonadPut m) =>
  (Var v) =>
  Map Reference Word64 ->
  Map ForeignFunc Text ->
  [v] ->
  SuperNormal v ->
  m ()
putComb :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> SuperNormal v -> m ()
putComb Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> Term ANormalF v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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 ->
  Map ForeignFunc Text ->
  [v] ->
  ANormal v ->
  m ()
putNormal :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> Func v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> Func v -> m ()
putFunc Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> Branched (ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> Branched (ANormal v) -> m ()
putBranches Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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 ->
  Map ForeignFunc Text ->
  [v] ->
  Func v ->
  m ()
putFunc :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> Func v -> m ()
putFunc Map Reference Word64
refrep Map ForeignFunc 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 ForeignFunc
f)
    | Just Text
nm <- ForeignFunc -> Map ForeignFunc Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ForeignFunc
f Map ForeignFunc 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 -> ShowS
forall v. [v] -> [v] -> [v]
++ ForeignFunc -> String
forall a. Show a => a -> String
show ForeignFunc
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 ForeignFunc -> Func v
forall v. Either POp ForeignFunc -> Func v
FPrim (Either POp ForeignFunc -> Func v)
-> (POp -> Either POp ForeignFunc) -> POp -> Func v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POp -> Either POp ForeignFunc
forall a b. a -> Either a b
Left (POp -> Func 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 -> ShowS
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
  POp
CAST -> Word16
124
  POp
ANDI -> Word16
125
  POp
IORI -> Word16
126
  POp
XORI -> Word16
127
  POp
COMI -> Word16
128
  POp
DRPN -> Word16
129
  POp
TRNC -> Word16
130
  POp
REFN -> Word16
131
  POp
REFR -> Word16
132
  POp
REFW -> Word16
133
  POp
RCAS -> Word16
134
  POp
RRFC -> Word16
135
  POp
TIKR -> Word16
136
  POp
LESI -> Word16
137
  POp
NEQI -> Word16
138
  POp
LESN -> Word16
139
  POp
NEQN -> Word16
140
  POp
LESF -> Word16
141
  POp
NEQF -> Word16
142
  POp
LEQU -> Word16
143
  POp
LESU -> Word16
144
  POp
NOTB -> Word16
145
  POp
ANDB -> Word16
146
  POp
IORB -> Word16
147

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

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

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

putLit :: (MonadPut m) => Lit -> 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) => Version -> BLit -> m ()
putBLit :: forall (m :: * -> *). MonadPut m => Version -> BLit -> m ()
putBLit Version
_ (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 Version
v (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 (Version -> Value -> m ()
forall (m :: * -> *). MonadPut m => Version -> Value -> m ()
putValue Version
v) Seq Value
s
putBLit Version
_ (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 Version
_ (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 Version
_ (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 Version
v (Quote Value
vl) = 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
*> Version -> Value -> m ()
forall (m :: * -> *). MonadPut m => Version -> Value -> m ()
putValue Version
v Value
vl
putBLit Version
v (Code (CodeRep SuperGroup Symbol
sg Cacheability
ch)) =
  BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
tag 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
-> Map ForeignFunc Text -> SuperGroup Symbol -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
forall a. Monoid a => a
mempty Map ForeignFunc Text
forall a. Monoid a => a
mempty SuperGroup Symbol
sg
  where
    -- Hashing treats everything as uncacheable for consistent
    -- results.
    tag :: BLTag
tag
      | Cacheability
Cacheable <- Cacheability
ch,
        Transfer Word32
_ <- Version
v =
          BLTag
CachedCodeT
      | Bool
otherwise = BLTag
CodeT
putBLit Version
_ (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 Version
_ (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 Version
_ (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 Version
_ (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 Version
_ (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 Version
v (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 (Version -> Value -> m ()
forall (m :: * -> *). MonadPut m => Version -> Value -> m ()
putValue Version
v) Array Value
a

getBLit :: (MonadGet m) => Version -> m BLit
getBLit :: forall (m :: * -> *). MonadGet m => Version -> m BLit
getBLit Version
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 (Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
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
<$> Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
v
    BLTag
CodeT -> Code -> BLit
Code (Code -> BLit)
-> (SuperGroup Symbol -> Code) -> SuperGroup Symbol -> BLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperGroup Symbol -> Cacheability -> Code)
-> Cacheability -> SuperGroup Symbol -> Code
forall a b c. (a -> b -> c) -> b -> a -> c
flip SuperGroup Symbol -> Cacheability -> Code
CodeRep Cacheability
Uncacheable (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 (Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
v)
    BLTag
CachedCodeT -> Code -> BLit
Code (Code -> BLit)
-> (SuperGroup Symbol -> Code) -> SuperGroup Symbol -> BLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperGroup Symbol -> Cacheability -> Code)
-> Cacheability -> SuperGroup Symbol -> Code
forall a b c. (a -> b -> c) -> b -> a -> c
flip SuperGroup Symbol -> Cacheability -> Code
CodeRep Cacheability
Cacheable (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

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 ->
  Map ForeignFunc Text ->
  [v] ->
  Branched (ANormal v) ->
  m ()
putBranches :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> Branched (ANormal v) -> m ()
putBranches Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ([Mem], ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep Map ForeignFunc Text
fops [v]
ctx)) Map Reference (EnumMap CTag ([Mem], ANormal v))
m
    Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ([Mem], ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ([Mem], ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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 ->
  Map ForeignFunc Text ->
  [v] ->
  ([Mem], ANormal v) ->
  m ()
putCase :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep Map ForeignFunc 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
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep Map ForeignFunc 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) => Version -> Value -> m ()
putValue :: forall (m :: * -> *). MonadPut m => Version -> Value -> m ()
putValue Version
v (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 (Version -> Value -> m ()
forall (m :: * -> *). MonadPut m => Version -> Value -> m ()
putValue Version
v) [Value]
vs
putValue Version
v (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 (Version -> Value -> m ()
forall (m :: * -> *). MonadPut m => Version -> Value -> m ()
putValue Version
v) [Value]
vs
putValue Version
v (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 (Version -> Value -> m ()
forall (m :: * -> *). MonadPut m => Version -> Value -> m ()
putValue Version
v) [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
*> Version -> Cont -> m ()
forall (m :: * -> *). MonadPut m => Version -> Cont -> m ()
putCont Version
v Cont
k
putValue Version
v (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
*> Version -> BLit -> m ()
forall (m :: * -> *). MonadPut m => Version -> BLit -> m ()
putBLit Version
v BLit
l

getValue :: (MonadGet m) => Version -> m Value
getValue :: forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
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
      | Transfer Word32
vn <- Version
v,
        Word32
vn Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 -> do
          GroupRef
gr <- m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef
          m Word64 -> m [Word64]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be m [Word64] -> ([Word64] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Word64] -> m ()
forall (m :: * -> *) a. MonadGet m => [a] -> m ()
assertEmptyUnboxed
          [Value]
bs <- m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
v)
          pure $ GroupRef -> [Value] -> Value
Partial GroupRef
gr [Value]
bs
      | Bool
otherwise -> do
          GroupRef
gr <- m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef
          [Value]
vs <- m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
v)
          pure $ GroupRef -> [Value] -> Value
Partial GroupRef
gr [Value]
vs
    VaTag
DataT
      | Transfer Word32
vn <- Version
v,
        Word32
vn Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 -> do
          Reference
r <- m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
          Word64
w <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
          m Word64 -> m [Word64]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be m [Word64] -> ([Word64] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Word64] -> m ()
forall (m :: * -> *) a. MonadGet m => [a] -> m ()
assertEmptyUnboxed
          [Value]
vs <- m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
v)
          pure $ Reference -> Word64 -> [Value] -> Value
Data Reference
r Word64
w [Value]
vs
      | Bool
otherwise -> do
          Reference
r <- m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
          Word64
w <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
          [Value]
vs <- m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
v)
          pure $ Reference -> Word64 -> [Value] -> Value
Data Reference
r Word64
w [Value]
vs
    VaTag
ContT
      | Transfer Word32
vn <- Version
v,
        Word32
vn Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 -> do
          m Word64 -> m [Word64]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be m [Word64] -> ([Word64] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Word64] -> m ()
forall (m :: * -> *) a. MonadGet m => [a] -> m ()
assertEmptyUnboxed
          [Value]
bs <- m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
v)
          Cont
k <- Version -> m Cont
forall (m :: * -> *). MonadGet m => Version -> m Cont
getCont Version
v
          pure $ [Value] -> Cont -> Value
Cont [Value]
bs Cont
k
      | Bool
otherwise -> do
          [Value]
bs <- m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
v)
          Cont
k <- Version -> m Cont
forall (m :: * -> *). MonadGet m => Version -> m Cont
getCont Version
v
          pure $ [Value] -> Cont -> Value
Cont [Value]
bs Cont
k
    VaTag
BLitT -> BLit -> Value
BLit (BLit -> Value) -> m BLit -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> m BLit
forall (m :: * -> *). MonadGet m => Version -> m BLit
getBLit Version
v
  where
    assertEmptyUnboxed :: (MonadGet m) => [a] -> m ()
    assertEmptyUnboxed :: forall (m :: * -> *) a. MonadGet m => [a] -> m ()
assertEmptyUnboxed [] = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    assertEmptyUnboxed [a]
_ = String -> m ()
forall a. HasCallStack => String -> a
exn String
"getValue: unboxed values no longer supported"

putCont :: (MonadPut m) => Version -> Cont -> m ()
putCont :: forall (m :: * -> *). MonadPut m => Version -> Cont -> m ()
putCont Version
_ Cont
KE = CoTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag CoTag
KET
putCont Version
v (Mark Word64
a [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
a
    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 (Version -> Value -> m ()
forall (m :: * -> *). MonadPut m => Version -> Value -> m ()
putValue Version
v) 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
*> Version -> Cont -> m ()
forall (m :: * -> *). MonadPut m => Version -> Cont -> m ()
putCont Version
v Cont
k
putCont Version
v (Push Word64
f 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
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
*> 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
*> Version -> Cont -> m ()
forall (m :: * -> *). MonadPut m => Version -> Cont -> m ()
putCont Version
v Cont
k

getCont :: (MonadGet m) => Version -> m Cont
getCont :: forall (m :: * -> *). MonadGet m => Version -> m Cont
getCont Version
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
      | Transfer Word32
vn <- Version
v,
        Word32
vn Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 -> do
          m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be m Word64 -> (Word64 -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Word64 -> m ()
forall {a} {f :: * -> *}.
(Eq a, Num a, Applicative f, Show a) =>
String -> a -> f ()
assert0 String
"unboxed arg size"
          Word64
ba <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
          [Reference]
refs <- m Reference -> m [Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
          Map Reference Value
vals <- 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 (Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
v)
          Cont
cont <- Version -> m Cont
forall (m :: * -> *). MonadGet m => Version -> m Cont
getCont Version
v
          pure $ Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont
Mark Word64
ba [Reference]
refs Map Reference Value
vals Cont
cont
      | Bool
otherwise ->
          Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont
Mark
            (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 (Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue Version
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
<*> Version -> m Cont
forall (m :: * -> *). MonadGet m => Version -> m Cont
getCont Version
v
    CoTag
PushT
      | Transfer Word32
vn <- Version
v,
        Word32
vn Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 -> do
          m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be m Word64 -> (Word64 -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Word64 -> m ()
forall {a} {f :: * -> *}.
(Eq a, Num a, Applicative f, Show a) =>
String -> a -> f ()
assert0 String
"unboxed frame size"
          Word64
bf <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
          m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be m Word64 -> (Word64 -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Word64 -> m ()
forall {a} {f :: * -> *}.
(Eq a, Num a, Applicative f, Show a) =>
String -> a -> f ()
assert0 String
"unboxed arg size"
          Word64
ba <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
          GroupRef
gr <- m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef
          Cont
cont <- Version -> m Cont
forall (m :: * -> *). MonadGet m => Version -> m Cont
getCont Version
v
          pure $ Word64 -> Word64 -> GroupRef -> Cont -> Cont
Push Word64
bf Word64
ba GroupRef
gr Cont
cont
      | Bool
otherwise ->
          Word64 -> Word64 -> GroupRef -> Cont -> Cont
Push
            (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
<*> Version -> m Cont
forall (m :: * -> *). MonadGet m => Version -> m Cont
getCont Version
v
  where
    assert0 :: String -> a -> f ()
assert0 String
_name a
0 = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    assert0 String
name a
n = String -> f ()
forall a. HasCallStack => String -> a
exn (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$ String
"getCont: malformed intermediate term. Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" to be 0, but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
n

deserializeCode :: ByteString -> Either String Code
deserializeCode :: ByteString -> Either String Code
deserializeCode ByteString
bs = Get Code -> ByteString -> Either String Code
forall a. Get a -> ByteString -> Either String a
runGetS (Get Word32
getVersion Get Word32 -> (Word32 -> Get Code) -> Get Code
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Get Code
forall (m :: * -> *). MonadGet m => Word32 -> m Code
getCode) ByteString
bs
  where
    getVersion :: Get Word32
getVersion =
      Get Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be Get Word32 -> (Word32 -> Get Word32) -> Get Word32
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
n | Word32
1 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
n Bool -> Bool -> Bool
&& Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
3 -> Word32 -> Get Word32
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
n
        Word32
n -> String -> Get Word32
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Word32) -> String -> Get Word32
forall a b. (a -> b) -> a -> b
$ String
"deserializeGroup: unknown version: " String -> ShowS
forall v. [v] -> [v] -> [v]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n

serializeCode :: Map ForeignFunc Text -> Code -> ByteString
serializeCode :: Map ForeignFunc Text -> Code -> ByteString
serializeCode Map ForeignFunc Text
fops Code
co = 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 ForeignFunc Text -> Code -> Put
forall (m :: * -> *).
MonadPut m =>
Map ForeignFunc Text -> Code -> m ()
putCode Map ForeignFunc Text
fops Code
co)
  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) =>
  Map ForeignFunc Text ->
  Reference ->
  SuperGroup v ->
  L.ByteString
serializeGroupForRehash :: forall v.
Var v =>
Map ForeignFunc Text -> Reference -> SuperGroup v -> ByteString
serializeGroupForRehash Map ForeignFunc Text
_ (Builtin Text
_) SuperGroup v
_ =
  String -> ByteString
forall a. HasCallStack => String -> a
error String
"serializeForRehash: builtin reference"
serializeGroupForRehash Map ForeignFunc 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 -> Map ForeignFunc Text -> SuperGroup v -> Put
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Map ForeignFunc Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
refrep Map ForeignFunc 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
>>= Version -> m Value
forall (m :: * -> *). MonadGet m => Version -> m Value
getValue (Version -> m Value) -> (Word32 -> Version) -> Word32 -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Version
Transfer
  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 -> ShowS
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 -> ShowS
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 -> ShowS
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
*> Version -> Value -> Put
forall (m :: * -> *). MonadPut m => Version -> Value -> m ()
putValue (Word32 -> Version
Transfer Word32
valueVersion) Value
v)
  where
    putVersion :: Put
putVersion = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
valueVersion

-- This serializer is used exclusively for hashing unison values.
-- For this reason, it doesn't prefix the string with the current
-- version, so that only genuine changes in the way things are
-- serialized will change hashes.
--
-- The 4 prefix is used because we were previously including the
-- version in the hash, so to maintain the same hashes, we need to
-- include the extra bytes that were previously there.
--
-- Additionally, any major serialization changes should consider
-- retaining this representation as much as possible, even if it
-- becomes a separate format, because there is no need to parse from
-- the hash serialization, just generate and hash it.
serializeValueForHash :: Value -> L.ByteString
serializeValueForHash :: Value -> ByteString
serializeValueForHash Value
v = Put -> ByteString
runPutLazy (Put
putPrefix Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Version -> Value -> Put
forall (m :: * -> *). MonadPut m => Version -> Value -> m ()
putValue (Word32 -> Version
Hash Word32
4) Value
v)
  where
    putPrefix :: Put
putPrefix = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
4

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

codeVersion :: Word32
codeVersion :: Word32
codeVersion = Word32
3