{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
module Unison.Runtime.ANF.Serialize where
import Control.Monad
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as L
import Data.Bytes.Get hiding (getBytes)
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Bytes.VarInt
import Data.Foldable (traverse_)
import Data.Functor ((<&>))
import Data.Map as Map (Map, fromList, lookup)
import Data.Maybe (mapMaybe)
import Data.Sequence qualified as Seq
import Data.Serialize.Put (runPutLazy)
import Data.Text (Text)
import Data.Word (Word16, Word32, Word64)
import GHC.IsList qualified (fromList)
import GHC.Stack
import Unison.ABT.Normalized (Term (..))
import Unison.Reference (Reference, Reference' (Builtin), pattern Derived)
import Unison.Runtime.ANF as ANF hiding (Tag)
import Unison.Runtime.Exception
import Unison.Runtime.Serialize
import Unison.Util.EnumContainers qualified as EC
import Unison.Util.Text qualified as Util.Text
import Unison.Var (Type (ANFBlank), Var (..))
import Prelude hiding (getChar, putChar)
type Version = Word32
data TmTag
= VarT
| ForceT
| AppT
| HandleT
| ShiftT
| MatchT
| LitT
| NameRefT
| NameVarT
| LetDirT
| LetIndT
| BxLitT
data FnTag
= FVarT
| FCombT
| FContT
| FConT
| FReqT
| FPrimT
| FForeignT
data MtTag
= MIntT
| MTextT
| MReqT
| MEmptyT
| MDataT
| MSumT
| MNumT
data LtTag
= IT
| NT
| FT
| TT
| CT
| LMT
| LYT
data BLTag
= TextT
| ListT
| TmLinkT
| TyLinkT
| BytesT
| QuoteT
| CodeT
| BArrT
| PosT
| NegT
| CharT
| FloatT
| ArrT
data VaTag = PartialT | DataT | ContT | BLitT
data CoTag = KET | MarkT | PushT
instance Tag TmTag where
tag2word :: TmTag -> Word8
tag2word = \case
TmTag
VarT -> Word8
1
TmTag
ForceT -> Word8
2
TmTag
AppT -> Word8
3
TmTag
HandleT -> Word8
4
TmTag
ShiftT -> Word8
5
TmTag
MatchT -> Word8
6
TmTag
LitT -> Word8
7
TmTag
NameRefT -> Word8
8
TmTag
NameVarT -> Word8
9
TmTag
LetDirT -> Word8
10
TmTag
LetIndT -> Word8
11
TmTag
BxLitT -> Word8
12
word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m TmTag
word2tag = \case
Word8
1 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
VarT
Word8
2 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
ForceT
Word8
3 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
AppT
Word8
4 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
HandleT
Word8
5 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
ShiftT
Word8
6 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
MatchT
Word8
7 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
LitT
Word8
8 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
NameRefT
Word8
9 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
NameVarT
Word8
10 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
LetDirT
Word8
11 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
LetIndT
Word8
12 -> TmTag -> m TmTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TmTag
BxLitT
Word8
n -> String -> Word8 -> m TmTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"TmTag" Word8
n
instance Tag FnTag where
tag2word :: FnTag -> Word8
tag2word = \case
FnTag
FVarT -> Word8
0
FnTag
FCombT -> Word8
1
FnTag
FContT -> Word8
2
FnTag
FConT -> Word8
3
FnTag
FReqT -> Word8
4
FnTag
FPrimT -> Word8
5
FnTag
FForeignT -> Word8
6
word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m FnTag
word2tag = \case
Word8
0 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FVarT
Word8
1 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FCombT
Word8
2 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FContT
Word8
3 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FConT
Word8
4 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FReqT
Word8
5 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FPrimT
Word8
6 -> FnTag -> m FnTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FnTag
FForeignT
Word8
n -> String -> Word8 -> m FnTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"FnTag" Word8
n
instance Tag MtTag where
tag2word :: MtTag -> Word8
tag2word = \case
MtTag
MIntT -> Word8
0
MtTag
MTextT -> Word8
1
MtTag
MReqT -> Word8
2
MtTag
MEmptyT -> Word8
3
MtTag
MDataT -> Word8
4
MtTag
MSumT -> Word8
5
MtTag
MNumT -> Word8
6
word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m MtTag
word2tag = \case
Word8
0 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MIntT
Word8
1 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MTextT
Word8
2 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MReqT
Word8
3 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MEmptyT
Word8
4 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MDataT
Word8
5 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MSumT
Word8
6 -> MtTag -> m MtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MtTag
MNumT
Word8
n -> String -> Word8 -> m MtTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"MtTag" Word8
n
instance Tag LtTag where
tag2word :: LtTag -> Word8
tag2word = \case
LtTag
IT -> Word8
0
LtTag
NT -> Word8
1
LtTag
FT -> Word8
2
LtTag
TT -> Word8
3
LtTag
CT -> Word8
4
LtTag
LMT -> Word8
5
LtTag
LYT -> Word8
6
word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m LtTag
word2tag = \case
Word8
0 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
IT
Word8
1 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
NT
Word8
2 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
FT
Word8
3 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
TT
Word8
4 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
CT
Word8
5 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
LMT
Word8
6 -> LtTag -> m LtTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LtTag
LYT
Word8
n -> String -> Word8 -> m LtTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"LtTag" Word8
n
instance Tag BLTag where
tag2word :: BLTag -> Word8
tag2word = \case
BLTag
TextT -> Word8
0
BLTag
ListT -> Word8
1
BLTag
TmLinkT -> Word8
2
BLTag
TyLinkT -> Word8
3
BLTag
BytesT -> Word8
4
BLTag
QuoteT -> Word8
5
BLTag
CodeT -> Word8
6
BLTag
BArrT -> Word8
7
BLTag
PosT -> Word8
8
BLTag
NegT -> Word8
9
BLTag
CharT -> Word8
10
BLTag
FloatT -> Word8
11
BLTag
ArrT -> Word8
12
word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m BLTag
word2tag = \case
Word8
0 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
TextT
Word8
1 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
ListT
Word8
2 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
TmLinkT
Word8
3 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
TyLinkT
Word8
4 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
BytesT
Word8
5 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
QuoteT
Word8
6 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
CodeT
Word8
7 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
BArrT
Word8
8 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
PosT
Word8
9 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
NegT
Word8
10 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
CharT
Word8
11 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
FloatT
Word8
12 -> BLTag -> m BLTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BLTag
ArrT
Word8
t -> String -> Word8 -> m BLTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"BLTag" Word8
t
instance Tag VaTag where
tag2word :: VaTag -> Word8
tag2word = \case
VaTag
PartialT -> Word8
0
VaTag
DataT -> Word8
1
VaTag
ContT -> Word8
2
VaTag
BLitT -> Word8
3
word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m VaTag
word2tag = \case
Word8
0 -> VaTag -> m VaTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VaTag
PartialT
Word8
1 -> VaTag -> m VaTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VaTag
DataT
Word8
2 -> VaTag -> m VaTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VaTag
ContT
Word8
3 -> VaTag -> m VaTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VaTag
BLitT
Word8
t -> String -> Word8 -> m VaTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"VaTag" Word8
t
instance Tag CoTag where
tag2word :: CoTag -> Word8
tag2word = \case
CoTag
KET -> Word8
0
CoTag
MarkT -> Word8
1
CoTag
PushT -> Word8
2
word2tag :: forall (m :: * -> *). MonadGet m => Word8 -> m CoTag
word2tag = \case
Word8
0 -> CoTag -> m CoTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoTag
KET
Word8
1 -> CoTag -> m CoTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoTag
MarkT
Word8
2 -> CoTag -> m CoTag
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoTag
PushT
Word8
t -> String -> Word8 -> m CoTag
forall (m :: * -> *) a. MonadGet m => String -> Word8 -> m a
unknownTag String
"CoTag" Word8
t
index :: (Eq v) => [v] -> v -> Maybe Word64
index :: forall v. Eq v => [v] -> v -> Maybe Word64
index [v]
ctx v
u = Word64 -> [v] -> Maybe Word64
go Word64
0 [v]
ctx
where
go :: Word64 -> [v] -> Maybe Word64
go !Word64
_ [] = Maybe Word64
forall a. Maybe a
Nothing
go Word64
n (v
v : [v]
vs)
| v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
u = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
n
| Bool
otherwise = Word64 -> [v] -> Maybe Word64
go (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) [v]
vs
deindex :: (HasCallStack) => [v] -> Word64 -> v
deindex :: forall v. HasCallStack => [v] -> Word64 -> v
deindex [] Word64
_ = String -> v
forall a. HasCallStack => String -> a
exn String
"deindex: bad index"
deindex (v
v : [v]
vs) Word64
n
| Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = v
v
| Bool
otherwise = [v] -> Word64 -> v
forall v. HasCallStack => [v] -> Word64 -> v
deindex [v]
vs (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
pushCtx :: [v] -> [v] -> [v]
pushCtx :: forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
vs = [v] -> [v]
forall a. [a] -> [a]
reverse [v]
us [v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
++ [v]
vs
putIndex :: (MonadPut m) => Word64 -> m ()
putIndex :: forall (m :: * -> *). MonadPut m => Word64 -> m ()
putIndex = VarInt Word64 -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => VarInt Word64 -> m ()
serialize (VarInt Word64 -> m ())
-> (Word64 -> VarInt Word64) -> Word64 -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> VarInt Word64
forall n. n -> VarInt n
VarInt
getIndex :: (MonadGet m) => m Word64
getIndex :: forall (m :: * -> *). MonadGet m => m Word64
getIndex = VarInt Word64 -> Word64
forall n. VarInt n -> n
unVarInt (VarInt Word64 -> Word64) -> m (VarInt Word64) -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (VarInt Word64)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (VarInt Word64)
deserialize
putVar :: (MonadPut m) => (Eq v) => [v] -> v -> m ()
putVar :: forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
| Just Word64
i <- [v] -> v -> Maybe Word64
forall v. Eq v => [v] -> v -> Maybe Word64
index [v]
ctx v
v = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putIndex Word64
i
| Bool
otherwise = String -> m ()
forall a. HasCallStack => String -> a
exn String
"putVar: variable not in context"
getVar :: (MonadGet m) => [v] -> m v
getVar :: forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx = [v] -> Word64 -> v
forall v. HasCallStack => [v] -> Word64 -> v
deindex [v]
ctx (Word64 -> v) -> m Word64 -> m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getIndex
putArgs :: (MonadPut m) => (Eq v) => [v] -> [v] -> m ()
putArgs :: forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> [v] -> m ()
putArgs [v]
ctx [v]
is = (v -> m ()) -> [v] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable ([v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx) [v]
is
getArgs :: (MonadGet m) => [v] -> m [v]
getArgs :: forall (m :: * -> *) v. MonadGet m => [v] -> m [v]
getArgs [v]
ctx = m v -> m [v]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList ([v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx)
putCCs :: (MonadPut m) => [Mem] -> m ()
putCCs :: forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs = Int -> m ()
forall (m :: * -> *) n.
(MonadPut m, Integral n, Integral (Unsigned n), Bits n,
Bits (Unsigned n)) =>
n -> m ()
putLength Int
n m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Mem -> m ()) -> [Mem] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Mem -> m ()
forall {m :: * -> *}. MonadPut m => Mem -> m ()
putCC [Mem]
ccs
where
n :: Int
n = [Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs
putCC :: Mem -> m ()
putCC Mem
UN = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0
putCC Mem
BX = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
1
getCCs :: (MonadGet m) => m [Mem]
getCCs :: forall (m :: * -> *). MonadGet m => m [Mem]
getCCs =
m Mem -> m [Mem]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (m Mem -> m [Mem]) -> m Mem -> m [Mem]
forall a b. (a -> b) -> a -> b
$
m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> Mem) -> m Mem
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Word8
0 -> Mem
UN
Word8
1 -> Mem
BX
Word8
_ -> String -> Mem
forall a. HasCallStack => String -> a
exn String
"getCCs: bad calling convention"
putGroup ::
(MonadPut m) =>
(Var v) =>
Map Reference Word64 ->
EC.EnumMap FOp Text ->
SuperGroup v ->
m ()
putGroup :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
refrep EnumMap Word64 Text
fops (Rec [(v, SuperNormal v)]
bs SuperNormal v
e) =
Int -> m ()
forall (m :: * -> *) n.
(MonadPut m, Integral n, Integral (Unsigned n), Bits n,
Bits (Unsigned n)) =>
n -> m ()
putLength Int
n
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SuperNormal v -> m ()) -> [SuperNormal v] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> SuperNormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> SuperNormal v -> m ()
putComb Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) [SuperNormal v]
cs
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> SuperNormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> SuperNormal v -> m ()
putComb Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx SuperNormal v
e
where
n :: Int
n = [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
us
([v]
us, [SuperNormal v]
cs) = [(v, SuperNormal v)] -> ([v], [SuperNormal v])
forall a b. [(a, b)] -> ([a], [b])
unzip [(v, SuperNormal v)]
bs
ctx :: [v]
ctx = [v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us []
getGroup :: (MonadGet m) => (Var v) => m (SuperGroup v)
getGroup :: forall (m :: * -> *) v. (MonadGet m, Var v) => m (SuperGroup v)
getGroup = do
Int
l <- m Int
forall (m :: * -> *) n.
(MonadGet m, Integral n, Integral (Unsigned n), Bits n,
Bits (Unsigned n)) =>
m n
getLength
let n :: Word64
n = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
vs :: [v]
vs = Word64 -> v
forall v. Var v => Word64 -> v
getFresh (Word64 -> v) -> [Word64] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
l [Word64
0 ..]
ctx :: [v]
ctx = [v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
vs []
[SuperNormal v]
cs <- Int -> m (SuperNormal v) -> m [SuperNormal v]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
l ([v] -> Word64 -> m (SuperNormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (SuperNormal v)
getComb [v]
ctx Word64
n)
[(v, SuperNormal v)] -> SuperNormal v -> SuperGroup v
forall v. [(v, SuperNormal v)] -> SuperNormal v -> SuperGroup v
Rec ([v] -> [SuperNormal v] -> [(v, SuperNormal v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs [SuperNormal v]
cs) (SuperNormal v -> SuperGroup v)
-> m (SuperNormal v) -> m (SuperGroup v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (SuperNormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (SuperNormal v)
getComb [v]
ctx Word64
n
putComb ::
(MonadPut m) =>
(Var v) =>
Map Reference Word64 ->
EC.EnumMap FOp Text ->
[v] ->
SuperNormal v ->
m ()
putComb :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> SuperNormal v -> m ()
putComb Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx (Lambda [Mem]
ccs (TAbss [v]
us Term ANormalF v
e)) =
[Mem] -> m ()
forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Term ANormalF v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Term ANormalF v
e
getFresh :: (Var v) => Word64 -> v
getFresh :: forall v. Var v => Word64 -> v
getFresh Word64
n = Word64 -> v -> v
forall v. Var v => Word64 -> v -> v
freshenId Word64
n (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ Type -> v
forall v. Var v => Type -> v
typed Type
ANFBlank
getComb :: (MonadGet m) => (Var v) => [v] -> Word64 -> m (SuperNormal v)
getComb :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (SuperNormal v)
getComb [v]
ctx Word64
frsh0 = do
[Mem]
ccs <- m [Mem]
forall (m :: * -> *). MonadGet m => m [Mem]
getCCs
let us :: [v]
us = (Mem -> Word64 -> v) -> [Mem] -> [Word64] -> [v]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Mem
_ -> Word64 -> v
forall v. Var v => Word64 -> v
getFresh) [Mem]
ccs [Word64
frsh0 ..]
frsh :: Word64
frsh = Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs)
[Mem] -> ANormal v -> SuperNormal v
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem]
ccs (ANormal v -> SuperNormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> SuperNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v]
us (ANormal v -> SuperNormal v) -> m (ANormal v) -> m (SuperNormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Word64
frsh
putNormal ::
(MonadPut m) =>
(Var v) =>
Map Reference Word64 ->
EC.EnumMap FOp Text ->
[v] ->
ANormal v ->
m ()
putNormal :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx ANormal v
tm = case ANormal v
tm of
TVar v
v -> TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
VarT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
TFrc v
v -> TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
ForceT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
TApp Func v
f [v]
as -> TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
AppT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Func v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Func v -> m ()
putFunc Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx Func v
f m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> [v] -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> [v] -> m ()
putArgs [v]
ctx [v]
as
THnd [Reference]
rs v
h ANormal v
e ->
TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
HandleT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Reference] -> m ()
forall (m :: * -> *). MonadPut m => [Reference] -> m ()
putRefs [Reference]
rs
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
h
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx ANormal v
e
TShift Reference
r v
v ANormal v
e ->
TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
ShiftT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal v
e
TMatch v
v Branched (ANormal v)
bs ->
TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
MatchT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Branched (ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Branched (ANormal v) -> m ()
putBranches Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx Branched (ANormal v)
bs
TLit Lit
l -> TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
LitT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lit -> m ()
forall (m :: * -> *). MonadPut m => Lit -> m ()
putLit Lit
l
TBLit Lit
l -> TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
BxLitT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lit -> m ()
forall (m :: * -> *). MonadPut m => Lit -> m ()
putLit Lit
l
TName v
v (Left Reference
r) [v]
as ANormal v
e ->
TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
NameRefT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
pr
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> [v] -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> [v] -> m ()
putArgs [v]
ctx [v]
as
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal v
e
where
pr :: m ()
pr
| Just Word64
w <- Reference -> Map Reference Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
r Map Reference Word64
refrep = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
w
| Bool
otherwise = Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
TName v
v (Right v
u) [v]
as ANormal v
e ->
TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
NameVarT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
u
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> [v] -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> [v] -> m ()
putArgs [v]
ctx [v]
as
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal v
e
TLets Direction Word16
Direct [v]
us [Mem]
ccs ANormal v
l ANormal v
e ->
TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
LetDirT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Mem] -> m ()
forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx ANormal v
l
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal v
e
TLets (Indirect Word16
w) [v]
us [Mem]
ccs ANormal v
l ANormal v
e ->
TmTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag TmTag
LetIndT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16be Word16
w
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Mem] -> m ()
forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx ANormal v
l
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal v
e
ANormal v
_ -> String -> m ()
forall a. HasCallStack => String -> a
exn String
"putNormal: malformed term"
getNormal :: (MonadGet m) => (Var v) => [v] -> Word64 -> m (ANormal v)
getNormal :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0 =
m TmTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m TmTag -> (TmTag -> m (ANormal v)) -> m (ANormal v)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TmTag
VarT -> v -> ANormal v
forall v. Var v => v -> Term ANormalF v
TVar (v -> ANormal v) -> m v -> m (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
TmTag
ForceT -> v -> ANormal v
forall v. Var v => v -> Term ANormalF v
TFrc (v -> ANormal v) -> m v -> m (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
TmTag
AppT -> Func v -> [v] -> ANormal v
forall v. Var v => Func v -> [v] -> Term ANormalF v
TApp (Func v -> [v] -> ANormal v) -> m (Func v) -> m ([v] -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m (Func v)
forall (m :: * -> *) v. (MonadGet m, Var v) => [v] -> m (Func v)
getFunc [v]
ctx m ([v] -> ANormal v) -> m [v] -> m (ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> m [v]
forall (m :: * -> *) v. MonadGet m => [v] -> m [v]
getArgs [v]
ctx
TmTag
HandleT -> [Reference] -> v -> ANormal v -> ANormal v
forall v.
Var v =>
[Reference] -> v -> Term ANormalF v -> Term ANormalF v
THnd ([Reference] -> v -> ANormal v -> ANormal v)
-> m [Reference] -> m (v -> ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Reference]
forall (m :: * -> *). MonadGet m => m [Reference]
getRefs m (v -> ANormal v -> ANormal v)
-> m v -> m (ANormal v -> ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx m (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0
TmTag
ShiftT ->
(Reference -> v -> ANormal v -> ANormal v)
-> v -> Reference -> ANormal v -> ANormal v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reference -> v -> ANormal v -> ANormal v
forall v.
Var v =>
Reference -> v -> Term ANormalF v -> Term ANormalF v
TShift v
v (Reference -> ANormal v -> ANormal v)
-> m Reference -> m (ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) (Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
where
v :: v
v = Word64 -> v
forall v. Var v => Word64 -> v
getFresh Word64
frsh0
TmTag
MatchT -> v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch (v -> Branched (ANormal v) -> ANormal v)
-> m v -> m (Branched (ANormal v) -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx m (Branched (ANormal v) -> ANormal v)
-> m (Branched (ANormal v)) -> m (ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (Branched (ANormal v))
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (Branched (ANormal v))
getBranches [v]
ctx Word64
frsh0
TmTag
LitT -> Lit -> ANormal v
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> ANormal v) -> m Lit -> m (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Lit
forall (m :: * -> *). MonadGet m => m Lit
getLit
TmTag
BxLitT -> Lit -> ANormal v
forall v. Var v => Lit -> Term ANormalF v
TBLit (Lit -> ANormal v) -> m Lit -> m (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Lit
forall (m :: * -> *). MonadGet m => m Lit
getLit
TmTag
NameRefT ->
v -> Either Reference v -> [v] -> ANormal v -> ANormal v
forall v.
Var v =>
v
-> Either Reference v -> [v] -> Term ANormalF v -> Term ANormalF v
TName v
v (Either Reference v -> [v] -> ANormal v -> ANormal v)
-> (Reference -> Either Reference v)
-> Reference
-> [v]
-> ANormal v
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Either Reference v
forall a b. a -> Either a b
Left
(Reference -> [v] -> ANormal v -> ANormal v)
-> m Reference -> m ([v] -> ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
m ([v] -> ANormal v -> ANormal v)
-> m [v] -> m (ANormal v -> ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> m [v]
forall (m :: * -> *) v. MonadGet m => [v] -> m [v]
getArgs [v]
ctx
m (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) (Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
where
v :: v
v = Word64 -> v
forall v. Var v => Word64 -> v
getFresh Word64
frsh0
TmTag
NameVarT ->
v -> Either Reference v -> [v] -> ANormal v -> ANormal v
forall v.
Var v =>
v
-> Either Reference v -> [v] -> Term ANormalF v -> Term ANormalF v
TName v
v (Either Reference v -> [v] -> ANormal v -> ANormal v)
-> (v -> Either Reference v) -> v -> [v] -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Either Reference v
forall a b. b -> Either a b
Right
(v -> [v] -> ANormal v -> ANormal v)
-> m v -> m ([v] -> ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
m ([v] -> ANormal v -> ANormal v)
-> m [v] -> m (ANormal v -> ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> m [v]
forall (m :: * -> *) v. MonadGet m => [v] -> m [v]
getArgs [v]
ctx
m (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) (Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
where
v :: v
v = Word64 -> v
forall v. Var v => Word64 -> v
getFresh Word64
frsh0
TmTag
LetDirT -> do
[Mem]
ccs <- m [Mem]
forall (m :: * -> *). MonadGet m => m [Mem]
getCCs
let l :: Int
l = [Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs
frsh :: Word64
frsh = Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
us :: [v]
us = Word64 -> v
forall v. Var v => Word64 -> v
getFresh (Word64 -> v) -> [Word64] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
l [Word64
frsh0 ..]
Direction Word16
-> [v] -> [Mem] -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets Direction Word16
forall a. Direction a
Direct [v]
us [Mem]
ccs
(ANormal v -> ANormal v -> ANormal v)
-> m (ANormal v) -> m (ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0
m (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Word64
frsh
TmTag
LetIndT -> do
Word16
w <- m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16be
[Mem]
ccs <- m [Mem]
forall (m :: * -> *). MonadGet m => m [Mem]
getCCs
let l :: Int
l = [Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs
frsh :: Word64
frsh = Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
us :: [v]
us = Word64 -> v
forall v. Var v => Word64 -> v
getFresh (Word64 -> v) -> [Word64] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
l [Word64
frsh0 ..]
Direction Word16
-> [v] -> [Mem] -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets (Word16 -> Direction Word16
forall a. a -> Direction a
Indirect Word16
w) [v]
us [Mem]
ccs
(ANormal v -> ANormal v -> ANormal v)
-> m (ANormal v) -> m (ANormal v -> ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0
m (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Word64
frsh
putFunc ::
(MonadPut m) =>
(Var v) =>
Map Reference Word64 ->
EC.EnumMap FOp Text ->
[v] ->
Func v ->
m ()
putFunc :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Func v -> m ()
putFunc Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx Func v
f = case Func v
f of
FVar v
v -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FVarT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
FComb Reference
r
| Just Word64
w <- Reference -> Map Reference Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
r Map Reference Word64
refrep -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FCombT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
w
| Bool
otherwise -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FCombT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
FCont v
v -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FContT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [v] -> v -> m ()
forall (m :: * -> *) v. (MonadPut m, Eq v) => [v] -> v -> m ()
putVar [v]
ctx v
v
FCon Reference
r CTag
c -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FConT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CTag -> m ()
forall (m :: * -> *). MonadPut m => CTag -> m ()
putCTag CTag
c
FReq Reference
r CTag
c -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FReqT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CTag -> m ()
forall (m :: * -> *). MonadPut m => CTag -> m ()
putCTag CTag
c
FPrim (Left POp
p) -> FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FPrimT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> POp -> m ()
forall (m :: * -> *). MonadPut m => POp -> m ()
putPOp POp
p
FPrim (Right Word64
f)
| Just Text
nm <- Word64 -> EnumMap Word64 Text -> Maybe Text
forall k a. EnumKey k => k -> EnumMap k a -> Maybe a
EC.lookup Word64
f EnumMap Word64 Text
fops ->
FnTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag FnTag
FForeignT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> m ()
forall (m :: * -> *). MonadPut m => Text -> m ()
putText Text
nm
| Bool
otherwise ->
String -> m ()
forall a. HasCallStack => String -> a
exn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"putFunc: could not serialize foreign operation: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
f
getFunc :: (MonadGet m) => (Var v) => [v] -> m (Func v)
getFunc :: forall (m :: * -> *) v. (MonadGet m, Var v) => [v] -> m (Func v)
getFunc [v]
ctx =
m FnTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m FnTag -> (FnTag -> m (Func v)) -> m (Func v)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
FnTag
FVarT -> v -> Func v
forall v. v -> Func v
FVar (v -> Func v) -> m v -> m (Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
FnTag
FCombT -> Reference -> Func v
forall v. Reference -> Func v
FComb (Reference -> Func v) -> m Reference -> m (Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
FnTag
FContT -> v -> Func v
forall v. v -> Func v
FCont (v -> Func v) -> m v -> m (Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> m v
forall (m :: * -> *) v. MonadGet m => [v] -> m v
getVar [v]
ctx
FnTag
FConT -> Reference -> CTag -> Func v
forall v. Reference -> CTag -> Func v
FCon (Reference -> CTag -> Func v) -> m Reference -> m (CTag -> Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (CTag -> Func v) -> m CTag -> m (Func v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m CTag
forall (m :: * -> *). MonadGet m => m CTag
getCTag
FnTag
FReqT -> Reference -> CTag -> Func v
forall v. Reference -> CTag -> Func v
FReq (Reference -> CTag -> Func v) -> m Reference -> m (CTag -> Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (CTag -> Func v) -> m CTag -> m (Func v)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m CTag
forall (m :: * -> *). MonadGet m => m CTag
getCTag
FnTag
FPrimT -> Either POp Word64 -> Func v
forall v. Either POp Word64 -> Func v
FPrim (Either POp Word64 -> Func v)
-> (POp -> Either POp Word64) -> POp -> Func v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POp -> Either POp Word64
forall a b. a -> Either a b
Left (POp -> Func v) -> m POp -> m (Func v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m POp
forall (m :: * -> *). MonadGet m => m POp
getPOp
FnTag
FForeignT -> String -> m (Func v)
forall a. HasCallStack => String -> a
exn String
"getFunc: can't deserialize a foreign func"
putPOp :: (MonadPut m) => POp -> m ()
putPOp :: forall (m :: * -> *). MonadPut m => POp -> m ()
putPOp POp
op
| Just Word16
w <- POp -> Map POp Word16 -> Maybe Word16
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup POp
op Map POp Word16
pop2word = Word16 -> m ()
forall (m :: * -> *). MonadPut m => Word16 -> m ()
putWord16be Word16
w
| Bool
otherwise = String -> m ()
forall a. HasCallStack => String -> a
exn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"putPOp: unknown POp: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ POp -> String
forall a. Show a => a -> String
show POp
op
getPOp :: (MonadGet m) => m POp
getPOp :: forall (m :: * -> *). MonadGet m => m POp
getPOp =
m Word16
forall (m :: * -> *). MonadGet m => m Word16
getWord16be m Word16 -> (Word16 -> m POp) -> m POp
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word16
w -> case Word16 -> Map Word16 POp -> Maybe POp
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word16
w Map Word16 POp
word2pop of
Just POp
op -> POp -> m POp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure POp
op
Maybe POp
Nothing -> String -> m POp
forall a. HasCallStack => String -> a
exn String
"getPOp: unknown enum code"
pOpCode :: POp -> Word16
pOpCode :: POp -> Word16
pOpCode POp
op = case POp
op of
POp
ADDI -> Word16
0
POp
SUBI -> Word16
1
POp
MULI -> Word16
2
POp
DIVI -> Word16
3
POp
SGNI -> Word16
4
POp
NEGI -> Word16
5
POp
MODI -> Word16
6
POp
POWI -> Word16
7
POp
SHLI -> Word16
8
POp
SHRI -> Word16
9
POp
INCI -> Word16
10
POp
DECI -> Word16
11
POp
LEQI -> Word16
12
POp
EQLI -> Word16
13
POp
ADDN -> Word16
14
POp
SUBN -> Word16
15
POp
MULN -> Word16
16
POp
DIVN -> Word16
17
POp
MODN -> Word16
18
POp
TZRO -> Word16
19
POp
LZRO -> Word16
20
POp
POWN -> Word16
21
POp
SHLN -> Word16
22
POp
SHRN -> Word16
23
POp
ANDN -> Word16
24
POp
IORN -> Word16
25
POp
XORN -> Word16
26
POp
COMN -> Word16
27
POp
INCN -> Word16
28
POp
DECN -> Word16
29
POp
LEQN -> Word16
30
POp
EQLN -> Word16
31
POp
ADDF -> Word16
32
POp
SUBF -> Word16
33
POp
MULF -> Word16
34
POp
DIVF -> Word16
35
POp
MINF -> Word16
36
POp
MAXF -> Word16
37
POp
LEQF -> Word16
38
POp
EQLF -> Word16
39
POp
POWF -> Word16
40
POp
EXPF -> Word16
41
POp
SQRT -> Word16
42
POp
LOGF -> Word16
43
POp
LOGB -> Word16
44
POp
ABSF -> Word16
45
POp
CEIL -> Word16
46
POp
FLOR -> Word16
47
POp
TRNF -> Word16
48
POp
RNDF -> Word16
49
POp
COSF -> Word16
50
POp
ACOS -> Word16
51
POp
COSH -> Word16
52
POp
ACSH -> Word16
53
POp
SINF -> Word16
54
POp
ASIN -> Word16
55
POp
SINH -> Word16
56
POp
ASNH -> Word16
57
POp
TANF -> Word16
58
POp
ATAN -> Word16
59
POp
TANH -> Word16
60
POp
ATNH -> Word16
61
POp
ATN2 -> Word16
62
POp
CATT -> Word16
63
POp
TAKT -> Word16
64
POp
DRPT -> Word16
65
POp
SIZT -> Word16
66
POp
UCNS -> Word16
67
POp
USNC -> Word16
68
POp
EQLT -> Word16
69
POp
LEQT -> Word16
70
POp
PAKT -> Word16
71
POp
UPKT -> Word16
72
POp
CATS -> Word16
73
POp
TAKS -> Word16
74
POp
DRPS -> Word16
75
POp
SIZS -> Word16
76
POp
CONS -> Word16
77
POp
SNOC -> Word16
78
POp
IDXS -> Word16
79
POp
BLDS -> Word16
80
POp
VWLS -> Word16
81
POp
VWRS -> Word16
82
POp
SPLL -> Word16
83
POp
SPLR -> Word16
84
POp
PAKB -> Word16
85
POp
UPKB -> Word16
86
POp
TAKB -> Word16
87
POp
DRPB -> Word16
88
POp
IDXB -> Word16
89
POp
SIZB -> Word16
90
POp
FLTB -> Word16
91
POp
CATB -> Word16
92
POp
ITOF -> Word16
93
POp
NTOF -> Word16
94
POp
ITOT -> Word16
95
POp
NTOT -> Word16
96
POp
TTOI -> Word16
97
POp
TTON -> Word16
98
POp
TTOF -> Word16
99
POp
FTOT -> Word16
100
POp
FORK -> Word16
101
POp
EQLU -> Word16
102
POp
CMPU -> Word16
103
POp
EROR -> Word16
104
POp
PRNT -> Word16
105
POp
INFO -> Word16
106
POp
POPC -> Word16
107
POp
MISS -> Word16
108
POp
CACH -> Word16
109
POp
LKUP -> Word16
110
POp
LOAD -> Word16
111
POp
CVLD -> Word16
112
POp
SDBX -> Word16
113
POp
VALU -> Word16
114
POp
TLTT -> Word16
115
POp
TRCE -> Word16
116
POp
ATOM -> Word16
117
POp
TFRC -> Word16
118
POp
DBTX -> Word16
119
POp
IXOT -> Word16
120
POp
IXOB -> Word16
121
POp
SDBL -> Word16
122
POp
SDBV -> Word16
123
pOpAssoc :: [(POp, Word16)]
pOpAssoc :: [(POp, Word16)]
pOpAssoc = (POp -> (POp, Word16)) -> [POp] -> [(POp, Word16)]
forall a b. (a -> b) -> [a] -> [b]
map (\POp
op -> (POp
op, POp -> Word16
pOpCode POp
op)) [POp
forall a. Bounded a => a
minBound .. POp
forall a. Bounded a => a
maxBound]
pop2word :: Map POp Word16
pop2word :: Map POp Word16
pop2word = [(POp, Word16)] -> Map POp Word16
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(POp, Word16)]
pOpAssoc
word2pop :: Map Word16 POp
word2pop :: Map Word16 POp
word2pop = [(Word16, POp)] -> Map Word16 POp
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Word16, POp)] -> Map Word16 POp)
-> [(Word16, POp)] -> Map Word16 POp
forall a b. (a -> b) -> a -> b
$ (POp, Word16) -> (Word16, POp)
forall {b} {a}. (b, a) -> (a, b)
swap ((POp, Word16) -> (Word16, POp))
-> [(POp, Word16)] -> [(Word16, POp)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(POp, Word16)]
pOpAssoc
where
swap :: (b, a) -> (a, b)
swap (b
x, a
y) = (a
y, b
x)
putLit :: (MonadPut m) => Lit -> m ()
putLit :: forall (m :: * -> *). MonadPut m => Lit -> m ()
putLit (I Int64
i) = LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
IT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int64 -> m ()
forall (m :: * -> *). MonadPut m => Int64 -> m ()
putInt Int64
i
putLit (N Word64
n) = LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
NT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putNat Word64
n
putLit (F Double
f) = LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
FT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Double -> m ()
forall (m :: * -> *). MonadPut m => Double -> m ()
putFloat Double
f
putLit (T Text
t) = LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
TT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> m ()
forall (m :: * -> *). MonadPut m => Text -> m ()
putText (Text -> Text
Util.Text.toText Text
t)
putLit (C Char
c) = LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
CT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> m ()
forall (m :: * -> *). MonadPut m => Char -> m ()
putChar Char
c
putLit (LM Referent
r) = LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
LMT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Referent -> m ()
forall (m :: * -> *). MonadPut m => Referent -> m ()
putReferent Referent
r
putLit (LY Reference
r) = LtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag LtTag
LYT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
getLit :: (MonadGet m) => m Lit
getLit :: forall (m :: * -> *). MonadGet m => m Lit
getLit =
m LtTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m LtTag -> (LtTag -> m Lit) -> m Lit
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
LtTag
IT -> Int64 -> Lit
I (Int64 -> Lit) -> m Int64 -> m Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int64
forall (m :: * -> *). MonadGet m => m Int64
getInt
LtTag
NT -> Word64 -> Lit
N (Word64 -> Lit) -> m Word64 -> m Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getNat
LtTag
FT -> Double -> Lit
F (Double -> Lit) -> m Double -> m Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Double
forall (m :: * -> *). MonadGet m => m Double
getFloat
LtTag
TT -> Text -> Lit
T (Text -> Lit) -> (Text -> Text) -> Text -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.fromText (Text -> Lit) -> m Text -> m Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
forall (m :: * -> *). MonadGet m => m Text
getText
LtTag
CT -> Char -> Lit
C (Char -> Lit) -> m Char -> m Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall (m :: * -> *). MonadGet m => m Char
getChar
LtTag
LMT -> Referent -> Lit
LM (Referent -> Lit) -> m Referent -> m Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Referent
forall (m :: * -> *). MonadGet m => m Referent
getReferent
LtTag
LYT -> Reference -> Lit
LY (Reference -> Lit) -> m Reference -> m Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
putBLit :: (MonadPut m) => BLit -> m ()
putBLit :: forall (m :: * -> *). MonadPut m => BLit -> m ()
putBLit (Text Text
t) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
TextT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> m ()
forall (m :: * -> *). MonadPut m => Text -> m ()
putText (Text -> Text
Util.Text.toText Text
t)
putBLit (List Seq Value
s) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
ListT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Value -> m ()) -> Seq Value -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Seq Value
s
putBLit (TmLink Referent
r) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
TmLinkT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Referent -> m ()
forall (m :: * -> *). MonadPut m => Referent -> m ()
putReferent Referent
r
putBLit (TyLink Reference
r) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
TyLinkT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
putBLit (Bytes Bytes
b) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
BytesT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bytes -> m ()
forall (m :: * -> *). MonadPut m => Bytes -> m ()
putBytes Bytes
b
putBLit (Quote Value
v) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
QuoteT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Value
v
putBLit (Code SuperGroup Symbol
g) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
CodeT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> SuperGroup Symbol -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
forall a. Monoid a => a
mempty EnumMap Word64 Text
forall a. Monoid a => a
mempty SuperGroup Symbol
g
putBLit (BArr ByteArray
a) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
BArrT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteArray -> m ()
forall (m :: * -> *). MonadPut m => ByteArray -> m ()
putByteArray ByteArray
a
putBLit (Pos Word64
n) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
PosT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> m ()
forall (m :: * -> *) n.
(MonadPut m, Bits n, Bits (Unsigned n), Integral n,
Integral (Unsigned n)) =>
n -> m ()
putPositive Word64
n
putBLit (Neg Word64
n) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
NegT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> m ()
forall (m :: * -> *) n.
(MonadPut m, Bits n, Bits (Unsigned n), Integral n,
Integral (Unsigned n)) =>
n -> m ()
putPositive Word64
n
putBLit (Char Char
c) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
CharT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> m ()
forall (m :: * -> *). MonadPut m => Char -> m ()
putChar Char
c
putBLit (Float Double
d) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
FloatT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Double -> m ()
forall (m :: * -> *). MonadPut m => Double -> m ()
putFloat Double
d
putBLit (Arr Array Value
a) = BLTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag BLTag
ArrT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Value -> m ()) -> Array Value -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Array Value
a
getBLit :: (MonadGet m) => Version -> m BLit
getBLit :: forall (m :: * -> *). MonadGet m => Word32 -> m BLit
getBLit Word32
v =
m BLTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m BLTag -> (BLTag -> m BLit) -> m BLit
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
BLTag
TextT -> Text -> BLit
Text (Text -> BLit) -> (Text -> Text) -> Text -> BLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.fromText (Text -> BLit) -> m Text -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
forall (m :: * -> *). MonadGet m => m Text
getText
BLTag
ListT -> Seq Value -> BLit
List (Seq Value -> BLit) -> ([Value] -> Seq Value) -> [Value] -> BLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Seq Value
forall a. [a] -> Seq a
Seq.fromList ([Value] -> BLit) -> m [Value] -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
BLTag
TmLinkT -> Referent -> BLit
TmLink (Referent -> BLit) -> m Referent -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Referent
forall (m :: * -> *). MonadGet m => m Referent
getReferent
BLTag
TyLinkT -> Reference -> BLit
TyLink (Reference -> BLit) -> m Reference -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
BLTag
BytesT -> Bytes -> BLit
Bytes (Bytes -> BLit) -> m Bytes -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bytes
forall (m :: * -> *). MonadGet m => m Bytes
getBytes
BLTag
QuoteT -> Value -> BLit
Quote (Value -> BLit) -> m Value -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v
BLTag
CodeT -> SuperGroup Symbol -> BLit
Code (SuperGroup Symbol -> BLit) -> m (SuperGroup Symbol) -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (SuperGroup Symbol)
forall (m :: * -> *) v. (MonadGet m, Var v) => m (SuperGroup v)
getGroup
BLTag
BArrT -> ByteArray -> BLit
BArr (ByteArray -> BLit) -> m ByteArray -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteArray
forall (m :: * -> *). MonadGet m => m ByteArray
getByteArray
BLTag
PosT -> Word64 -> BLit
Pos (Word64 -> BLit) -> m Word64 -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *) n. (Bounded n, Integral n, MonadGet m) => m n
getPositive
BLTag
NegT -> Word64 -> BLit
Neg (Word64 -> BLit) -> m Word64 -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *) n. (Bounded n, Integral n, MonadGet m) => m n
getPositive
BLTag
CharT -> Char -> BLit
Char (Char -> BLit) -> m Char -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall (m :: * -> *). MonadGet m => m Char
getChar
BLTag
FloatT -> Double -> BLit
Float (Double -> BLit) -> m Double -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Double
forall (m :: * -> *). MonadGet m => m Double
getFloat
BLTag
ArrT -> Array Value -> BLit
Arr (Array Value -> BLit)
-> ([Value] -> Array Value) -> [Value] -> BLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (Array Value)] -> Array Value
[Value] -> Array Value
forall l. IsList l => [Item l] -> l
GHC.IsList.fromList ([Value] -> BLit) -> m [Value] -> m BLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
putRefs :: (MonadPut m) => [Reference] -> m ()
putRefs :: forall (m :: * -> *). MonadPut m => [Reference] -> m ()
putRefs [Reference]
rs = (Reference -> m ()) -> [Reference] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference [Reference]
rs
getRefs :: (MonadGet m) => m [Reference]
getRefs :: forall (m :: * -> *). MonadGet m => m [Reference]
getRefs = m Reference -> m [Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
putBranches ::
(MonadPut m) =>
(Var v) =>
Map Reference Word64 ->
EC.EnumMap FOp Text ->
[v] ->
Branched (ANormal v) ->
m ()
putBranches :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> Branched (ANormal v) -> m ()
putBranches Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx Branched (ANormal v)
bs = case Branched (ANormal v)
bs of
Branched (ANormal v)
MatchEmpty -> MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MEmptyT
MatchIntegral EnumMap Word64 (ANormal v)
m Maybe (ANormal v)
df -> do
MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MIntT
(Word64 -> m ())
-> (ANormal v -> m ()) -> EnumMap Word64 (ANormal v) -> m ()
forall (m :: * -> *) k v.
(MonadPut m, EnumKey k) =>
(k -> m ()) -> (v -> m ()) -> EnumMap k v -> m ()
putEnumMap Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) EnumMap Word64 (ANormal v)
m
Maybe (ANormal v) -> (ANormal v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal v)
df ((ANormal v -> m ()) -> m ()) -> (ANormal v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx
MatchText Map Text (ANormal v)
m Maybe (ANormal v)
df -> do
MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MTextT
(Text -> m ())
-> (ANormal v -> m ()) -> Map Text (ANormal v) -> m ()
forall (m :: * -> *) a b.
MonadPut m =>
(a -> m ()) -> (b -> m ()) -> Map a b -> m ()
putMap (Text -> m ()
forall (m :: * -> *). MonadPut m => Text -> m ()
putText (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.toText) (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) Map Text (ANormal v)
m
Maybe (ANormal v) -> (ANormal v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal v)
df ((ANormal v -> m ()) -> m ()) -> (ANormal v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx
MatchRequest Map Reference (EnumMap CTag ([Mem], ANormal v))
m (TAbs v
v ANormal v
df) -> do
MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MReqT
(Reference -> m ())
-> (EnumMap CTag ([Mem], ANormal v) -> m ())
-> Map Reference (EnumMap CTag ([Mem], ANormal v))
-> m ()
forall (m :: * -> *) a b.
MonadPut m =>
(a -> m ()) -> (b -> m ()) -> Map a b -> m ()
putMap Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference ((CTag -> m ())
-> (([Mem], ANormal v) -> m ())
-> EnumMap CTag ([Mem], ANormal v)
-> m ()
forall (m :: * -> *) k v.
(MonadPut m, EnumKey k) =>
(k -> m ()) -> (v -> m ()) -> EnumMap k v -> m ()
putEnumMap CTag -> m ()
forall (m :: * -> *). MonadPut m => CTag -> m ()
putCTag (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx)) Map Reference (EnumMap CTag ([Mem], ANormal v))
m
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) ANormal v
df
MatchData Reference
r EnumMap CTag ([Mem], ANormal v)
m Maybe (ANormal v)
df -> do
MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MDataT
Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
(CTag -> m ())
-> (([Mem], ANormal v) -> m ())
-> EnumMap CTag ([Mem], ANormal v)
-> m ()
forall (m :: * -> *) k v.
(MonadPut m, EnumKey k) =>
(k -> m ()) -> (v -> m ()) -> EnumMap k v -> m ()
putEnumMap CTag -> m ()
forall (m :: * -> *). MonadPut m => CTag -> m ()
putCTag (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) EnumMap CTag ([Mem], ANormal v)
m
Maybe (ANormal v) -> (ANormal v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal v)
df ((ANormal v -> m ()) -> m ()) -> (ANormal v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx
MatchSum EnumMap Word64 ([Mem], ANormal v)
m -> do
MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MSumT
(Word64 -> m ())
-> (([Mem], ANormal v) -> m ())
-> EnumMap Word64 ([Mem], ANormal v)
-> m ()
forall (m :: * -> *) k v.
(MonadPut m, EnumKey k) =>
(k -> m ()) -> (v -> m ()) -> EnumMap k v -> m ()
putEnumMap Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) EnumMap Word64 ([Mem], ANormal v)
m
MatchNumeric Reference
r EnumMap Word64 (ANormal v)
m Maybe (ANormal v)
df -> do
MtTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag MtTag
MNumT
Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
(Word64 -> m ())
-> (ANormal v -> m ()) -> EnumMap Word64 (ANormal v) -> m ()
forall (m :: * -> *) k v.
(MonadPut m, EnumKey k) =>
(k -> m ()) -> (v -> m ()) -> EnumMap k v -> m ()
putEnumMap Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx) EnumMap Word64 (ANormal v)
m
Maybe (ANormal v) -> (ANormal v -> m ()) -> m ()
forall (m :: * -> *) a.
MonadPut m =>
Maybe a -> (a -> m ()) -> m ()
putMaybe Maybe (ANormal v)
df ((ANormal v -> m ()) -> m ()) -> (ANormal v -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx
Branched (ANormal v)
_ -> String -> m ()
forall a. HasCallStack => String -> a
exn String
"putBranches: malformed intermediate term"
getBranches ::
(MonadGet m) => (Var v) => [v] -> Word64 -> m (Branched (ANormal v))
getBranches :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (Branched (ANormal v))
getBranches [v]
ctx Word64
frsh0 =
m MtTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m MtTag
-> (MtTag -> m (Branched (ANormal v))) -> m (Branched (ANormal v))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MtTag
MEmptyT -> Branched (ANormal v) -> m (Branched (ANormal v))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branched (ANormal v)
forall e. Branched e
MatchEmpty
MtTag
MIntT ->
EnumMap Word64 (ANormal v)
-> Maybe (ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral
(EnumMap Word64 (ANormal v)
-> Maybe (ANormal v) -> Branched (ANormal v))
-> m (EnumMap Word64 (ANormal v))
-> m (Maybe (ANormal v) -> Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64 -> m (ANormal v) -> m (EnumMap Word64 (ANormal v))
forall (m :: * -> *) k v.
(MonadGet m, EnumKey k) =>
m k -> m v -> m (EnumMap k v)
getEnumMap m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
m (Maybe (ANormal v) -> Branched (ANormal v))
-> m (Maybe (ANormal v)) -> m (Branched (ANormal v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (ANormal v) -> m (Maybe (ANormal v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
MtTag
MTextT ->
Map Text (ANormal v) -> Maybe (ANormal v) -> Branched (ANormal v)
forall e. Map Text e -> Maybe e -> Branched e
MatchText
(Map Text (ANormal v) -> Maybe (ANormal v) -> Branched (ANormal v))
-> m (Map Text (ANormal v))
-> m (Maybe (ANormal v) -> Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text -> m (ANormal v) -> m (Map Text (ANormal v))
forall (m :: * -> *) a b.
(MonadGet m, Ord a) =>
m a -> m b -> m (Map a b)
getMap (Text -> Text
Util.Text.fromText (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
forall (m :: * -> *). MonadGet m => m Text
getText) ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
m (Maybe (ANormal v) -> Branched (ANormal v))
-> m (Maybe (ANormal v)) -> m (Branched (ANormal v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (ANormal v) -> m (Maybe (ANormal v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
MtTag
MReqT ->
Map Reference (EnumMap CTag ([Mem], ANormal v))
-> ANormal v -> Branched (ANormal v)
forall e.
Map Reference (EnumMap CTag ([Mem], e)) -> e -> Branched e
MatchRequest
(Map Reference (EnumMap CTag ([Mem], ANormal v))
-> ANormal v -> Branched (ANormal v))
-> m (Map Reference (EnumMap CTag ([Mem], ANormal v)))
-> m (ANormal v -> Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
-> m (EnumMap CTag ([Mem], ANormal v))
-> m (Map Reference (EnumMap CTag ([Mem], ANormal v)))
forall (m :: * -> *) a b.
(MonadGet m, Ord a) =>
m a -> m b -> m (Map a b)
getMap m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference (m CTag
-> m ([Mem], ANormal v) -> m (EnumMap CTag ([Mem], ANormal v))
forall (m :: * -> *) k v.
(MonadGet m, EnumKey k) =>
m k -> m v -> m (EnumMap k v)
getEnumMap m CTag
forall (m :: * -> *). MonadGet m => m CTag
getCTag ([v] -> Word64 -> m ([Mem], ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal v)
getCase [v]
ctx Word64
frsh0))
m (ANormal v -> Branched (ANormal v))
-> m (ANormal v) -> m (Branched (ANormal v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (v -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
v (ANormal v -> ANormal v) -> m (ANormal v) -> m (ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
ctx) (Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1))
where
v :: v
v = Word64 -> v
forall v. Var v => Word64 -> v
getFresh Word64
frsh0
MtTag
MDataT ->
Reference
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Branched (ANormal v)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData
(Reference
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Branched (ANormal v))
-> m Reference
-> m (EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v) -> Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
m (EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v) -> Branched (ANormal v))
-> m (EnumMap CTag ([Mem], ANormal v))
-> m (Maybe (ANormal v) -> Branched (ANormal v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m CTag
-> m ([Mem], ANormal v) -> m (EnumMap CTag ([Mem], ANormal v))
forall (m :: * -> *) k v.
(MonadGet m, EnumKey k) =>
m k -> m v -> m (EnumMap k v)
getEnumMap m CTag
forall (m :: * -> *). MonadGet m => m CTag
getCTag ([v] -> Word64 -> m ([Mem], ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal v)
getCase [v]
ctx Word64
frsh0)
m (Maybe (ANormal v) -> Branched (ANormal v))
-> m (Maybe (ANormal v)) -> m (Branched (ANormal v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (ANormal v) -> m (Maybe (ANormal v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
MtTag
MSumT -> EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> m (EnumMap Word64 ([Mem], ANormal v))
-> m (Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
-> m ([Mem], ANormal v) -> m (EnumMap Word64 ([Mem], ANormal v))
forall (m :: * -> *) k v.
(MonadGet m, EnumKey k) =>
m k -> m v -> m (EnumMap k v)
getEnumMap m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be ([v] -> Word64 -> m ([Mem], ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal v)
getCase [v]
ctx Word64
frsh0)
MtTag
MNumT ->
Reference
-> EnumMap Word64 (ANormal v)
-> Maybe (ANormal v)
-> Branched (ANormal v)
forall e. Reference -> EnumMap Word64 e -> Maybe e -> Branched e
MatchNumeric
(Reference
-> EnumMap Word64 (ANormal v)
-> Maybe (ANormal v)
-> Branched (ANormal v))
-> m Reference
-> m (EnumMap Word64 (ANormal v)
-> Maybe (ANormal v) -> Branched (ANormal v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
m (EnumMap Word64 (ANormal v)
-> Maybe (ANormal v) -> Branched (ANormal v))
-> m (EnumMap Word64 (ANormal v))
-> m (Maybe (ANormal v) -> Branched (ANormal v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64 -> m (ANormal v) -> m (EnumMap Word64 (ANormal v))
forall (m :: * -> *) k v.
(MonadGet m, EnumKey k) =>
m k -> m v -> m (EnumMap k v)
getEnumMap m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
m (Maybe (ANormal v) -> Branched (ANormal v))
-> m (Maybe (ANormal v)) -> m (Branched (ANormal v))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (ANormal v) -> m (Maybe (ANormal v))
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe ([v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal [v]
ctx Word64
frsh0)
putCase ::
(MonadPut m) =>
(Var v) =>
Map Reference Word64 ->
EC.EnumMap FOp Text ->
[v] ->
([Mem], ANormal v) ->
m ()
putCase :: forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ([Mem], ANormal v) -> m ()
putCase Map Reference Word64
refrep EnumMap Word64 Text
fops [v]
ctx ([Mem]
ccs, (TAbss [v]
us ANormal v
e)) =
[Mem] -> m ()
forall (m :: * -> *). MonadPut m => [Mem] -> m ()
putCCs [Mem]
ccs m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64
-> EnumMap Word64 Text -> [v] -> ANormal v -> m ()
putNormal Map Reference Word64
refrep EnumMap Word64 Text
fops ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) ANormal v
e
getCase :: (MonadGet m) => (Var v) => [v] -> Word64 -> m ([Mem], ANormal v)
getCase :: forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m ([Mem], ANormal v)
getCase [v]
ctx Word64
frsh0 = do
[Mem]
ccs <- m [Mem]
forall (m :: * -> *). MonadGet m => m [Mem]
getCCs
let l :: Int
l = [Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs
frsh :: Word64
frsh = Word64
frsh0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l
us :: [v]
us = Word64 -> v
forall v. Var v => Word64 -> v
getFresh (Word64 -> v) -> [Word64] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
l [Word64
frsh0 ..]
(,) [Mem]
ccs (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v]
us (ANormal v -> ([Mem], ANormal v))
-> m (ANormal v) -> m ([Mem], ANormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v] -> Word64 -> m (ANormal v)
forall (m :: * -> *) v.
(MonadGet m, Var v) =>
[v] -> Word64 -> m (ANormal v)
getNormal ([v] -> [v] -> [v]
forall v. [v] -> [v] -> [v]
pushCtx [v]
us [v]
ctx) Word64
frsh
putCTag :: (MonadPut m) => CTag -> m ()
putCTag :: forall (m :: * -> *). MonadPut m => CTag -> m ()
putCTag CTag
c = VarInt Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => VarInt Int -> m ()
serialize (Int -> VarInt Int
forall n. n -> VarInt n
VarInt (Int -> VarInt Int) -> Int -> VarInt Int
forall a b. (a -> b) -> a -> b
$ CTag -> Int
forall a. Enum a => a -> Int
fromEnum CTag
c)
getCTag :: (MonadGet m) => m CTag
getCTag :: forall (m :: * -> *). MonadGet m => m CTag
getCTag = Int -> CTag
forall a. Enum a => Int -> a
toEnum (Int -> CTag) -> (VarInt Int -> Int) -> VarInt Int -> CTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt Int -> Int
forall n. VarInt n -> n
unVarInt (VarInt Int -> CTag) -> m (VarInt Int) -> m CTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (VarInt Int)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (VarInt Int)
deserialize
putGroupRef :: (MonadPut m) => GroupRef -> m ()
putGroupRef :: forall (m :: * -> *). MonadPut m => GroupRef -> m ()
putGroupRef (GR Reference
r Word64
i) =
Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
i
getGroupRef :: (MonadGet m) => m GroupRef
getGroupRef :: forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef = Reference -> Word64 -> GroupRef
GR (Reference -> Word64 -> GroupRef)
-> m Reference -> m (Word64 -> GroupRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference m (Word64 -> GroupRef) -> m Word64 -> m GroupRef
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
putValue :: (MonadPut m) => Value -> m ()
putValue :: forall (m :: * -> *). MonadPut m => Value -> m ()
putValue (Partial GroupRef
gr [] [Value]
vs) =
VaTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag VaTag
PartialT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GroupRef -> m ()
forall (m :: * -> *). MonadPut m => GroupRef -> m ()
putGroupRef GroupRef
gr
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Value -> m ()) -> [Value] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue [Value]
vs
putValue Partial {} =
String -> m ()
forall a. HasCallStack => String -> a
exn String
"putValue: Partial with unboxed values no longer supported"
putValue (Data Reference
r Word64
t [] [Value]
vs) =
VaTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag VaTag
DataT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Reference
r
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
t
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Value -> m ()) -> [Value] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue [Value]
vs
putValue Data {} =
String -> m ()
forall a. HasCallStack => String -> a
exn String
"putValue: Data with unboxed contents no longer supported"
putValue (Cont [] [Value]
bs Cont
k) =
VaTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag VaTag
ContT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Value -> m ()) -> [Value] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue [Value]
bs
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Cont -> m ()
forall (m :: * -> *). MonadPut m => Cont -> m ()
putCont Cont
k
putValue Cont {} =
String -> m ()
forall a. HasCallStack => String -> a
exn String
"putValue: Cont with unboxed stack no longer supported"
putValue (BLit BLit
l) =
VaTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag VaTag
BLitT m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BLit -> m ()
forall (m :: * -> *). MonadPut m => BLit -> m ()
putBLit BLit
l
getValue :: (MonadGet m) => Version -> m Value
getValue :: forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v =
m VaTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m VaTag -> (VaTag -> m Value) -> m Value
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
VaTag
PartialT
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 ->
GroupRef -> [Word64] -> [Value] -> Value
Partial (GroupRef -> [Word64] -> [Value] -> Value)
-> m GroupRef -> m ([Word64] -> [Value] -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef m ([Word64] -> [Value] -> Value)
-> m [Word64] -> m ([Value] -> Value)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64 -> m [Word64]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be m ([Value] -> Value) -> m [Value] -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
| Bool
otherwise ->
(GroupRef -> [Word64] -> [Value] -> Value)
-> [Word64] -> GroupRef -> [Value] -> Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip GroupRef -> [Word64] -> [Value] -> Value
Partial [] (GroupRef -> [Value] -> Value)
-> m GroupRef -> m ([Value] -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef m ([Value] -> Value) -> m [Value] -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
VaTag
DataT
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 ->
Reference -> Word64 -> [Word64] -> [Value] -> Value
Data
(Reference -> Word64 -> [Word64] -> [Value] -> Value)
-> m Reference -> m (Word64 -> [Word64] -> [Value] -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
m (Word64 -> [Word64] -> [Value] -> Value)
-> m Word64 -> m ([Word64] -> [Value] -> Value)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m ([Word64] -> [Value] -> Value)
-> m [Word64] -> m ([Value] -> Value)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64 -> m [Word64]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m ([Value] -> Value) -> m [Value] -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
| Bool
otherwise ->
(\Reference
r Word64
t -> Reference -> Word64 -> [Word64] -> [Value] -> Value
Data Reference
r Word64
t [])
(Reference -> Word64 -> [Value] -> Value)
-> m Reference -> m (Word64 -> [Value] -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
m (Word64 -> [Value] -> Value) -> m Word64 -> m ([Value] -> Value)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m ([Value] -> Value) -> m [Value] -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
VaTag
ContT
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 ->
[Word64] -> [Value] -> Cont -> Value
Cont ([Word64] -> [Value] -> Cont -> Value)
-> m [Word64] -> m ([Value] -> Cont -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64 -> m [Word64]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be m ([Value] -> Cont -> Value) -> m [Value] -> m (Cont -> Value)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v) m (Cont -> Value) -> m Cont -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
| Bool
otherwise -> [Word64] -> [Value] -> Cont -> Value
Cont [] ([Value] -> Cont -> Value) -> m [Value] -> m (Cont -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Value -> m [Value]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v) m (Cont -> Value) -> m Cont -> m Value
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
VaTag
BLitT -> BLit -> Value
BLit (BLit -> Value) -> m BLit -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> m BLit
forall (m :: * -> *). MonadGet m => Word32 -> m BLit
getBLit Word32
v
putCont :: (MonadPut m) => Cont -> m ()
putCont :: forall (m :: * -> *). MonadPut m => Cont -> m ()
putCont Cont
KE = CoTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag CoTag
KET
putCont (Mark Word64
0 Word64
ba [Reference]
rs Map Reference Value
ds Cont
k) =
CoTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag CoTag
MarkT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
ba
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Reference -> m ()) -> [Reference] -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
putFoldable Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference [Reference]
rs
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Reference -> m ())
-> (Value -> m ()) -> Map Reference Value -> m ()
forall (m :: * -> *) a b.
MonadPut m =>
(a -> m ()) -> (b -> m ()) -> Map a b -> m ()
putMap Reference -> m ()
forall (m :: * -> *). MonadPut m => Reference -> m ()
putReference Value -> m ()
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Map Reference Value
ds
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Cont -> m ()
forall (m :: * -> *). MonadPut m => Cont -> m ()
putCont Cont
k
putCont Mark {} =
String -> m ()
forall a. HasCallStack => String -> a
exn String
"putCont: Mark with unboxed args no longer supported"
putCont (Push Word64
0 Word64
j Word64
0 Word64
n GroupRef
gr Cont
k) =
CoTag -> m ()
forall (m :: * -> *) t. (MonadPut m, Tag t) => t -> m ()
putTag CoTag
PushT
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
j
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
n
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GroupRef -> m ()
forall (m :: * -> *). MonadPut m => GroupRef -> m ()
putGroupRef GroupRef
gr
m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Cont -> m ()
forall (m :: * -> *). MonadPut m => Cont -> m ()
putCont Cont
k
putCont Push {} =
String -> m ()
forall a. HasCallStack => String -> a
exn String
"putCont: Push with unboxed information no longer supported"
getCont :: (MonadGet m) => Version -> m Cont
getCont :: forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v =
m CoTag
forall (m :: * -> *) t. (MonadGet m, Tag t) => m t
getTag m CoTag -> (CoTag -> m Cont) -> m Cont
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
CoTag
KET -> Cont -> m Cont
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cont
KE
CoTag
MarkT
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 ->
Word64
-> Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont
Mark
(Word64
-> Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont)
-> m Word64
-> m (Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m (Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont)
-> m Word64
-> m ([Reference] -> Map Reference Value -> Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m ([Reference] -> Map Reference Value -> Cont -> Cont)
-> m [Reference] -> m (Map Reference Value -> Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Reference -> m [Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
m (Map Reference Value -> Cont -> Cont)
-> m (Map Reference Value) -> m (Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Reference -> m Value -> m (Map Reference Value)
forall (m :: * -> *) a b.
(MonadGet m, Ord a) =>
m a -> m b -> m (Map a b)
getMap m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
m (Cont -> Cont) -> m Cont -> m Cont
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
| Bool
otherwise ->
Word64
-> Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont
Mark Word64
0
(Word64 -> [Reference] -> Map Reference Value -> Cont -> Cont)
-> m Word64
-> m ([Reference] -> Map Reference Value -> Cont -> Cont)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m ([Reference] -> Map Reference Value -> Cont -> Cont)
-> m [Reference] -> m (Map Reference Value -> Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Reference -> m [Reference]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference
m (Map Reference Value -> Cont -> Cont)
-> m (Map Reference Value) -> m (Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Reference -> m Value -> m (Map Reference Value)
forall (m :: * -> *) a b.
(MonadGet m, Ord a) =>
m a -> m b -> m (Map a b)
getMap m Reference
forall (m :: * -> *). MonadGet m => m Reference
getReference (Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue Word32
v)
m (Cont -> Cont) -> m Cont -> m Cont
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
CoTag
PushT
| Word32
v Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
4 ->
Word64 -> Word64 -> Word64 -> Word64 -> GroupRef -> Cont -> Cont
Push
(Word64 -> Word64 -> Word64 -> Word64 -> GroupRef -> Cont -> Cont)
-> m Word64
-> m (Word64 -> Word64 -> Word64 -> GroupRef -> Cont -> Cont)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m (Word64 -> Word64 -> Word64 -> GroupRef -> Cont -> Cont)
-> m Word64 -> m (Word64 -> Word64 -> GroupRef -> Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m (Word64 -> Word64 -> GroupRef -> Cont -> Cont)
-> m Word64 -> m (Word64 -> GroupRef -> Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m (Word64 -> GroupRef -> Cont -> Cont)
-> m Word64 -> m (GroupRef -> Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m (GroupRef -> Cont -> Cont) -> m GroupRef -> m (Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef
m (Cont -> Cont) -> m Cont -> m Cont
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
| Bool
otherwise ->
(\Word64
j Word64
n -> Word64 -> Word64 -> Word64 -> Word64 -> GroupRef -> Cont -> Cont
Push Word64
0 Word64
j Word64
0 Word64
n)
(Word64 -> Word64 -> GroupRef -> Cont -> Cont)
-> m Word64 -> m (Word64 -> GroupRef -> Cont -> Cont)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m (Word64 -> GroupRef -> Cont -> Cont)
-> m Word64 -> m (GroupRef -> Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
m (GroupRef -> Cont -> Cont) -> m GroupRef -> m (Cont -> Cont)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m GroupRef
forall (m :: * -> *). MonadGet m => m GroupRef
getGroupRef
m (Cont -> Cont) -> m Cont -> m Cont
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word32 -> m Cont
forall (m :: * -> *). MonadGet m => Word32 -> m Cont
getCont Word32
v
deserializeGroup :: (Var v) => ByteString -> Either String (SuperGroup v)
deserializeGroup :: forall v. Var v => ByteString -> Either String (SuperGroup v)
deserializeGroup ByteString
bs = Get (SuperGroup v) -> ByteString -> Either String (SuperGroup v)
forall a. Get a -> ByteString -> Either String a
runGetS (Get ()
getVersion Get () -> Get (SuperGroup v) -> Get (SuperGroup v)
forall a b. Get a -> Get b -> Get b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get (SuperGroup v)
forall (m :: * -> *) v. (MonadGet m, Var v) => m (SuperGroup v)
getGroup) ByteString
bs
where
getVersion :: Get ()
getVersion =
Get Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be Get Word32 -> (Word32 -> Get ()) -> Get ()
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word32
1 -> () -> Get ()
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Word32
2 -> () -> Get ()
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Word32
n -> String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"deserializeGroup: unknown version: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n
serializeGroup ::
(Var v) => EC.EnumMap FOp Text -> SuperGroup v -> ByteString
serializeGroup :: forall v.
Var v =>
EnumMap Word64 Text -> SuperGroup v -> ByteString
serializeGroup EnumMap Word64 Text
fops SuperGroup v
sg = Put -> ByteString
runPutS (Put
putVersion Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> Put
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
forall a. Monoid a => a
mempty EnumMap Word64 Text
fops SuperGroup v
sg)
where
putVersion :: Put
putVersion = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
codeVersion
serializeGroupForRehash ::
(Var v) =>
EC.EnumMap FOp Text ->
Reference ->
SuperGroup v ->
L.ByteString
serializeGroupForRehash :: forall v.
Var v =>
EnumMap Word64 Text -> Reference -> SuperGroup v -> ByteString
serializeGroupForRehash EnumMap Word64 Text
_ (Builtin Text
_) SuperGroup v
_ =
String -> ByteString
forall a. HasCallStack => String -> a
error String
"serializeForRehash: builtin reference"
serializeGroupForRehash EnumMap Word64 Text
fops (Derived Hash
h Word64
_) SuperGroup v
sg =
Put -> ByteString
runPutLazy (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> Put
forall (m :: * -> *) v.
(MonadPut m, Var v) =>
Map Reference Word64 -> EnumMap Word64 Text -> SuperGroup v -> m ()
putGroup Map Reference Word64
refrep EnumMap Word64 Text
fops SuperGroup v
sg
where
f :: Reference -> Maybe (Reference, Word64)
f r :: Reference
r@(Derived Hash
h' Word64
i) | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h' = (Reference, Word64) -> Maybe (Reference, Word64)
forall a. a -> Maybe a
Just (Reference
r, Word64
i)
f Reference
_ = Maybe (Reference, Word64)
forall a. Maybe a
Nothing
refrep :: Map Reference Word64
refrep = [(Reference, Word64)] -> Map Reference Word64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, Word64)] -> Map Reference Word64)
-> ([Reference] -> [(Reference, Word64)])
-> [Reference]
-> Map Reference Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Maybe (Reference, Word64))
-> [Reference] -> [(Reference, Word64)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Reference -> Maybe (Reference, Word64)
f ([Reference] -> Map Reference Word64)
-> [Reference] -> Map Reference Word64
forall a b. (a -> b) -> a -> b
$ SuperGroup v -> [Reference]
forall v. Var v => SuperGroup v -> [Reference]
groupTermLinks SuperGroup v
sg
getVersionedValue :: (MonadGet m) => m Value
getVersionedValue :: forall (m :: * -> *). MonadGet m => m Value
getVersionedValue = m Word32
getVersion m Word32 -> (Word32 -> m Value) -> m Value
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> m Value
forall (m :: * -> *). MonadGet m => Word32 -> m Value
getValue
where
getVersion :: m Word32
getVersion =
m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be m Word32 -> (Word32 -> m Word32) -> m Word32
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word32
n
| Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
1 -> String -> m Word32
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Word32) -> String -> m Word32
forall a b. (a -> b) -> a -> b
$ String
"deserializeValue: unknown version: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n
| Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
3 -> String -> m Word32
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Word32) -> String -> m Word32
forall a b. (a -> b) -> a -> b
$ String
"deserializeValue: unsupported version: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n
| Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
4 -> Word32 -> m Word32
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
n
| Bool
otherwise -> String -> m Word32
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Word32) -> String -> m Word32
forall a b. (a -> b) -> a -> b
$ String
"deserializeValue: unknown version: " String -> String -> String
forall v. [v] -> [v] -> [v]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n
deserializeValue :: ByteString -> Either String Value
deserializeValue :: ByteString -> Either String Value
deserializeValue ByteString
bs = Get Value -> ByteString -> Either String Value
forall a. Get a -> ByteString -> Either String a
runGetS Get Value
forall (m :: * -> *). MonadGet m => m Value
getVersionedValue ByteString
bs
serializeValue :: Value -> ByteString
serializeValue :: Value -> ByteString
serializeValue Value
v = Put -> ByteString
runPutS (Put
putVersion Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Put
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Value
v)
where
putVersion :: Put
putVersion = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
valueVersion
serializeValueLazy :: Value -> L.ByteString
serializeValueLazy :: Value -> ByteString
serializeValueLazy Value
v = Put -> ByteString
runPutLazy (Put
putVersion Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Put
forall (m :: * -> *). MonadPut m => Value -> m ()
putValue Value
v)
where
putVersion :: Put
putVersion = Word32 -> Put
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Word32
valueVersion
valueVersion :: Word32
valueVersion :: Word32
valueVersion = Word32
4
codeVersion :: Word32
codeVersion :: Word32
codeVersion = Word32
2