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

module Unison.Runtime.ANF.Serialize where

import Control.Monad
import Control.Monad.Reader
import Control.Monad.State.Strict (StateT (..))
import Data.Bifunctor (bimap, first)
import Data.Binary.Get (runGetOrFail)
import Data.Binary.Get qualified as BGet
import Data.Binary.Put qualified as BPut
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 (toList, traverse_)
import Data.Functor ((<&>))
import Data.Map as Map (Map, fromDistinctAscList, fromList, lookup)
-- machinery for special casing maps
import Data.Map.Strict.Internal (Map (..))
import Data.Maybe (mapMaybe)
import Data.Serialize.Get qualified as SGet
import Data.Serialize.Put (runPutLazy)
import Data.Serialize.Put qualified as SPut
import Data.Word (Word16, Word32, Word64)
import GHC.IsList qualified (fromList)
import GHC.Stack
import Unison.ABT.Normalized (Term (..))
import Unison.Builtin.Decls (mapBin, mapRef, mapTip)
import Unison.Reference (Reference, Reference' (Builtin), pattern Derived)
import Unison.Runtime.ANF as ANF hiding (Tag)
import Unison.Runtime.ANF.Optimize as ANF
import Unison.Runtime.ANF.Serialize.CodeV4 qualified as CodeV4
import Unison.Runtime.ANF.Serialize.Tags
import Unison.Runtime.ANF.Serialize.ValueV5 qualified as ValueV5
import Unison.Runtime.Exception (die, exn)
import Unison.Runtime.Foreign.Function.Type (ForeignFunc)
import Unison.Runtime.Referenced
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 -> [Char]
(Int -> Version -> ShowS)
-> (Version -> [Char]) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> [Char]
show :: Version -> [Char]
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show)

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

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

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 = [Word] -> [Char] -> m ()
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"putVar: variable not in context"

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

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

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

putCCs :: (MonadPut m) => [Mem] -> m ()
putCCs :: forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs = Int -> m ()
forall (m :: * -> *) n.
(MonadPut m, Integral n, Integral (Unsigned n), Bits n,
 Bits (Unsigned n)) =>
n -> m ()
putLength Int
n m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Mem -> m ()) -> [Mem] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Mem -> m ()
forall {m :: * -> *}. MonadPut m => Mem -> m ()
putCC [Mem]
ccs
  where
    n :: Int
n = [Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs
    putCC :: Mem -> m ()
putCC Mem
UN = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0
    putCC Mem
BX = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
1

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

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

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

putCode :: (MonadPut m) => Bool -> Code Reference -> m ()
putCode :: forall (m :: * -> *). MonadPut m => Bool -> Code Reference -> m ()
putCode Bool
fops (CodeRep SuperGroup Reference Symbol
g Cacheability
c) = Map Reference Word64 -> Bool -> SuperGroup Reference Symbol -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> SuperGroup Reference v -> m ()
putGroup Map Reference Word64
forall a. Monoid a => a
mempty Bool
fops SuperGroup Reference 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, SerialConfig m) => m (Code Reference)
getCode :: forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Code Reference)
getCode = SuperGroup Reference Symbol -> Cacheability -> Code Reference
forall ref. SuperGroup ref Symbol -> Cacheability -> Code ref
CodeRep (SuperGroup Reference Symbol -> Cacheability -> Code Reference)
-> m (SuperGroup Reference Symbol)
-> m (Cacheability -> Code Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (SuperGroup Reference Symbol)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
m (SuperGroup Reference v)
getGroup m (Cacheability -> Code Reference)
-> m Cacheability -> m (Code Reference)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Cacheability
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m Cacheability
getCacheability

putInlineInfo ::
  (MonadPut m, Var v) =>
  [v] ->
  InlineInfo Reference v ->
  m ()
putInlineInfo :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
[v] -> InlineInfo Reference v -> m ()
putInlineInfo [v]
ctx (InlInfo InlineClass
clazz ANormal Reference v
expr) =
  InlineClass -> m ()
forall (m :: * -> *). MonadPut m => InlineClass -> m ()
putInlineClass InlineClass
clazz 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] -> ANormal Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
[v] -> ANormal Reference v -> m ()
putInlineExpr [v]
ctx ANormal Reference v
expr

getInlineInfo ::
  (MonadGet m, SerialConfig m, Var v) =>
  [v] ->
  Word64 ->
  m (InlineInfo Reference v)
getInlineInfo :: forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (InlineInfo Reference v)
getInlineInfo [v]
ctx Word64
frsh =
  InlineClass -> ANormal Reference v -> InlineInfo Reference v
forall ref v. InlineClass -> ANormal ref v -> InlineInfo ref v
InlInfo (InlineClass -> ANormal Reference v -> InlineInfo Reference v)
-> m InlineClass
-> m (ANormal Reference v -> InlineInfo Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InlineClass
forall (m :: * -> *). MonadGet m => m InlineClass
getInlineClass m (ANormal Reference v -> InlineInfo Reference v)
-> m (ANormal Reference v) -> m (InlineInfo Reference 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 Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference v)
getInlineExpr [v]
ctx Word64
frsh

putInlineExpr ::
  (MonadPut m, Var v) =>
  [v] ->
  ANormal Reference v ->
  m ()
putInlineExpr :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
[v] -> ANormal Reference v -> m ()
putInlineExpr [v]
ctx (TAbss [v]
vs Term (ANormalF Reference) v
body) =
  Int -> m ()
forall (m :: * -> *) n.
(MonadPut m, Integral n, Integral (Unsigned n), Bits n,
 Bits (Unsigned n)) =>
n -> m ()
putLength ([v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs)
    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
-> Bool -> [v] -> Term (ANormalF Reference) v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
forall a. Monoid a => a
mempty Bool
True ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
vs [v]
ctx) Term (ANormalF Reference) v
body

getInlineExpr ::
  (MonadGet m, SerialConfig m, Var v) =>
  [v] ->
  Word64 ->
  m (ANormal Reference v)
getInlineExpr :: forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference v)
getInlineExpr [v]
ctx Word64
frsh0 = do
  Int
n <- m Int
forall (m :: * -> *) n.
(MonadGet m, Integral n, Integral (Unsigned n), Bits n,
 Bits (Unsigned n)) =>
m n
getLength
  let 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
n
      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
n [Word64
frsh0 ..]
  [v] -> ANormal Reference v -> ANormal Reference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v]
vs (ANormal Reference v -> ANormal Reference v)
-> m (ANormal Reference v) -> m (ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
vs [v]
ctx) Word64
frsh

putOptInfos :: (MonadPut m, Var v) => OptInfos Reference v -> m ()
putOptInfos :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
OptInfos Reference v -> m ()
putOptInfos (Arities Reference
arities, InlineInfos Reference v
inls) =
  (Reference -> m ()) -> (Int -> m ()) -> Arities Reference -> 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 Int -> m ()
pInt Arities Reference
arities
    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 ())
-> (InlineInfo Reference v -> m ())
-> InlineInfos Reference 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 ([v] -> InlineInfo Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
[v] -> InlineInfo Reference v -> m ()
putInlineInfo []) InlineInfos Reference v
inls
  where
    pInt :: Int -> m ()
pInt = VarInt Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => VarInt Int -> m ()
serialize (VarInt Int -> m ()) -> (Int -> VarInt Int) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VarInt Int
forall n. n -> VarInt n
VarInt

-- Note: current version
getOptInfos :: (MonadGet m, Var v) => m (OptInfos Reference v)
getOptInfos :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
m (OptInfos Reference v)
getOptInfos =
  (ReaderT (Version, Bool) m (OptInfos Reference v)
 -> (Version, Bool) -> m (OptInfos Reference v))
-> (Version, Bool)
-> ReaderT (Version, Bool) m (OptInfos Reference v)
-> m (OptInfos Reference v)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (Version, Bool) m (OptInfos Reference v)
-> (Version, Bool) -> m (OptInfos Reference v)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Word32 -> Version
Transfer Word32
codeVersion, Bool
True) (ReaderT (Version, Bool) m (OptInfos Reference v)
 -> m (OptInfos Reference v))
-> ReaderT (Version, Bool) m (OptInfos Reference v)
-> m (OptInfos Reference v)
forall a b. (a -> b) -> a -> b
$
    (,)
      (Arities Reference
 -> InlineInfos Reference v -> OptInfos Reference v)
-> ReaderT (Version, Bool) m (Arities Reference)
-> ReaderT
     (Version, Bool) m (InlineInfos Reference v -> OptInfos Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Version, Bool) m Reference
-> ReaderT (Version, Bool) m Int
-> ReaderT (Version, Bool) m (Arities Reference)
forall (m :: * -> *) a b.
(MonadGet m, Ord a) =>
m a -> m b -> m (Map a b)
getMap ReaderT (Version, Bool) m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference ReaderT (Version, Bool) m Int
gInt
      ReaderT
  (Version, Bool) m (InlineInfos Reference v -> OptInfos Reference v)
-> ReaderT (Version, Bool) m (InlineInfos Reference v)
-> ReaderT (Version, Bool) m (OptInfos Reference v)
forall a b.
ReaderT (Version, Bool) m (a -> b)
-> ReaderT (Version, Bool) m a -> ReaderT (Version, Bool) m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (Version, Bool) m Reference
-> ReaderT (Version, Bool) m (InlineInfo Reference v)
-> ReaderT (Version, Bool) m (InlineInfos Reference v)
forall (m :: * -> *) a b.
(MonadGet m, Ord a) =>
m a -> m b -> m (Map a b)
getMap ReaderT (Version, Bool) m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference ([v] -> Word64 -> ReaderT (Version, Bool) m (InlineInfo Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (InlineInfo Reference v)
getInlineInfo [] Word64
0)
  where
    gInt :: ReaderT (Version, Bool) m Int
gInt = VarInt Int -> Int
forall n. VarInt n -> n
unVarInt (VarInt Int -> Int)
-> ReaderT (Version, Bool) m (VarInt Int)
-> ReaderT (Version, Bool) m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Version, Bool) m (VarInt Int)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (VarInt Int)
deserialize

putInlineClass :: (MonadPut m) => InlineClass -> m ()
putInlineClass :: forall (m :: * -> *). MonadPut m => InlineClass -> m ()
putInlineClass = \case
  InlineClass
AnywhereInl -> Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0
  InlineClass
TailInl -> Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
1
  InlineClass
Don'tInl -> Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
2

getInlineClass :: (MonadGet m) => m InlineClass
getInlineClass :: forall (m :: * -> *). MonadGet m => m InlineClass
getInlineClass =
  m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m InlineClass) -> m InlineClass
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 -> InlineClass -> m InlineClass
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InlineClass
AnywhereInl
    Word8
1 -> InlineClass -> m InlineClass
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InlineClass
TailInl
    Word8
2 -> InlineClass -> m InlineClass
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InlineClass
Don'tInl
    Word8
n -> [Char] -> Word8 -> m InlineClass
forall (m :: * -> *) a. MonadGet m => [Char] -> Word8 -> m a
unknownTag [Char]
"InlineClass" Word8
n

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, SerialConfig m) => m Cacheability
getCacheability :: forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m Cacheability
getCacheability =
  m Version
forall (m :: * -> *). SerialConfig m => m Version
askVersion m Version -> (Version -> 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
    Transfer Word32
v
      | Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
3 ->
          m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m Cacheability) -> m Cacheability
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Word8
0 -> Cacheability -> m Cacheability
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cacheability
Uncacheable
            Word8
1 -> Cacheability -> m Cacheability
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cacheability
Cacheable
            Word8
n -> [Word] -> [Char] -> m Cacheability
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] ([Char] -> m Cacheability) -> [Char] -> m Cacheability
forall a b. (a -> b) -> a -> b
$ [Char]
"getBLit: unrecognized cacheability byte: " [Char] -> ShowS
forall v. [v] -> [v] -> [v]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
n
    Version
_ -> Cacheability -> m Cacheability
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cacheability
Uncacheable

putComb ::
  (MonadPut m) =>
  (Var v) =>
  Map Reference Word64 ->
  Bool ->
  [v] ->
  SuperNormal Reference v ->
  m ()
putComb :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Bool -> [v] -> SuperNormal Reference v -> m ()
putComb Map Reference Word64
refrep Bool
fops [v]
ctx (Lambda [Mem]
ccs (TAbss [v]
us Term (ANormalF Reference) 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
-> Bool -> [v] -> Term (ANormalF Reference) v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
refrep Bool
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Term (ANormalF Reference) 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) =>
  (SerialConfig m) =>
  (Var v) =>
  [v] ->
  Word64 ->
  m (SuperNormal Reference v)
getComb :: forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (SuperNormal Reference 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 Reference v -> SuperNormal Reference v
forall ref v. [Mem] -> ANormal ref v -> SuperNormal ref v
Lambda [Mem]
ccs (ANormal Reference v -> SuperNormal Reference v)
-> (ANormal Reference v -> ANormal Reference v)
-> ANormal Reference v
-> SuperNormal Reference v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal Reference v -> ANormal Reference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v]
us (ANormal Reference v -> SuperNormal Reference v)
-> m (ANormal Reference v) -> m (SuperNormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference 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 ->
  Bool ->
  [v] ->
  ANormal Reference v ->
  m ()
putNormal :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx ANormal Reference v
tm = case ANormal Reference 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 Reference 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 -> Bool -> [v] -> Func Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> Func Reference v -> m ()
putFunc Map Reference Word64
refrep Bool
fops [v]
ctx Func Reference 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
nh Maybe v
_ah ANormal Reference 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
nh
      m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx ANormal Reference v
e
  TShift Reference
r v
v ANormal Reference 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 -> Bool -> [v] -> ANormal Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
refrep Bool
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal Reference v
e
  TMatch v
v Branched Reference (ANormal Reference 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
-> Bool -> [v] -> Branched Reference (ANormal Reference v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> Bool -> [v] -> Branched Reference (ANormal Reference v) -> m ()
putBranches Map Reference Word64
refrep Bool
fops [v]
ctx Branched Reference (ANormal Reference v)
bs
  TLit Lit Reference
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 Reference -> m ()
forall (m :: * -> *). MonadPut m => Lit Reference -> m ()
putLit Lit Reference
l
  TBLit Lit Reference
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 Reference -> m ()
forall (m :: * -> *). MonadPut m => Lit Reference -> m ()
putLit Lit Reference
l
  TName v
v (Left Reference
r) [v]
as ANormal Reference 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 -> Bool -> [v] -> ANormal Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
refrep Bool
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal Reference 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 Reference 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 -> Bool -> [v] -> ANormal Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
refrep Bool
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal Reference v
e
  TLets Direction Word16
Direct [v]
us [Mem]
ccs ANormal Reference v
l ANormal Reference 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 -> Bool -> [v] -> ANormal Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx ANormal Reference 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 -> Bool -> [v] -> ANormal Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
refrep Bool
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal Reference v
e
  TLets (Indirect Word16
w) [v]
us [Mem]
ccs ANormal Reference v
l ANormal Reference 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 -> Bool -> [v] -> ANormal Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx ANormal Reference 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 -> Bool -> [v] -> ANormal Reference v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> ANormal Reference v -> m ()
putNormal Map Reference Word64
refrep Bool
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal Reference v
e
  ANormal Reference v
v -> [Word] -> [Char] -> m ()
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"putNormal: malformed term\n" [Char] -> ShowS
forall v. [v] -> [v] -> [v]
++ ANormal Reference v -> [Char]
forall a. Show a => a -> [Char]
show ANormal Reference v
v

getNormal ::
  (MonadGet m) =>
  (SerialConfig m) =>
  (Var v) =>
  [v] ->
  Word64 ->
  m (ANormal Reference v)
getNormal :: forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference v)
getNormal [v]
ctx Word64
frsh0 =
  m TmTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m TmTag
-> (TmTag -> m (ANormal Reference v)) -> m (ANormal Reference 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 Reference v
forall v ref. Var v => v -> ANormal ref v
TVar (v -> ANormal Reference v) -> m v -> m (ANormal Reference 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 Reference v
forall v ref. Var v => v -> ANormal ref v
TFrc (v -> ANormal Reference v) -> m v -> m (ANormal Reference 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 Reference v -> [v] -> ANormal Reference v
forall v ref. Var v => Func ref v -> [v] -> ANormal ref v
TApp (Func Reference v -> [v] -> ANormal Reference v)
-> m (Func Reference v) -> m ([v] -> ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m (Func Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> m (Func Reference v)
getFunc [v]
ctx m ([v] -> ANormal Reference v) -> m [v] -> m (ANormal Reference 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 -> Maybe v -> ANormal Reference v -> ANormal Reference v
forall v ref.
Var v =>
[ref] -> v -> Maybe v -> ANormal ref v -> ANormal ref v
THnd
        ([Reference]
 -> v -> Maybe v -> ANormal Reference v -> ANormal Reference v)
-> m [Reference]
-> m (v -> Maybe v -> ANormal Reference v -> ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Reference]
forall (m :: * -> *). MonadGet m => m [Reference]
getRefs
        m (v -> Maybe v -> ANormal Reference v -> ANormal Reference v)
-> m v -> m (Maybe v -> ANormal Reference v -> ANormal Reference v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
        m (Maybe v -> ANormal Reference v -> ANormal Reference v)
-> m (Maybe v) -> m (ANormal Reference v -> ANormal Reference v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe v -> m (Maybe v)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe v
forall a. Maybe a
Nothing
        m (ANormal Reference v -> ANormal Reference v)
-> m (ANormal Reference v) -> m (ANormal Reference 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 Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference v)
getNormal [v]
ctx Word64
frsh0
    TmTag
ShiftT ->
      (Reference -> v -> ANormal Reference v -> ANormal Reference v)
-> v -> Reference -> ANormal Reference v -> ANormal Reference v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reference -> v -> ANormal Reference v -> ANormal Reference v
forall v ref. Var v => ref -> v -> ANormal ref v -> ANormal ref v
TShift v
v (Reference -> ANormal Reference v -> ANormal Reference v)
-> m Reference -> m (ANormal Reference v -> ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (ANormal Reference v -> ANormal Reference v)
-> m (ANormal Reference v) -> m (ANormal Reference 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 Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference 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 Reference (ANormal Reference v) -> ANormal Reference v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch (v
 -> Branched Reference (ANormal Reference v) -> ANormal Reference v)
-> m v
-> m (Branched Reference (ANormal Reference v)
      -> ANormal Reference 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 Reference (ANormal Reference v) -> ANormal Reference v)
-> m (Branched Reference (ANormal Reference v))
-> m (ANormal Reference 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 Reference (ANormal Reference v))
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (Branched Reference (ANormal Reference v))
getBranches [v]
ctx Word64
frsh0
    TmTag
LitT -> Lit Reference -> ANormal Reference v
forall v ref. Var v => Lit ref -> ANormal ref v
TLit (Lit Reference -> ANormal Reference v)
-> m (Lit Reference) -> m (ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Lit Reference)
forall (m :: * -> *). MonadGet m => m (Lit Reference)
getLit
    TmTag
BxLitT -> Lit Reference -> ANormal Reference v
forall v ref. Var v => Lit ref -> ANormal ref v
TBLit (Lit Reference -> ANormal Reference v)
-> m (Lit Reference) -> m (ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Lit Reference)
forall (m :: * -> *). MonadGet m => m (Lit Reference)
getLit
    TmTag
NameRefT ->
      v
-> Either Reference v
-> [v]
-> ANormal Reference v
-> ANormal Reference v
forall v ref.
Var v =>
v -> Either ref v -> [v] -> ANormal ref v -> ANormal ref v
TName v
v (Either Reference v
 -> [v] -> ANormal Reference v -> ANormal Reference v)
-> (Reference -> Either Reference v)
-> Reference
-> [v]
-> ANormal Reference v
-> ANormal Reference 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 Reference v -> ANormal Reference v)
-> m Reference
-> m ([v] -> ANormal Reference v -> ANormal Reference 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 Reference v -> ANormal Reference v)
-> m [v] -> m (ANormal Reference v -> ANormal Reference 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 Reference v -> ANormal Reference v)
-> m (ANormal Reference v) -> m (ANormal Reference 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 Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference 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 Reference v
-> ANormal Reference v
forall v ref.
Var v =>
v -> Either ref v -> [v] -> ANormal ref v -> ANormal ref v
TName v
v (Either Reference v
 -> [v] -> ANormal Reference v -> ANormal Reference v)
-> (v -> Either Reference v)
-> v
-> [v]
-> ANormal Reference v
-> ANormal Reference 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 Reference v -> ANormal Reference v)
-> m v -> m ([v] -> ANormal Reference v -> ANormal Reference 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 Reference v -> ANormal Reference v)
-> m [v] -> m (ANormal Reference v -> ANormal Reference 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 Reference v -> ANormal Reference v)
-> m (ANormal Reference v) -> m (ANormal Reference 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 Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference 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 Reference v
-> ANormal Reference v
-> ANormal Reference v
forall v ref.
Var v =>
Direction Word16
-> [v] -> [Mem] -> ANormal ref v -> ANormal ref v -> ANormal ref v
TLets Direction Word16
forall a. Direction a
Direct [v]
us [Mem]
ccs
        (ANormal Reference v -> ANormal Reference v -> ANormal Reference v)
-> m (ANormal Reference v)
-> m (ANormal Reference v -> ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference v)
getNormal [v]
ctx Word64
frsh0
        m (ANormal Reference v -> ANormal Reference v)
-> m (ANormal Reference v) -> m (ANormal Reference 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 Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference 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 Reference v
-> ANormal Reference v
-> ANormal Reference v
forall v ref.
Var v =>
Direction Word16
-> [v] -> [Mem] -> ANormal ref v -> ANormal ref v -> ANormal ref v
TLets (Word16 -> Direction Word16
forall a. a -> Direction a
Indirect Word16
w) [v]
us [Mem]
ccs
        (ANormal Reference v -> ANormal Reference v -> ANormal Reference v)
-> m (ANormal Reference v)
-> m (ANormal Reference v -> ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference v)
getNormal [v]
ctx Word64
frsh0
        m (ANormal Reference v -> ANormal Reference v)
-> m (ANormal Reference v) -> m (ANormal Reference 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 Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference 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 ->
  Bool ->
  [v] ->
  Func Reference v ->
  m ()
putFunc :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> [v] -> Func Reference v -> m ()
putFunc Map Reference Word64
refrep Bool
allowFop [v]
ctx Func Reference v
f = case Func Reference 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)
    | Bool
allowFop -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FForeignT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ForeignFunc -> m ()
forall (m :: * -> *). MonadPut m => ForeignFunc -> m ()
putFOp ForeignFunc
f
    | Bool
otherwise ->
        [Word] -> [Char] -> m ()
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"putFunc: could not serialize foreign operation: " [Char] -> ShowS
forall v. [v] -> [v] -> [v]
++ ForeignFunc -> [Char]
forall a. Show a => a -> [Char]
show ForeignFunc
f

getFunc ::
  (MonadGet m, SerialConfig m, Var v) => [v] -> m (Func Reference v)
getFunc :: forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> m (Func Reference v)
getFunc [v]
ctx =
  m Bool
forall (m :: * -> *). SerialConfig m => m Bool
askFOp m Bool -> (Bool -> m (Func Reference v)) -> m (Func Reference v)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
allowFOp ->
    m FnTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m FnTag -> (FnTag -> m (Func Reference v)) -> m (Func Reference 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 Reference v
forall ref v. v -> Func ref v
FVar (v -> Func Reference v) -> m v -> m (Func Reference 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 Reference v
forall ref v. ref -> Func ref v
FComb (Reference -> Func Reference v)
-> m Reference -> m (Func Reference 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 Reference v
forall ref v. v -> Func ref v
FCont (v -> Func Reference v) -> m v -> m (Func Reference 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 Reference v
forall ref v. ref -> CTag -> Func ref v
FCon (Reference -> CTag -> Func Reference v)
-> m Reference -> m (CTag -> Func Reference 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 Reference v) -> m CTag -> m (Func Reference 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 Reference v
forall ref v. ref -> CTag -> Func ref v
FReq (Reference -> CTag -> Func Reference v)
-> m Reference -> m (CTag -> Func Reference 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 Reference v) -> m CTag -> m (Func Reference 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 Reference v
forall ref v. Either POp ForeignFunc -> Func ref v
FPrim (Either POp ForeignFunc -> Func Reference v)
-> (POp -> Either POp ForeignFunc) -> POp -> Func Reference 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 Reference v) -> m POp -> m (Func Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m POp
forall (m :: * -> *). MonadGet m => m POp
getPOp
      FnTag
FForeignT
        | Bool
allowFOp -> Either POp ForeignFunc -> Func Reference v
forall ref v. Either POp ForeignFunc -> Func ref v
FPrim (Either POp ForeignFunc -> Func Reference v)
-> (ForeignFunc -> Either POp ForeignFunc)
-> ForeignFunc
-> Func Reference v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignFunc -> Either POp ForeignFunc
forall a b. b -> Either a b
Right (ForeignFunc -> Func Reference v)
-> m ForeignFunc -> m (Func Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ForeignFunc
forall (m :: * -> *). MonadGet m => m ForeignFunc
getFOp
        | Bool
otherwise -> [Word] -> [Char] -> m (Func Reference v)
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"getFunc: can't deserialize a foreign func"

-- Note: this numbering is derived, and so not particularly stable.
-- However, foreign functions are not serialized for interchange. This
-- is for serializing optimization information for standalaone
-- programs.
putFOp :: (MonadPut m) => ForeignFunc -> m ()
putFOp :: forall (m :: * -> *). MonadPut m => ForeignFunc -> m ()
putFOp = VarInt Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => VarInt Int -> m ()
serialize (VarInt Int -> m ())
-> (ForeignFunc -> VarInt Int) -> ForeignFunc -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VarInt Int
forall n. n -> VarInt n
VarInt (Int -> VarInt Int)
-> (ForeignFunc -> Int) -> ForeignFunc -> VarInt Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignFunc -> Int
forall a. Enum a => a -> Int
fromEnum

getFOp :: (MonadGet m) => m ForeignFunc
getFOp :: forall (m :: * -> *). MonadGet m => m ForeignFunc
getFOp = Int -> ForeignFunc
forall a. Enum a => Int -> a
toEnum (Int -> ForeignFunc)
-> (VarInt Int -> Int) -> VarInt Int -> ForeignFunc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt Int -> Int
forall n. VarInt n -> n
unVarInt (VarInt Int -> ForeignFunc) -> m (VarInt Int) -> m ForeignFunc
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

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

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

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 Reference -> m ()
putLit :: forall (m :: * -> *). MonadPut m => Lit Reference -> 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' Reference
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' Reference -> m ()
forall (m :: * -> *). MonadPut m => Referent' Reference -> m ()
putReferent Referent' Reference
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 Reference)
getLit :: forall (m :: * -> *). MonadGet m => m (Lit Reference)
getLit =
  m LtTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m LtTag -> (LtTag -> m (Lit Reference)) -> m (Lit Reference)
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 Reference
forall ref. Int64 -> Lit ref
I (Int64 -> Lit Reference) -> m Int64 -> m (Lit Reference)
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 Reference
forall ref. Word64 -> Lit ref
N (Word64 -> Lit Reference) -> m Word64 -> m (Lit Reference)
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 Reference
forall ref. Double -> Lit ref
F (Double -> Lit Reference) -> m Double -> m (Lit Reference)
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 Reference
forall ref. Text -> Lit ref
T (Text -> Lit Reference) -> (Text -> Text) -> Text -> Lit Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.fromText (Text -> Lit Reference) -> m Text -> m (Lit Reference)
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 Reference
forall ref. Char -> Lit ref
C (Char -> Lit Reference) -> m Char -> m (Lit Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall (m :: * -> *). MonadGet m => m Char
getChar
    LtTag
LMT -> Referent' Reference -> Lit Reference
forall ref. Referent' ref -> Lit ref
LM (Referent' Reference -> Lit Reference)
-> m (Referent' Reference) -> m (Lit Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Referent' Reference)
forall (m :: * -> *). MonadGet m => m (Referent' Reference)
getReferent
    LtTag
LYT -> Reference -> Lit Reference
forall ref. ref -> Lit ref
LY (Reference -> Lit Reference) -> m Reference -> m (Lit Reference)
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 Reference -> m ()
putBLit :: forall (m :: * -> *).
MonadPut m =>
Version -> BLit Reference -> 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 Reference)
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 Reference -> m ()) -> Seq (Value Reference) -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable (Version -> Value Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v) Seq (Value Reference)
s
putBLit Version
_ (TmLink Referent' Reference
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' Reference -> m ()
forall (m :: * -> *). MonadPut m => Referent' Reference -> m ()
putReferent Referent' Reference
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 Reference
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 Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v Value Reference
vl
putBLit Version
v (Code (CodeRep SuperGroup Reference 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 -> Bool -> SuperGroup Reference Symbol -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> SuperGroup Reference v -> m ()
putGroup Map Reference Word64
forall a. Monoid a => a
mempty Bool
False SuperGroup Reference 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 Reference)
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 Reference -> m ()) -> Array (Value Reference) -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable (Version -> Value Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v) Array (Value Reference)
a
putBLit Version
_ (Map [(Value Reference, Value Reference)]
_) = [Word] -> [Char] -> m ()
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"putBLit: impossible Map"
{-# SPECIALIZE putBLit :: Version -> BLit Reference -> BPut.Put #-}
{-# SPECIALIZE putBLit :: Version -> BLit Reference -> SPut.Put #-}

-- special function for serializing a list of pairs as a Unison map.
-- This allows us to avoid inflating the map to a unison value during
-- the interpreter->interchange step, which is expensive.
--
-- It is assumed that the list is in ascending order. We always
-- produce an ascending map during reflection, but if you deserialize
-- a non-ascending list and re-serialize using an old version, you
-- will get an invalid map. However, you might also just receive an
-- invalid serialized map.
putAsMap ::
  (MonadPut m) => Version -> [(Value Reference, Value Reference)] -> m ()
putAsMap :: forall (m :: * -> *).
MonadPut m =>
Version -> [(Value Reference, Value Reference)] -> m ()
putAsMap Version
v = Map (Value Reference) (Value Reference) -> m ()
putter (Map (Value Reference) (Value Reference) -> m ())
-> ([(Value Reference, Value Reference)]
    -> Map (Value Reference) (Value Reference))
-> [(Value Reference, Value Reference)]
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Value Reference, Value Reference)]
-> Map (Value Reference) (Value Reference)
forall k a. [(k, a)] -> Map k a
fromDistinctAscList
  where
    putter :: Map (Value Reference) (Value Reference) -> m ()
putter Map (Value Reference) (Value Reference)
Tip =
      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
mapRef
        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
mapTip
        m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> m ()
forall (m :: * -> *) n.
(MonadPut m, Integral n, Integral (Unsigned n), Bits n,
 Bits (Unsigned n)) =>
n -> m ()
putLength (Int
0 :: Int) -- subfields
    putter (Bin Int
sz Value Reference
k Value Reference
e Map (Value Reference) (Value Reference)
l Map (Value Reference) (Value Reference)
r) =
      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
mapRef
        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
mapBin
        m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> m ()
forall (m :: * -> *) n.
(MonadPut m, Integral n, Integral (Unsigned n), Bits n,
 Bits (Unsigned n)) =>
n -> m ()
putLength (Int
5 :: Int)
        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 Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v (BLit Reference -> Value Reference
forall ref. BLit ref -> Value ref
BLit (BLit Reference -> Value Reference)
-> (Word64 -> BLit Reference) -> Word64 -> Value Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> BLit Reference
forall ref. Word64 -> BLit ref
Pos (Word64 -> Value Reference) -> Word64 -> Value Reference
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
        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 Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v Value Reference
k
        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 Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v Value Reference
e
        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 (Value Reference) (Value Reference) -> m ()
putter Map (Value Reference) (Value Reference)
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 (Value Reference) (Value Reference) -> m ()
putter Map (Value Reference) (Value Reference)
r
{-# SPECIALIZE putAsMap ::
  Version -> [(Value Reference, Value Reference)] -> BPut.Put
  #-}
{-# SPECIALIZE putAsMap ::
  Version -> [(Value Reference, Value Reference)] -> SPut.Put
  #-}

getBLit :: (MonadGet m, SerialConfig m) => m (BLit Reference)
getBLit :: forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (BLit Reference)
getBLit =
  m BLTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m BLTag -> (BLTag -> m (BLit Reference)) -> m (BLit Reference)
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 Reference
forall ref. Text -> BLit ref
Text (Text -> BLit Reference)
-> (Text -> Text) -> Text -> BLit Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.fromText (Text -> BLit Reference) -> m Text -> m (BLit Reference)
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 Reference) -> BLit Reference
forall ref. Seq (Value ref) -> BLit ref
List (Seq (Value Reference) -> BLit Reference)
-> m (Seq (Value Reference)) -> m (BLit Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Value Reference) -> m (Seq (Value Reference))
forall (m :: * -> *) a. MonadGet m => m a -> m (Seq a)
getSeq m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
    BLTag
TmLinkT -> Referent' Reference -> BLit Reference
forall ref. Referent' ref -> BLit ref
TmLink (Referent' Reference -> BLit Reference)
-> m (Referent' Reference) -> m (BLit Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Referent' Reference)
forall (m :: * -> *). MonadGet m => m (Referent' Reference)
getReferent
    BLTag
TyLinkT -> Reference -> BLit Reference
forall ref. ref -> BLit ref
TyLink (Reference -> BLit Reference) -> m Reference -> m (BLit Reference)
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 Reference
forall ref. Bytes -> BLit ref
Bytes (Bytes -> BLit Reference) -> m Bytes -> m (BLit Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bytes
forall (m :: * -> *). MonadGet m => m Bytes
getBytes
    BLTag
QuoteT -> Value Reference -> BLit Reference
forall ref. Value ref -> BLit ref
Quote (Value Reference -> BLit Reference)
-> m (Value Reference) -> m (BLit Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
    BLTag
CodeT ->
      Code Reference -> BLit Reference
forall ref. Code ref -> BLit ref
Code (Code Reference -> BLit Reference)
-> (SuperGroup Reference Symbol -> Code Reference)
-> SuperGroup Reference Symbol
-> BLit Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperGroup Reference Symbol -> Cacheability -> Code Reference)
-> Cacheability -> SuperGroup Reference Symbol -> Code Reference
forall a b c. (a -> b -> c) -> b -> a -> c
flip SuperGroup Reference Symbol -> Cacheability -> Code Reference
forall ref. SuperGroup ref Symbol -> Cacheability -> Code ref
CodeRep Cacheability
Uncacheable (SuperGroup Reference Symbol -> BLit Reference)
-> m (SuperGroup Reference Symbol) -> m (BLit Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (SuperGroup Reference Symbol) -> m (SuperGroup Reference Symbol)
forall (m :: * -> *) r. SerialConfig m => m r -> m r
withCodeVersion m (SuperGroup Reference Symbol)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
m (SuperGroup Reference v)
getGroup
    BLTag
BArrT -> ByteArray -> BLit Reference
forall ref. ByteArray -> BLit ref
BArr (ByteArray -> BLit Reference) -> m ByteArray -> m (BLit Reference)
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 Reference
forall ref. Word64 -> BLit ref
Pos (Word64 -> BLit Reference) -> m Word64 -> m (BLit Reference)
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 Reference
forall ref. Word64 -> BLit ref
Neg (Word64 -> BLit Reference) -> m Word64 -> m (BLit Reference)
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 Reference
forall ref. Char -> BLit ref
Char (Char -> BLit Reference) -> m Char -> m (BLit Reference)
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 Reference
forall ref. Double -> BLit ref
Float (Double -> BLit Reference) -> m Double -> m (BLit Reference)
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 Reference) -> BLit Reference
forall ref. Array (Value ref) -> BLit ref
Arr (Array (Value Reference) -> BLit Reference)
-> ([Value Reference] -> Array (Value Reference))
-> [Value Reference]
-> BLit Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (Array (Value Reference))] -> Array (Value Reference)
[Value Reference] -> Array (Value Reference)
forall l. IsList l => [Item l] -> l
GHC.IsList.fromList ([Value Reference] -> BLit Reference)
-> m [Value Reference] -> m (BLit Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Value Reference) -> m [Value Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
    BLTag
CachedCodeT -> Code Reference -> BLit Reference
forall ref. Code ref -> BLit ref
Code (Code Reference -> BLit Reference)
-> (SuperGroup Reference Symbol -> Code Reference)
-> SuperGroup Reference Symbol
-> BLit Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperGroup Reference Symbol -> Cacheability -> Code Reference)
-> Cacheability -> SuperGroup Reference Symbol -> Code Reference
forall a b c. (a -> b -> c) -> b -> a -> c
flip SuperGroup Reference Symbol -> Cacheability -> Code Reference
forall ref. SuperGroup ref Symbol -> Cacheability -> Code ref
CodeRep Cacheability
Cacheable (SuperGroup Reference Symbol -> BLit Reference)
-> m (SuperGroup Reference Symbol) -> m (BLit Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (SuperGroup Reference Symbol)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
m (SuperGroup Reference v)
getGroup
    BLTag
MapT -> [Word] -> [Char] -> m (BLit Reference)
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"getBLit: unsupported literal map"
{-# SPECIALIZE getBLit :: BDeserial (BLit Reference) #-}
{-# SPECIALIZE getBLit :: SDeserial (BLit Reference) #-}

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

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

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

getCase ::
  (MonadGet m) =>
  (SerialConfig m) =>
  (Var v) =>
  [v] ->
  Word64 ->
  m ([Mem], ANormal Reference v)
getCase :: forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal Reference 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 Reference v -> ([Mem], ANormal Reference v))
-> (ANormal Reference v -> ANormal Reference v)
-> ANormal Reference v
-> ([Mem], ANormal Reference v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal Reference v -> ANormal Reference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v]
us (ANormal Reference v -> ([Mem], ANormal Reference v))
-> m (ANormal Reference v) -> m ([Mem], ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
[v] -> Word64 -> m (ANormal Reference 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 Reference -> m ()
putGroupRef :: forall (m :: * -> *). MonadPut m => GroupRef Reference -> 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 Reference)
getGroupRef :: forall (m :: * -> *). MonadGet m => m (GroupRef Reference)
getGroupRef = Reference -> Word64 -> GroupRef Reference
forall ref. ref -> Word64 -> GroupRef ref
GR (Reference -> Word64 -> GroupRef Reference)
-> m Reference -> m (Word64 -> GroupRef Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (Word64 -> GroupRef Reference)
-> m Word64 -> m (GroupRef Reference)
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 Reference -> m ()
putValue :: forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v (Partial GroupRef Reference
gr [Value Reference]
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 Reference -> m ()
forall (m :: * -> *). MonadPut m => GroupRef Reference -> m ()
putGroupRef GroupRef Reference
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 Reference -> m ()) -> [Value Reference] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable (Version -> Value Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v) [Value Reference]
vs
putValue Version
v (Data Reference
r Word64
t [Value Reference]
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 Reference -> m ()) -> [Value Reference] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable (Version -> Value Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v) [Value Reference]
vs
putValue Version
v (Cont [Value Reference]
bs Cont Reference
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 Reference -> m ()) -> [Value Reference] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable (Version -> Value Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v) [Value Reference]
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 Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Cont Reference -> m ()
putCont Version
v Cont Reference
k
putValue Version
v (BLit (Map [(Value Reference, Value Reference)]
l)) = Version -> [(Value Reference, Value Reference)] -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> [(Value Reference, Value Reference)] -> m ()
putAsMap Version
v [(Value Reference, Value Reference)]
l
putValue Version
v (BLit BLit Reference
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 Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> BLit Reference -> m ()
putBLit Version
v BLit Reference
l
{-# SPECIALIZE putValue :: Version -> Value Reference -> BPut.Put #-}
{-# SPECIALIZE putValue :: Version -> Value Reference -> SPut.Put #-}

getValue :: (MonadGet m, SerialConfig m) => m (Value Reference)
getValue :: forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue =
  m Version
forall (m :: * -> *). SerialConfig m => m Version
askVersion m Version
-> (Version -> m (Value Reference)) -> m (Value Reference)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Version
v ->
    m VaTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m VaTag -> (VaTag -> m (Value Reference)) -> m (Value Reference)
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 Reference
gr <- m (GroupRef Reference)
forall (m :: * -> *). MonadGet m => m (GroupRef Reference)
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 Reference]
bs <- m (Value Reference) -> m [Value Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
            pure $ GroupRef Reference -> [Value Reference] -> Value Reference
forall ref. GroupRef ref -> ValList ref -> Value ref
Partial GroupRef Reference
gr [Value Reference]
bs
        | Bool
otherwise -> do
            GroupRef Reference
gr <- m (GroupRef Reference)
forall (m :: * -> *). MonadGet m => m (GroupRef Reference)
getGroupRef
            [Value Reference]
vs <- m (Value Reference) -> m [Value Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
            pure $ GroupRef Reference -> [Value Reference] -> Value Reference
forall ref. GroupRef ref -> ValList ref -> Value ref
Partial GroupRef Reference
gr [Value Reference]
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 Reference]
vs <- m (Value Reference) -> m [Value Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
            pure $ Reference -> Word64 -> [Value Reference] -> Value Reference
forall ref. ref -> Word64 -> ValList ref -> Value ref
Data Reference
r Word64
w [Value Reference]
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 Reference]
vs <- m (Value Reference) -> m [Value Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
            pure $ Reference -> Word64 -> [Value Reference] -> Value Reference
forall ref. ref -> Word64 -> ValList ref -> Value ref
Data Reference
r Word64
w [Value Reference]
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 Reference]
bs <- m (Value Reference) -> m [Value Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
            Cont Reference
k <- m (Cont Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Cont Reference)
getCont
            pure $ [Value Reference] -> Cont Reference -> Value Reference
forall ref. ValList ref -> Cont ref -> Value ref
Cont [Value Reference]
bs Cont Reference
k
        | Bool
otherwise -> do
            [Value Reference]
bs <- m (Value Reference) -> m [Value Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
            Cont Reference
k <- m (Cont Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Cont Reference)
getCont
            pure $ [Value Reference] -> Cont Reference -> Value Reference
forall ref. ValList ref -> Cont ref -> Value ref
Cont [Value Reference]
bs Cont Reference
k
      VaTag
BLitT -> BLit Reference -> Value Reference
forall ref. BLit ref -> Value ref
BLit (BLit Reference -> Value Reference)
-> m (BLit Reference) -> m (Value Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (BLit Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (BLit Reference)
getBLit
  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]
_ = [Word] -> [Char] -> m ()
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"getValue: unboxed values no longer supported"
{-# SPECIALIZE getValue :: BDeserial (Value Reference) #-}
{-# SPECIALIZE getValue :: SDeserial (Value Reference) #-}

putCont :: (MonadPut m) => Version -> Cont Reference -> m ()
putCont :: forall (m :: * -> *).
MonadPut m =>
Version -> Cont Reference -> m ()
putCont Version
_ Cont Reference
KE = CoTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag CoTag
KET
putCont Version
v (Mark Word64
a [Reference]
rs [(Reference, Value Reference)]
ds Cont Reference
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 Reference -> m ())
-> [(Reference, Value Reference)]
-> m ()
forall (m :: * -> *) a b.
MonadPut m =>
(a -> m ()) -> (b -> m ()) -> [(a, b)] -> m ()
putMapping Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference (Version -> Value Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue Version
v) [(Reference, Value Reference)]
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 Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Cont Reference -> m ()
putCont Version
v Cont Reference
k
putCont Version
v (Push Word64
f Word64
n GroupRef Reference
gr Cont Reference
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 Reference -> m ()
forall (m :: * -> *). MonadPut m => GroupRef Reference -> m ()
putGroupRef GroupRef Reference
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 Reference -> m ()
forall (m :: * -> *).
MonadPut m =>
Version -> Cont Reference -> m ()
putCont Version
v Cont Reference
k
{-# SPECIALIZE putCont :: Version -> Cont Reference -> BPut.Put #-}
{-# SPECIALIZE putCont :: Version -> Cont Reference -> SPut.Put #-}

getCont :: (MonadGet m, SerialConfig m) => m (Cont Reference)
getCont :: forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Cont Reference)
getCont =
  m Version
forall (m :: * -> *). SerialConfig m => m Version
askVersion m Version -> (Version -> m (Cont Reference)) -> m (Cont Reference)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Version
v ->
    m CoTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m CoTag -> (CoTag -> m (Cont Reference)) -> m (Cont Reference)
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 Reference -> m (Cont Reference)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cont Reference
forall ref. Cont ref
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
>>= [Char] -> Word64 -> m ()
forall {a} {f :: * -> *}.
(Eq a, Num a, Applicative f, Show a) =>
[Char] -> a -> f ()
assert0 [Char]
"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
            [(Reference, Value Reference)]
vals <- m Reference
-> m (Value Reference) -> m [(Reference, Value Reference)]
forall (m :: * -> *) a b. MonadGet m => m a -> m b -> m [(a, b)]
getMapping m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
            Cont Reference
cont <- m (Cont Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Cont Reference)
getCont
            pure $ Word64
-> [Reference]
-> [(Reference, Value Reference)]
-> Cont Reference
-> Cont Reference
forall ref.
Word64 -> [ref] -> [(ref, Value ref)] -> Cont ref -> Cont ref
Mark Word64
ba [Reference]
refs [(Reference, Value Reference)]
vals Cont Reference
cont
        | Bool
otherwise ->
            Word64
-> [Reference]
-> [(Reference, Value Reference)]
-> Cont Reference
-> Cont Reference
forall ref.
Word64 -> [ref] -> [(ref, Value ref)] -> Cont ref -> Cont ref
Mark
              (Word64
 -> [Reference]
 -> [(Reference, Value Reference)]
 -> Cont Reference
 -> Cont Reference)
-> m Word64
-> m ([Reference]
      -> [(Reference, Value Reference)]
      -> Cont Reference
      -> Cont Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
              m ([Reference]
   -> [(Reference, Value Reference)]
   -> Cont Reference
   -> Cont Reference)
-> m [Reference]
-> m ([(Reference, Value Reference)]
      -> Cont Reference -> Cont Reference)
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 ([(Reference, Value Reference)]
   -> Cont Reference -> Cont Reference)
-> m [(Reference, Value Reference)]
-> m (Cont Reference -> Cont Reference)
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 Reference) -> m [(Reference, Value Reference)]
forall (m :: * -> *) a b. MonadGet m => m a -> m b -> m [(a, b)]
getMapping m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue
              m (Cont Reference -> Cont Reference)
-> m (Cont Reference) -> m (Cont Reference)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Cont Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Cont Reference)
getCont
      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
>>= [Char] -> Word64 -> m ()
forall {a} {f :: * -> *}.
(Eq a, Num a, Applicative f, Show a) =>
[Char] -> a -> f ()
assert0 [Char]
"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
>>= [Char] -> Word64 -> m ()
forall {a} {f :: * -> *}.
(Eq a, Num a, Applicative f, Show a) =>
[Char] -> a -> f ()
assert0 [Char]
"unboxed arg size"
            Word64
ba <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            GroupRef Reference
gr <- m (GroupRef Reference)
forall (m :: * -> *). MonadGet m => m (GroupRef Reference)
getGroupRef
            Cont Reference
cont <- m (Cont Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Cont Reference)
getCont
            pure $ Word64
-> Word64 -> GroupRef Reference -> Cont Reference -> Cont Reference
forall ref.
Word64 -> Word64 -> GroupRef ref -> Cont ref -> Cont ref
Push Word64
bf Word64
ba GroupRef Reference
gr Cont Reference
cont
        | Bool
otherwise ->
            Word64
-> Word64 -> GroupRef Reference -> Cont Reference -> Cont Reference
forall ref.
Word64 -> Word64 -> GroupRef ref -> Cont ref -> Cont ref
Push
              (Word64
 -> Word64
 -> GroupRef Reference
 -> Cont Reference
 -> Cont Reference)
-> m Word64
-> m (Word64
      -> GroupRef Reference -> Cont Reference -> Cont Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
              m (Word64
   -> GroupRef Reference -> Cont Reference -> Cont Reference)
-> m Word64
-> m (GroupRef Reference -> Cont Reference -> Cont Reference)
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 Reference -> Cont Reference -> Cont Reference)
-> m (GroupRef Reference) -> m (Cont Reference -> Cont Reference)
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 Reference)
forall (m :: * -> *). MonadGet m => m (GroupRef Reference)
getGroupRef
              m (Cont Reference -> Cont Reference)
-> m (Cont Reference) -> m (Cont Reference)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Cont Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Cont Reference)
getCont
  where
    assert0 :: [Char] -> a -> f ()
assert0 [Char]
_name a
0 = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    assert0 [Char]
name a
n = [Word] -> [Char] -> f ()
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] ([Char] -> f ()) -> [Char] -> f ()
forall a b. (a -> b) -> a -> b
$ [Char]
"getCont: malformed intermediate term. Expected " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" to be 0, but got " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
n
{-# SPECIALIZE getCont :: BDeserial (Cont Reference) #-}
{-# SPECIALIZE getCont :: SDeserial (Cont Reference) #-}

deserializeCode :: ByteString -> Either String (Referenced Code)
deserializeCode :: ByteString -> Either [Char] (Referenced Code)
deserializeCode ByteString
bs = Get (Referenced Code)
-> ByteString -> Either [Char] (Referenced Code)
forall a. Get a -> ByteString -> Either [Char] a
runGetS Get (Referenced Code)
go ByteString
bs
  where
    go :: Get (Referenced Code)
go =
      Get Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be Get Word32
-> (Word32 -> Get (Referenced Code)) -> Get (Referenced Code)
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
n Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
4 -> Get (Referenced Code)
forall (m :: * -> *). MonadGet m => m (Referenced Code)
CodeV4.getCodeWithHeader
          | 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
4 ->
              Code Reference -> Referenced Code
forall (t :: * -> *). t Reference -> Referenced t
Plain (Code Reference -> Referenced Code)
-> Get (Code Reference) -> Get (Referenced Code)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Version, Bool) Get (Code Reference)
-> (Version, Bool) -> Get (Code Reference)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Version, Bool) Get (Code Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Code Reference)
getCode (Word32 -> Version
Transfer Word32
n, Bool
False)
          | Bool
otherwise ->
              [Char] -> Get (Referenced Code)
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get (Referenced Code))
-> [Char] -> Get (Referenced Code)
forall a b. (a -> b) -> a -> b
$ [Char]
"deserializeGroup: unknown version: " [Char] -> ShowS
forall v. [v] -> [v] -> [v]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
n

-- Boolean argument determines whether ForeignFunc occurrences are
-- allowed to be serialized. For interchange, this should be False.
serializeCode :: Bool -> Referenced Code -> ByteString
serializeCode :: Bool -> Referenced Code -> ByteString
serializeCode Bool
fops (Referenced Code -> Code Reference
forall (t :: * -> *). Referential t => Referenced t -> t Reference
dereference -> Code Reference
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
*> Bool -> Code Reference -> Put
forall (m :: * -> *). MonadPut m => Bool -> Code Reference -> m ()
putCode Bool
fops Code Reference
co)
  where
    putVersion :: Put
putVersion = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
codeVersion

serializeCodeWithVersion ::
  Word64 -> Bool -> Referenced Code -> IO (Either String L.ByteString)
serializeCodeWithVersion :: Word64 -> Bool -> Referenced Code -> IO (Either [Char] ByteString)
serializeCodeWithVersion Word64
v Bool
fops Referenced Code
rco
  | Word64
v Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
4 =
      Referenced Code -> IO ([Reference], [Reference], Code RefNum)
forall {t :: * -> *}.
Referential t =>
Referenced t -> IO ([Reference], [Reference], t RefNum)
enreference Referenced Code
rco IO ([Reference], [Reference], Code RefNum)
-> (([Reference], [Reference], Code RefNum)
    -> IO (Either [Char] ByteString))
-> IO (Either [Char] ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \([Reference]
tys, [Reference]
tms, Code RefNum
co) ->
        Either [Char] ByteString -> IO (Either [Char] ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] ByteString -> IO (Either [Char] ByteString))
-> (Put -> Either [Char] ByteString)
-> Put
-> IO (Either [Char] ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> (Put -> ByteString) -> Put -> Either [Char] ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> IO (Either [Char] ByteString))
-> Put -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$
          Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
4 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Reference] -> [Reference] -> Bool -> Code RefNum -> Put
forall (m :: * -> *).
MonadPut m =>
[Reference] -> [Reference] -> Bool -> Code RefNum -> m ()
CodeV4.putCodeWithHeader [Reference]
tys [Reference]
tms Bool
fops Code RefNum
co
  | Word64
v Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
3 =
      Either [Char] ByteString -> IO (Either [Char] ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] ByteString -> IO (Either [Char] ByteString))
-> (Put -> Either [Char] ByteString)
-> Put
-> IO (Either [Char] ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either [Char] ByteString
forall a b. b -> Either a b
Right (ByteString -> Either [Char] ByteString)
-> (Put -> ByteString) -> Put -> Either [Char] ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> IO (Either [Char] ByteString))
-> Put -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$
        Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
3 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Code Reference -> Put
forall (m :: * -> *). MonadPut m => Bool -> Code Reference -> m ()
putCode Bool
fops (Referenced Code -> Code Reference
forall (t :: * -> *). Referential t => Referenced t -> t Reference
dereference Referenced Code
rco)
  | Bool
otherwise =
      Either [Char] ByteString -> IO (Either [Char] ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] ByteString -> IO (Either [Char] ByteString))
-> ([Char] -> Either [Char] ByteString)
-> [Char]
-> IO (Either [Char] ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] ByteString
forall a b. a -> Either a b
Left ([Char] -> IO (Either [Char] ByteString))
-> [Char] -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$ [Char]
"unsupported code serialization version: " [Char] -> ShowS
forall v. [v] -> [v] -> [v]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
v
  where
    enreference :: Referenced t -> IO ([Reference], [Reference], t RefNum)
enreference (WithRefs [Reference]
tys [Reference]
tms t RefNum
co) = ([Reference], [Reference], t RefNum)
-> IO ([Reference], [Reference], t RefNum)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Reference]
tys, [Reference]
tms, t RefNum
co)
    enreference (Plain t Reference
co) =
      StateT CanonST IO (t RefNum) -> CanonST -> IO (t RefNum, CanonST)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (t Reference -> StateT CanonST IO (t RefNum)
forall (t :: * -> *).
Referential t =>
t Reference -> Canonize (t RefNum)
canonicalizeRefs t Reference
co) CanonST
emptyCST
        IO (t RefNum, CanonST)
-> ((t RefNum, CanonST) -> ([Reference], [Reference], t RefNum))
-> IO ([Reference], [Reference], t RefNum)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(t RefNum
co, CST Canonicalizer Reference
_ CanonMap Reference RefNum
_ CanonMap Reference RefNum
_ Seq Reference
tys Seq Reference
tms) -> (Seq Reference -> [Reference]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Reference
tys, Seq Reference -> [Reference]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Reference
tms, t RefNum
co)

-- | 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) =>
  Reference ->
  SuperGroup Reference v ->
  L.ByteString
serializeGroupForRehash :: forall v.
Var v =>
Reference -> SuperGroup Reference v -> ByteString
serializeGroupForRehash (Builtin Text
_) SuperGroup Reference v
_ =
  [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"serializeForRehash: builtin reference"
serializeGroupForRehash (Derived Hash
h Word64
_) SuperGroup Reference v
sg =
  Put -> ByteString
runPutLazy (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Map Reference Word64 -> Bool -> SuperGroup Reference v -> Put
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> Bool -> SuperGroup Reference v -> m ()
putGroup Map Reference Word64
refrep Bool
False SuperGroup Reference 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 Reference v -> [Reference]
forall ref v. (Ord ref, Var v) => SuperGroup ref v -> [ref]
groupTermLinks SuperGroup Reference v
sg

getVersionedValue :: (MonadGet m) => m (Referenced Value)
getVersionedValue :: forall (m :: * -> *). MonadGet m => m (Referenced Value)
getVersionedValue =
  m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be m Word32
-> (Word32 -> m (Referenced Value)) -> m (Referenced 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
    Word32
n
      | Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
1 -> [Char] -> m (Referenced Value)
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (Referenced Value)) -> [Char] -> m (Referenced Value)
forall a b. (a -> b) -> a -> b
$ [Char]
"deserializeValue: unknown version: " [Char] -> ShowS
forall v. [v] -> [v] -> [v]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
n
      | Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
3 -> [Char] -> m (Referenced Value)
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (Referenced Value)) -> [Char] -> m (Referenced Value)
forall a b. (a -> b) -> a -> b
$ [Char]
"deserializeValue: unsupported version: " [Char] -> ShowS
forall v. [v] -> [v] -> [v]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
n
      | Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
4 -> Value Reference -> Referenced Value
forall (t :: * -> *). t Reference -> Referenced t
Plain (Value Reference -> Referenced Value)
-> m (Value Reference) -> m (Referenced Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Version, Bool) m (Value Reference)
-> (Version, Bool) -> m (Value Reference)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Version, Bool) m (Value Reference)
forall (m :: * -> *).
(MonadGet m, SerialConfig m) =>
m (Value Reference)
getValue (Word32 -> Version
Transfer Word32
n, Bool
False)
      | Word32
n Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
5 -> m (Referenced Value)
forall (m :: * -> *). MonadGet m => m (Referenced Value)
ValueV5.getValueWithHeader
      | Bool
otherwise -> [Char] -> m (Referenced Value)
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (Referenced Value)) -> [Char] -> m (Referenced Value)
forall a b. (a -> b) -> a -> b
$ [Char]
"deserializeValue: unknown version: " [Char] -> ShowS
forall v. [v] -> [v] -> [v]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
n
{-# SPECIALIZE getVersionedValue :: BGet.Get (Referenced Value) #-}
{-# SPECIALIZE getVersionedValue :: SGet.Get (Referenced Value) #-}

deserializeValue :: L.ByteString -> Either String (Referenced Value)
deserializeValue :: ByteString -> Either [Char] (Referenced Value)
deserializeValue ByteString
bs = ((ByteString, Int64, [Char]) -> [Char])
-> ((ByteString, Int64, Referenced Value) -> Referenced Value)
-> Either
     (ByteString, Int64, [Char]) (ByteString, Int64, Referenced Value)
-> Either [Char] (Referenced Value)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ByteString, Int64, [Char]) -> [Char]
forall {a} {b} {c}. (a, b, c) -> c
thd (ByteString, Int64, Referenced Value) -> Referenced Value
forall {a} {b} {c}. (a, b, c) -> c
thd (Either
   (ByteString, Int64, [Char]) (ByteString, Int64, Referenced Value)
 -> Either [Char] (Referenced Value))
-> Either
     (ByteString, Int64, [Char]) (ByteString, Int64, Referenced Value)
-> Either [Char] (Referenced Value)
forall a b. (a -> b) -> a -> b
$ Get (Referenced Value)
-> ByteString
-> Either
     (ByteString, Int64, [Char]) (ByteString, Int64, Referenced Value)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, [Char]) (ByteString, Int64, a)
runGetOrFail Get (Referenced Value)
forall (m :: * -> *). MonadGet m => m (Referenced Value)
getVersionedValue ByteString
bs
  where
    thd :: (a, b, c) -> c
thd (a
_, b
_, c
x) = c
x

serializeValue :: Referenced Value -> ByteString
serializeValue :: Referenced Value -> ByteString
serializeValue (Referenced Value -> Value Reference
forall (t :: * -> *). Referential t => Referenced t -> t Reference
dereference -> Value Reference
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 Reference -> Put
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue (Word32 -> Version
Transfer Word32
valueVersion) Value Reference
v)
  where
    putVersion :: Put
putVersion = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
valueVersion

serializeValueWithVersion ::
  Word64 -> Referenced Value -> IO L.ByteString
serializeValueWithVersion :: Word64 -> Referenced Value -> IO ByteString
serializeValueWithVersion Word64
v Referenced Value
rval
  | Word64
v Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
5 = case Referenced Value
rval of
      WithRefs [Reference]
tys [Reference]
tms Value RefNum
x -> [Reference] -> [Reference] -> Value RefNum -> IO ByteString
forall {f :: * -> *}.
Applicative f =>
[Reference] -> [Reference] -> Value RefNum -> f ByteString
v5ser [Reference]
tys [Reference]
tms Value RefNum
x
      Plain Value Reference
x -> do
        (Value RefNum
x, CST Canonicalizer Reference
_ CanonMap Reference RefNum
_ CanonMap Reference RefNum
_ Seq Reference
tys Seq Reference
tms) <-
          StateT CanonST IO (Value RefNum)
-> CanonST -> IO (Value RefNum, CanonST)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Value Reference -> StateT CanonST IO (Value RefNum)
forall (t :: * -> *).
Referential t =>
t Reference -> Canonize (t RefNum)
canonicalizeRefs Value Reference
x) CanonST
emptyCST
        [Reference] -> [Reference] -> Value RefNum -> IO ByteString
forall {f :: * -> *}.
Applicative f =>
[Reference] -> [Reference] -> Value RefNum -> f ByteString
v5ser (Seq Reference -> [Reference]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Reference
tys) (Seq Reference -> [Reference]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Reference
tms) Value RefNum
x
  | Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
5,
    Word32
n <- Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v =
      ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString)
-> (Put -> ByteString) -> Put -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> IO ByteString) -> Put -> IO ByteString
forall a b. (a -> b) -> a -> b
$
        Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
n
          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 Reference -> Put
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue (Word32 -> Version
Transfer Word32
n) (Referenced Value -> Value Reference
forall (t :: * -> *). Referential t => Referenced t -> t Reference
dereference Referenced Value
rval)
  | Bool
otherwise =
      [Word] -> [Char] -> IO ByteString
forall a. HasCallStack => [Word] -> [Char] -> IO a
die [] ([Char] -> IO ByteString) -> [Char] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"Value.serialize.versioned: unrecognized version: " [Char] -> ShowS
forall v. [v] -> [v] -> [v]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
v
  where
    v5ser :: [Reference] -> [Reference] -> Value RefNum -> f ByteString
v5ser [Reference]
tys [Reference]
tms Value RefNum
x =
      ByteString -> f ByteString
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> f ByteString)
-> (Put -> ByteString) -> Put -> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> f ByteString) -> Put -> f ByteString
forall a b. (a -> b) -> a -> b
$
        Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
5 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Reference] -> [Reference] -> Value RefNum -> Put
forall (m :: * -> *).
MonadPut m =>
[Reference] -> [Reference] -> Value RefNum -> m ()
ValueV5.putValueWithHeader [Reference]
tys [Reference]
tms Value RefNum
x

-- 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 Reference -> L.ByteString
serializeValueForHash :: Value Reference -> ByteString
serializeValueForHash Value Reference
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 Reference -> Put
forall (m :: * -> *).
MonadPut m =>
Version -> Value Reference -> m ()
putValue (Word32 -> Version
Hash Word32
4) Value Reference
v)
  where
    putPrefix :: Put
putPrefix = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
4

-- Gets a SuperGroup with the current code version. Used for
-- interpreter state serialization in U.R.Interface.
getGroupCurrent :: (MonadGet m, Var v) => m (SuperGroup Reference v)
getGroupCurrent :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
m (SuperGroup Reference v)
getGroupCurrent = ReaderT (Version, Bool) m (SuperGroup Reference v)
-> (Version, Bool) -> m (SuperGroup Reference v)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Version, Bool) m (SuperGroup Reference v)
forall (m :: * -> *) v.
(MonadGet m, SerialConfig m, Var v) =>
m (SuperGroup Reference v)
getGroup (Word32 -> Version
Transfer Word32
codeVersion, Bool
False)

askVersion :: (SerialConfig m) => m Version
askVersion :: forall (m :: * -> *). SerialConfig m => m Version
askVersion = ((Version, Bool) -> Version) -> m Version
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Version, Bool) -> Version
forall a b. (a, b) -> a
fst

askFOp :: (SerialConfig m) => m Bool
askFOp :: forall (m :: * -> *). SerialConfig m => m Bool
askFOp = ((Version, Bool) -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Version, Bool) -> Bool
forall a b. (a, b) -> b
snd

type SerialConfig m = MonadReader (Version, Bool) m

type BDeserial = ReaderT (Version, Bool) BGet.Get

type SDeserial = ReaderT (Version, Bool) SGet.Get

-- Convert value version numbers to code version numbers
valueToCode :: Version -> Version
valueToCode :: Version -> Version
valueToCode Version
v
  | Hash Word32
n <- Version
v = Word32 -> Version
Hash (Word32 -> Version) -> Word32 -> Version
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall {a}. (Ord a, Num a) => a -> a
tweak Word32
n
  | Transfer Word32
n <- Version
v = Word32 -> Version
Transfer (Word32 -> Version) -> Word32 -> Version
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall {a}. (Ord a, Num a) => a -> a
tweak Word32
n
  where
    tweak :: a -> a
tweak a
n
      | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
2 = a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1
      | Bool
otherwise = a
n

withCodeVersion :: (SerialConfig m) => m r -> m r
withCodeVersion :: forall (m :: * -> *) r. SerialConfig m => m r -> m r
withCodeVersion = ((Version, Bool) -> (Version, Bool)) -> m r -> m r
forall a. ((Version, Bool) -> (Version, Bool)) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((Version -> Version) -> (Version, Bool) -> (Version, Bool)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Version -> Version
valueToCode)

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

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