{-# 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.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import Data.ByteString.Builder qualified as BU
import Data.ByteString.Lazy qualified as L
import Data.Bytes.Get hiding (getBytes)
import Data.Bytes.Serial
import Data.Bytes.VarInt
import Data.Foldable (toList)
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.Word (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.POp 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 :: Word64 -> Builder
putIndex :: Word64 -> Builder
putIndex = Word64 -> Builder
forall a.
(Integral a, Integral (Unsigned a), Bits (Unsigned a)) =>
a -> Builder
putVarInt
{-# INLINE putIndex #-}

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

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

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

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

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

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

-- Serializes a `SuperGroup`.
--
-- The Reference map allows certain term references to be switched out
-- for a given 64 bit word. This is used when re-hashing intermediate
-- code. For actual serialization, the empty map should be used, so
-- that the process is reversible. The purpose of this is merely to
-- strip out (mutual/)self-references when producing a byte sequence
-- to recompute a hash of a connected component of intermediate
-- definitons, since it is infeasible to
--
-- The EnumMap associates 'foreign' operations with a textual name
-- that is used as the serialized representation. Since they are
-- generated somewhat dynamically, it is not easy to associate them
-- with a fixed numbering like we can with POps.
putGroup ::
  (Var v) =>
  Map Reference Word64 ->
  Bool ->
  SuperGroup Reference v ->
  Builder
putGroup :: forall v.
Var v =>
Map Reference Word64 -> Bool -> SuperGroup Reference v -> Builder
putGroup Map Reference Word64
refrep Bool
fops (Rec [(v, SuperNormal Reference v)]
bs SuperNormal Reference v
e) =
  Int -> Builder
forall n.
(Integral n, Integral (Unsigned n), Bits n, Bits (Unsigned n)) =>
n -> Builder
putLength Int
n
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (SuperNormal Reference v -> Builder)
-> [SuperNormal Reference v] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Map Reference Word64
-> Bool -> [v] -> SuperNormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> SuperNormal Reference v -> Builder
putComb Map Reference Word64
refrep Bool
fops [v]
ctx) [SuperNormal Reference v]
cs
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> SuperNormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> SuperNormal Reference v -> Builder
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 :: Bool -> Code Reference -> Builder
putCode :: Bool -> Code Reference -> Builder
putCode Bool
fops (CodeRep SuperGroup Reference Symbol
g Cacheability
c) = Map Reference Word64
-> Bool -> SuperGroup Reference Symbol -> Builder
forall v.
Var v =>
Map Reference Word64 -> Bool -> SuperGroup Reference v -> Builder
putGroup Map Reference Word64
forall a. Monoid a => a
mempty Bool
fops SuperGroup Reference Symbol
g Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Cacheability -> Builder
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 ::
  (Var v) =>
  [v] ->
  InlineInfo Reference v ->
  Builder
putInlineInfo :: forall v. Var v => [v] -> InlineInfo Reference v -> Builder
putInlineInfo [v]
ctx (InlInfo InlineClass
clazz ANormal Reference v
expr) =
  InlineClass -> Builder
putInlineClass InlineClass
clazz Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> ANormal Reference v -> Builder
forall v. Var v => [v] -> ANormal Reference v -> Builder
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 ::
  (Var v) =>
  [v] ->
  ANormal Reference v ->
  Builder
putInlineExpr :: forall v. Var v => [v] -> ANormal Reference v -> Builder
putInlineExpr [v]
ctx (TAbss [v]
vs Term (ANormalF Reference) v
body) =
  Int -> Builder
forall n.
(Integral n, Integral (Unsigned n), Bits n, Bits (Unsigned n)) =>
n -> Builder
putLength ([v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> Term (ANormalF Reference) v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
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 :: (Var v) => OptInfos Reference v -> Builder
putOptInfos :: forall v. Var v => OptInfos Reference v -> Builder
putOptInfos (Arities Reference
arities, InlineInfos Reference v
inls) =
  (Reference -> Builder)
-> (Int -> Builder) -> Arities Reference -> Builder
forall a b. (a -> Builder) -> (b -> Builder) -> Map a b -> Builder
putMap Reference -> Builder
putReference Int -> Builder
forall a.
(Integral a, Integral (Unsigned a), Bits (Unsigned a)) =>
a -> Builder
putVarInt Arities Reference
arities
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Reference -> Builder)
-> (InlineInfo Reference v -> Builder)
-> InlineInfos Reference v
-> Builder
forall a b. (a -> Builder) -> (b -> Builder) -> Map a b -> Builder
putMap Reference -> Builder
putReference ([v] -> InlineInfo Reference v -> Builder
forall v. Var v => [v] -> InlineInfo Reference v -> Builder
putInlineInfo []) InlineInfos Reference v
inls

-- 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 :: InlineClass -> Builder
putInlineClass :: InlineClass -> Builder
putInlineClass = \case
  InlineClass
AnywhereInl -> Word8 -> Builder
BU.word8 Word8
0
  InlineClass
TailInl -> Word8 -> Builder
BU.word8 Word8
1
  InlineClass
Don'tInl -> Word8 -> Builder
BU.word8 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 :: Cacheability -> Builder
putCacheability :: Cacheability -> Builder
putCacheability Cacheability
Uncacheable = Word8 -> Builder
BU.word8 Word8
0
putCacheability Cacheability
Cacheable = Word8 -> Builder
BU.word8 Word8
1

getCacheability :: (MonadGet m, 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 ::
  (Var v) =>
  Map Reference Word64 ->
  Bool ->
  [v] ->
  SuperNormal Reference v ->
  Builder
putComb :: forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> SuperNormal Reference v -> Builder
putComb Map Reference Word64
refrep Bool
fops [v]
ctx (Lambda [Mem]
ccs (TAbss [v]
us Term (ANormalF Reference) v
e)) =
  [Mem] -> Builder
putCCs [Mem]
ccs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> Term (ANormalF Reference) v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
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 ::
  (Var v) =>
  Map Reference Word64 ->
  Bool ->
  [v] ->
  ANormal Reference v ->
  Builder
putNormal :: forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx ANormal Reference v
tm = case ANormal Reference v
tm of
  TVar v
v -> TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
VarT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
  TFrc v
v -> TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
ForceT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
  TApp Func Reference v
f [v]
as -> TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
AppT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64 -> Bool -> [v] -> Func Reference v -> Builder
forall v.
Var v =>
Map Reference Word64 -> Bool -> [v] -> Func Reference v -> Builder
putFunc Map Reference Word64
refrep Bool
fops [v]
ctx Func Reference v
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> [v] -> Builder
forall v. Eq v => [v] -> [v] -> Builder
putArgs [v]
ctx [v]
as
  THnd [Reference]
rs v
nh Maybe v
_ah ANormal Reference v
e ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
HandleT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Reference] -> Builder
putRefs [Reference]
rs
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
nh
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx ANormal Reference v
e
  TShift Reference
r v
v ANormal Reference v
e ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
ShiftT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
putReference Reference
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
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 -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
MatchT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool
-> [v]
-> Branched Reference (ANormal Reference v)
-> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool
-> [v]
-> Branched Reference (ANormal Reference v)
-> Builder
putBranches Map Reference Word64
refrep Bool
fops [v]
ctx Branched Reference (ANormal Reference v)
bs
  TLit Lit Reference
l -> TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
LitT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Lit Reference -> Builder
putLit Lit Reference
l
  TBLit Lit Reference
l -> TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
BxLitT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Lit Reference -> Builder
putLit Lit Reference
l
  TName v
v (Left Reference
r) [v]
as ANormal Reference v
e ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
NameRefT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pr
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> [v] -> Builder
forall v. Eq v => [v] -> [v] -> Builder
putArgs [v]
ctx [v]
as
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
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 :: Builder
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 -> Builder
BU.word64BE Word64
w
        | Bool
otherwise = Reference -> Builder
putReference Reference
r
  TName v
v (Right v
u) [v]
as ANormal Reference v
e ->
    TmTag -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
NameVarT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
u
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> [v] -> Builder
forall v. Eq v => [v] -> [v] -> Builder
putArgs [v]
ctx [v]
as
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
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 -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
LetDirT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Mem] -> Builder
putCCs [Mem]
ccs
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx ANormal Reference v
l
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
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 -> Builder
forall t. Tag t => t -> Builder
putTag TmTag
LetIndT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BU.word16BE Word16
w
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Mem] -> Builder
putCCs [Mem]
ccs
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx ANormal Reference v
l
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
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] -> Builder
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ [Char]
"putNormal: malformed term\n" [Char] -> 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 ::
  (Var v) =>
  Map Reference Word64 ->
  Bool ->
  [v] ->
  Func Reference v ->
  Builder
putFunc :: forall v.
Var v =>
Map Reference Word64 -> Bool -> [v] -> Func Reference v -> Builder
putFunc Map Reference Word64
refrep Bool
allowFop [v]
ctx Func Reference v
f = case Func Reference v
f of
  FVar v
v -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FVarT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
  FComb 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 -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FCombT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BU.word64BE Word64
w
    | Bool
otherwise -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FCombT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
putReference Reference
r
  FCont v
v -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FContT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [v] -> v -> Builder
forall v. Eq v => [v] -> v -> Builder
putVar [v]
ctx v
v
  FCon Reference
r CTag
c -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FConT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
putReference Reference
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CTag -> Builder
putCTag CTag
c
  FReq Reference
r CTag
c -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FReqT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
putReference Reference
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CTag -> Builder
putCTag CTag
c
  FPrim (Left POp
p) -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FPrimT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> POp -> Builder
putPOp POp
p
  FPrim (Right ForeignFunc
f)
    | Bool
allowFop -> FnTag -> Builder
forall t. Tag t => t -> Builder
putTag FnTag
FForeignT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ForeignFunc -> Builder
putFOp ForeignFunc
f
    | Bool
otherwise ->
        [Word] -> [Char] -> Builder
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] ([Char] -> Builder) -> [Char] -> Builder
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 :: ForeignFunc -> Builder
putFOp :: ForeignFunc -> Builder
putFOp = Int -> Builder
forall a.
(Integral a, Integral (Unsigned a), Bits (Unsigned a)) =>
a -> Builder
putVarInt (Int -> Builder) -> (ForeignFunc -> Int) -> ForeignFunc -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignFunc -> Int
forall a. Enum a => a -> Int
fromEnum

getFOp :: (MonadGet m) => m ForeignFunc
getFOp :: forall (m :: * -> *). MonadGet m => m ForeignFunc
getFOp = Int -> ForeignFunc
forall a. Enum a => Int -> a
toEnum (Int -> ForeignFunc)
-> (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 :: POp -> Builder
putPOp :: POp -> Builder
putPOp POp
op
  | Just Word16
w <- POp -> Map POp Word16 -> Maybe Word16
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup POp
op Map POp Word16
pop2word = Word16 -> Builder
BU.word16BE Word16
w
  | Bool
otherwise = [Word] -> [Char] -> Builder
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ [Char]
"putPOp: unknown POp: " [Char] -> 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"

putLit :: Lit Reference -> Builder
putLit :: Lit Reference -> Builder
putLit (I Int64
i) = LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
IT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
putInt Int64
i
putLit (N Word64
n) = LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
NT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
putNat Word64
n
putLit (F Double
f) = LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
FT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
putFloat Double
f
putLit (T Text
t) = LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
TT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
putText (Text -> Text
Util.Text.toText Text
t)
putLit (C Char
c) = LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
CT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
putChar Char
c
putLit (LM Referent' Reference
r) = LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
LMT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Referent' Reference -> Builder
putReferent Referent' Reference
r
putLit (LY Reference
r) = LtTag -> Builder
forall t. Tag t => t -> Builder
putTag LtTag
LYT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
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 :: Version -> BLit Reference -> Builder
putBLit :: Version -> BLit Reference -> Builder
putBLit Version
_ (Text Text
t) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
TextT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
putText (Text -> Text
Util.Text.toText Text
t)
putBLit Version
v (List Seq (Value Reference)
s) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
ListT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Value Reference -> Builder) -> Seq (Value Reference) -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable (Version -> Value Reference -> Builder
putValue Version
v) Seq (Value Reference)
s
putBLit Version
_ (TmLink Referent' Reference
r) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
TmLinkT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Referent' Reference -> Builder
putReferent Referent' Reference
r
putBLit Version
_ (TyLink Reference
r) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
TyLinkT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
putReference Reference
r
putBLit Version
_ (Bytes Bytes
b) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
BytesT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bytes -> Builder
putBytes Bytes
b
putBLit Version
v (Quote Value Reference
vl) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
QuoteT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> Value Reference -> Builder
putValue Version
v Value Reference
vl
putBLit Version
v (Code (CodeRep SuperGroup Reference Symbol
sg Cacheability
ch)) =
  BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
tag Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> SuperGroup Reference Symbol -> Builder
forall v.
Var v =>
Map Reference Word64 -> Bool -> SuperGroup Reference v -> Builder
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 -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
BArrT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteArray -> Builder
putByteArray ByteArray
a
putBLit Version
_ (Pos Word64
n) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
PosT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
forall n.
(Bits n, Bits (Unsigned n), Integral n, Integral (Unsigned n)) =>
n -> Builder
putPositive Word64
n
putBLit Version
_ (Neg Word64
n) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
NegT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
forall n.
(Bits n, Bits (Unsigned n), Integral n, Integral (Unsigned n)) =>
n -> Builder
putPositive Word64
n
putBLit Version
_ (Char Char
c) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
CharT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
putChar Char
c
putBLit Version
_ (Float Double
d) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
FloatT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Double -> Builder
putFloat Double
d
putBLit Version
v (Arr Array (Value Reference)
a) = BLTag -> Builder
forall t. Tag t => t -> Builder
putTag BLTag
ArrT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Value Reference -> Builder) -> Array (Value Reference) -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable (Version -> Value Reference -> Builder
putValue Version
v) Array (Value Reference)
a
putBLit Version
_ (Map [(Value Reference, Value Reference)]
_) = [Word] -> [Char] -> Builder
forall a. HasCallStack => [Word] -> [Char] -> a
exn [] [Char]
"putBLit: impossible Map"

-- 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 ::
  Version -> [(Value Reference, Value Reference)] -> Builder
putAsMap :: Version -> [(Value Reference, Value Reference)] -> Builder
putAsMap Version
v = Map (Value Reference) (Value Reference) -> Builder
putter (Map (Value Reference) (Value Reference) -> Builder)
-> ([(Value Reference, Value Reference)]
    -> Map (Value Reference) (Value Reference))
-> [(Value Reference, Value Reference)]
-> Builder
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) -> Builder
putter Map (Value Reference) (Value Reference)
Tip =
      VaTag -> Builder
forall t. Tag t => t -> Builder
putTag VaTag
DataT
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
putReference Reference
mapRef
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BU.word64BE Word64
mapTip
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall n.
(Integral n, Integral (Unsigned n), Bits n, Bits (Unsigned n)) =>
n -> Builder
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 -> Builder
forall t. Tag t => t -> Builder
putTag VaTag
DataT
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
putReference Reference
mapRef
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BU.word64BE Word64
mapBin
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall n.
(Integral n, Integral (Unsigned n), Bits n, Bits (Unsigned n)) =>
n -> Builder
putLength (Int
5 :: Int)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> Value Reference -> Builder
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)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> Value Reference -> Builder
putValue Version
v Value Reference
k
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> Value Reference -> Builder
putValue Version
v Value Reference
e
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map (Value Reference) (Value Reference) -> Builder
putter Map (Value Reference) (Value Reference)
l
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map (Value Reference) (Value Reference) -> Builder
putter Map (Value Reference) (Value Reference)
r

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 :: [Reference] -> Builder
putRefs :: [Reference] -> Builder
putRefs [Reference]
rs = (Reference -> Builder) -> [Reference] -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable Reference -> Builder
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 ::
  (Var v) =>
  Map Reference Word64 ->
  Bool ->
  [v] ->
  Branched Reference (ANormal Reference v) ->
  Builder
putBranches :: forall v.
Var v =>
Map Reference Word64
-> Bool
-> [v]
-> Branched Reference (ANormal Reference v)
-> Builder
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 -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MEmptyT
  MatchIntegral EnumMap Word64 (ANormal Reference v)
m Maybe (ANormal Reference v)
df ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MIntT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Word64 -> Builder)
-> (ANormal Reference v -> Builder)
-> EnumMap Word64 (ANormal Reference v)
-> Builder
forall k v.
EnumKey k =>
(k -> Builder) -> (v -> Builder) -> EnumMap k v -> Builder
putEnumMap Word64 -> Builder
BU.word64BE (Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx) EnumMap Word64 (ANormal Reference v)
m
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe (ANormal Reference v)
-> (ANormal Reference v -> Builder) -> Builder
forall a. Maybe a -> (a -> Builder) -> Builder
putMaybe Maybe (ANormal Reference v)
df (Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx)
  MatchText Map Text (ANormal Reference v)
m Maybe (ANormal Reference v)
df ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MTextT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder)
-> (ANormal Reference v -> Builder)
-> Map Text (ANormal Reference v)
-> Builder
forall a b. (a -> Builder) -> (b -> Builder) -> Map a b -> Builder
putMap (Text -> Builder
putText (Text -> Builder) -> (Text -> Text) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.toText) (Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx) Map Text (ANormal Reference v)
m
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe (ANormal Reference v)
-> (ANormal Reference v -> Builder) -> Builder
forall a. Maybe a -> (a -> Builder) -> Builder
putMaybe Maybe (ANormal Reference v)
df (Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
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) ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MReqT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Reference -> Builder)
-> (EnumMap CTag ([Mem], ANormal Reference v) -> Builder)
-> [(Reference, EnumMap CTag ([Mem], ANormal Reference v))]
-> Builder
forall a b. (a -> Builder) -> (b -> Builder) -> [(a, b)] -> Builder
putMapping Reference -> Builder
putReference ((CTag -> Builder)
-> (([Mem], ANormal Reference v) -> Builder)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> Builder
forall k v.
EnumKey k =>
(k -> Builder) -> (v -> Builder) -> EnumMap k v -> Builder
putEnumMap CTag -> Builder
putCTag (Map Reference Word64
-> Bool -> [v] -> ([Mem], ANormal Reference v) -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ([Mem], ANormal Reference v) -> Builder
putCase Map Reference Word64
refrep Bool
fops [v]
ctx)) [(Reference, EnumMap CTag ([Mem], ANormal Reference v))]
m
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
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 ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MDataT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
putReference Reference
r
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (CTag -> Builder)
-> (([Mem], ANormal Reference v) -> Builder)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> Builder
forall k v.
EnumKey k =>
(k -> Builder) -> (v -> Builder) -> EnumMap k v -> Builder
putEnumMap CTag -> Builder
putCTag (Map Reference Word64
-> Bool -> [v] -> ([Mem], ANormal Reference v) -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ([Mem], ANormal Reference v) -> Builder
putCase Map Reference Word64
refrep Bool
fops [v]
ctx) EnumMap CTag ([Mem], ANormal Reference v)
m
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe (ANormal Reference v)
-> (ANormal Reference v -> Builder) -> Builder
forall a. Maybe a -> (a -> Builder) -> Builder
putMaybe Maybe (ANormal Reference v)
df (Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx)
  MatchSum EnumMap Word64 ([Mem], ANormal Reference v)
m ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MSumT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Word64 -> Builder)
-> (([Mem], ANormal Reference v) -> Builder)
-> EnumMap Word64 ([Mem], ANormal Reference v)
-> Builder
forall k v.
EnumKey k =>
(k -> Builder) -> (v -> Builder) -> EnumMap k v -> Builder
putEnumMap Word64 -> Builder
BU.word64BE (Map Reference Word64
-> Bool -> [v] -> ([Mem], ANormal Reference v) -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ([Mem], ANormal Reference v) -> Builder
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 ->
    MtTag -> Builder
forall t. Tag t => t -> Builder
putTag MtTag
MNumT
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
putReference Reference
r
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Word64 -> Builder)
-> (ANormal Reference v -> Builder)
-> EnumMap Word64 (ANormal Reference v)
-> Builder
forall k v.
EnumKey k =>
(k -> Builder) -> (v -> Builder) -> EnumMap k v -> Builder
putEnumMap Word64 -> Builder
BU.word64BE (Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx) EnumMap Word64 (ANormal Reference v)
m
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe (ANormal Reference v)
-> (ANormal Reference v -> Builder) -> Builder
forall a. Maybe a -> (a -> Builder) -> Builder
putMaybe Maybe (ANormal Reference v)
df (Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
putNormal Map Reference Word64
refrep Bool
fops [v]
ctx)
  Branched Reference (ANormal Reference v)
_ -> [Word] -> [Char] -> Builder
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 ::
  (Var v) =>
  Map Reference Word64 ->
  Bool ->
  [v] ->
  ([Mem], ANormal Reference v) ->
  Builder
putCase :: forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ([Mem], ANormal Reference v) -> Builder
putCase Map Reference Word64
refrep Bool
fops [v]
ctx ([Mem]
ccs, (TAbss [v]
us ANormal Reference v
e)) =
  [Mem] -> Builder
putCCs [Mem]
ccs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
forall v.
Var v =>
Map Reference Word64
-> Bool -> [v] -> ANormal Reference v -> Builder
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 :: CTag -> Builder
putCTag :: CTag -> Builder
putCTag CTag
c = Int -> Builder
forall a.
(Integral a, Integral (Unsigned a), Bits (Unsigned a)) =>
a -> Builder
putVarInt (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ CTag -> Int
forall a. Enum a => a -> Int
fromEnum CTag
c

getCTag :: (MonadGet m) => m CTag
getCTag :: forall (m :: * -> *). MonadGet m => m CTag
getCTag = Int -> CTag
forall a. Enum a => Int -> a
toEnum (Int -> CTag) -> (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 :: GroupRef Reference -> Builder
putGroupRef :: GroupRef Reference -> Builder
putGroupRef (GR Reference
r Word64
i) =
  Reference -> Builder
putReference Reference
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BU.word64BE 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 :: Version -> Value Reference -> Builder
putValue :: Version -> Value Reference -> Builder
putValue Version
v (Partial GroupRef Reference
gr [Value Reference]
vs) =
  VaTag -> Builder
forall t. Tag t => t -> Builder
putTag VaTag
PartialT
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> GroupRef Reference -> Builder
putGroupRef GroupRef Reference
gr
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Value Reference -> Builder) -> [Value Reference] -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable (Version -> Value Reference -> Builder
putValue Version
v) [Value Reference]
vs
putValue Version
v (Data Reference
r Word64
t [Value Reference]
vs) =
  VaTag -> Builder
forall t. Tag t => t -> Builder
putTag VaTag
DataT
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Reference -> Builder
putReference Reference
r
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BU.word64BE Word64
t
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Value Reference -> Builder) -> [Value Reference] -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable (Version -> Value Reference -> Builder
putValue Version
v) [Value Reference]
vs
putValue Version
v (Cont [Value Reference]
bs Cont Reference
k) =
  VaTag -> Builder
forall t. Tag t => t -> Builder
putTag VaTag
ContT
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Value Reference -> Builder) -> [Value Reference] -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable (Version -> Value Reference -> Builder
putValue Version
v) [Value Reference]
bs
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> Cont Reference -> Builder
putCont Version
v Cont Reference
k
putValue Version
v (BLit (Map [(Value Reference, Value Reference)]
l)) = Version -> [(Value Reference, Value Reference)] -> Builder
putAsMap Version
v [(Value Reference, Value Reference)]
l
putValue Version
v (BLit BLit Reference
l) =
  VaTag -> Builder
forall t. Tag t => t -> Builder
putTag VaTag
BLitT Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> BLit Reference -> Builder
putBLit Version
v BLit Reference
l

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 :: Version -> Cont Reference -> Builder
putCont :: Version -> Cont Reference -> Builder
putCont Version
_ Cont Reference
KE = CoTag -> Builder
forall t. Tag t => t -> Builder
putTag CoTag
KET
putCont Version
v (Mark Word64
a [Reference]
rs [(Reference, Value Reference)]
ds Cont Reference
k) =
  CoTag -> Builder
forall t. Tag t => t -> Builder
putTag CoTag
MarkT
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BU.word64BE Word64
a
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Reference -> Builder) -> [Reference] -> Builder
forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
putFoldable Reference -> Builder
putReference [Reference]
rs
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Reference -> Builder)
-> (Value Reference -> Builder)
-> [(Reference, Value Reference)]
-> Builder
forall a b. (a -> Builder) -> (b -> Builder) -> [(a, b)] -> Builder
putMapping Reference -> Builder
putReference (Version -> Value Reference -> Builder
putValue Version
v) [(Reference, Value Reference)]
ds
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> Cont Reference -> Builder
putCont Version
v Cont Reference
k
putCont Version
v (Push Word64
f Word64
n GroupRef Reference
gr Cont Reference
k) =
  CoTag -> Builder
forall t. Tag t => t -> Builder
putTag CoTag
PushT
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BU.word64BE Word64
f
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BU.word64BE Word64
n
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> GroupRef Reference -> Builder
putGroupRef GroupRef Reference
gr
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> Cont Reference -> Builder
putCont Version
v Cont Reference
k

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) =
  ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BU.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
putVersion Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Code Reference -> Builder
putCode Bool
fops Code Reference
co
  where
    putVersion :: Builder
putVersion = Word32 -> Builder
BU.word32BE 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))
-> (Builder -> Either [Char] ByteString)
-> Builder
-> 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)
-> (Builder -> ByteString) -> Builder -> Either [Char] ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BU.toLazyByteString (Builder -> IO (Either [Char] ByteString))
-> Builder -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$
          Word32 -> Builder
BU.word32BE Word32
4 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Reference] -> [Reference] -> Bool -> Code RefNum -> Builder
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))
-> (Builder -> Either [Char] ByteString)
-> Builder
-> 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)
-> (Builder -> ByteString) -> Builder -> Either [Char] ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BU.toLazyByteString (Builder -> IO (Either [Char] ByteString))
-> Builder -> IO (Either [Char] ByteString)
forall a b. (a -> b) -> a -> b
$
        Word32 -> Builder
BU.word32BE Word32
3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Code Reference -> Builder
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 =
  Builder -> ByteString
BU.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Map Reference Word64 -> Bool -> SuperGroup Reference v -> Builder
forall v.
Var v =>
Map Reference Word64 -> Bool -> SuperGroup Reference v -> Builder
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) =
  ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BU.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
    Builder
putVersion Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> Value Reference -> Builder
putValue (Word32 -> Version
Transfer Word32
valueVersion) Value Reference
v
  where
    putVersion :: Builder
putVersion = Word32 -> Builder
BU.word32BE 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)
-> (Builder -> ByteString) -> Builder -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BU.toLazyByteString (Builder -> IO ByteString) -> Builder -> IO ByteString
forall a b. (a -> b) -> a -> b
$
        Word32 -> Builder
BU.word32BE Word32
n
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> Value Reference -> Builder
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) -> ByteString -> f ByteString
forall a b. (a -> b) -> a -> b
$ [Reference] -> [Reference] -> Value RefNum -> ByteString
ValueV5.versionedValueBytes [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 =
  Builder -> ByteString
BU.toLazyByteString (Builder
putPrefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> Value Reference -> Builder
putValue (Word32 -> Version
Hash Word32
4) Value Reference
v)
  where
    putPrefix :: Builder
putPrefix = Word32 -> Builder
BU.word32BE 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