-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{- | Module, carrying logic of @UNPACK@ instruction.

This is nearly symmetric to adjacent Pack.hs module.

When implementing this the following sources were used:

* https://pastebin.com/8gfXaRvp

* https://gitlab.com/tezos/tezos/-/blob/767de2b6665ec2cc21e41e6348f8a0b369d26450/src/proto_alpha/lib_protocol/script_ir_translator.ml#L2501

* https://github.com/tezbridge/tezbridge-crypto/blob/f7d93d8d04201557972e839967758cff5bbe5345/PsddFKi3/codec.js#L513

-}
module Michelson.Interpret.Unpack
  ( UnpackError (..)
  , unpackValue
  , unpackValue'
  , unpackInstr'

  -- * Internals
  , decodeContract
  , decodeType
  ) where

import Prelude hiding (EQ, Ordering(..), get)

import Control.Monad.Except (throwError)
import Data.Binary (Get)
import qualified Data.Binary.Get as Get
import qualified Data.Bits as Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Constraint (Dict(..))
import Data.Default (def)
import qualified Data.Kind as Kind
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Singletons (Sing, SingI(..))
import Data.Typeable ((:~:)(..))
import Fmt (Buildable, fmt, hexF, pretty, (+|), (|+))

import Michelson.Parser (Parser, ParserException(..), parseNoEnv)
import qualified Michelson.Parser.Annotations as PA
import Michelson.Text
import Michelson.TypeCheck
  (HST(..), SomeHST(..), SomeInstr(..), SomeInstrOut(..), TCError(..), TypeCheckEnv(..),
  TypeCheckMode(..), TypeContext(..), withWTPm)
import Michelson.TypeCheck.Helpers (ensureDistinctAsc, eqHST1)
import Michelson.TypeCheck.Instr (typeCheckList)
import Michelson.Typed (KnownT, RemFail(..), SingT(..), starNotes)
import qualified Michelson.Typed as T
import Michelson.Typed.Entrypoints
import Michelson.Typed.Scope (UnpackedValScope)
import Michelson.Untyped
import Tezos.Core
import Tezos.Crypto hiding (sign)
import Util.Binary
import Util.Num

----------------------------------------------------------------------------
-- Helpers
----------------------------------------------------------------------------

-- | Alias for label attaching.
(?) :: Get a -> String -> Get a
? :: Get a -> String -> Get a
(?) = (String -> Get a -> Get a) -> Get a -> String -> Get a
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Get a -> Get a
forall a. String -> Get a -> Get a
Get.label
infix 0 ?

-- | Read a byte and match it against given value.
expectTag :: String -> Word8 -> Get ()
expectTag :: String -> Word8 -> Get ()
expectTag desc :: String
desc t :: Word8
t =
  String -> Get () -> Get ()
forall a. String -> Get a -> Get a
Get.label String
desc (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
    Word8
t' <- Get Word8
Get.getWord8
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
t') (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
      String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> (Builder -> String) -> Builder -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Get ()) -> Builder -> Get ()
forall a b. (a -> b) -> a -> b
$ "Unexpected tag value (expected 0x" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Word8 -> Builder
forall a. FormatAsHex a => a -> Builder
hexF Word8
t Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
                   ", but got 0x" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Word8 -> Builder
forall a. FormatAsHex a => a -> Builder
hexF Word8
t' Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ")"


-- | Read a byte describing the primitive going further and match it against
-- expected tag in the given conditions.
--
-- Aside of context description, you have to specify number of arguments which
-- given instruction accepts when written in Michelson. For instance, @PUSH@
-- accepts two arguments - type and value.
expectDescTag :: HasCallStack => String -> Word16 -> Get ()
expectDescTag :: String -> Word16 -> Get ()
expectDescTag desc :: String
desc argsNum :: Word16
argsNum =
  String -> Get () -> Get ()
forall a. String -> Get a -> Get a
Get.label String
desc (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ do
    Word8
tag <- Get Word8
Get.getWord8
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
expected) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
      String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> (Builder -> String) -> Builder -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Get ()) -> Builder -> Get ()
forall a b. (a -> b) -> a -> b
$ "Unexpected preliminary tag: 0x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. FormatAsHex a => a -> Builder
hexF Word8
tag
  where
    expected :: Word8
expected = case Word16
argsNum of
      0 -> 0x03
      1 -> 0x05
      2 -> 0x07
      3 -> 0x08
      _ -> Text -> Word8
forall a. HasCallStack => Text -> a
error "Bad arguments num"
      -- Intermediate values of tag are also used and designate that annotations
      -- are also attached to the packed data. But they are never produced by
      -- @PACK@, neither @UNPACK@ seem to expect them, so for now we pretend
      -- that annotations do not exist.

-- | Read a byte indicating the number of arguments/annotations of
-- the primitive that follows it.
decodeDescTag :: String -> Get Word8
decodeDescTag :: String -> Get Word8
decodeDescTag desc :: String
desc =
  String -> Get Word8 -> Get Word8
forall a. String -> Get a -> Get a
Get.label String
desc
    Get Word8
Get.getWord8

-- | Like 'many', but doesn't backtrack if next entry failed to parse
-- yet there are some bytes to consume ahead.
--
-- This function exists primarily for better error messages.
manyForced :: Get a -> Get [a]
manyForced :: Get a -> Get [a]
manyForced decode :: Get a
decode = do
  Bool
emp <- Get Bool
Get.isEmpty
  if Bool
emp
    then [a] -> Get [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else (:) (a -> [a] -> [a]) -> Get a -> Get ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
decode Get ([a] -> [a]) -> Get [a] -> Get [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get a -> Get [a]
forall a. Get a -> Get [a]
manyForced Get a
decode

----------------------------------------------------------------------------
-- Michelson serialisation
----------------------------------------------------------------------------

{- Implementation notes:

* We need to know which exact type we unpack to.
For instance, serialized signatures are indistinguishable from
plain serialized bytes, so if we want to return "Value" (typed or untyped),
we need to know currently expected type. The reference implementation does
the same.

* It occured to be easier to decode to typed values and untyped instructions.
When decoding lambda, we type check given instruction, and when decoding
@PUSH@ call we untype decoded value.
One may say that this gives unreasonable performance overhead, but with the
current definition of "Value" types (typed and untyped) we cannot avoid it
anyway, because when deserializing bytearray-like data (keys, signatures, ...),
we have to convert raw bytes to human-readable 'Text' and later parse them
to bytes back at type check stage.
We console ourselves that lambdas are rarely packed.

-}

-- | Deserialize bytes into the given value.
-- Suitable for @UNPACK@ operation only.
unpackValue
  :: (UnpackedValScope t)
  => LByteString -> Either UnpackError (T.Value t)
unpackValue :: LByteString -> Either UnpackError (Value t)
unpackValue = Get (Value t) -> LByteString -> Either UnpackError (Value t)
forall a. Get a -> LByteString -> Either UnpackError a
launchGet (Get (Value t) -> Get (Value t)
forall a. Get a -> Get a
finalizeDecoder Get (Value t)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue)

-- | Like 'unpackValue', for strict byte array.
unpackValue'
  :: (UnpackedValScope t)
  => ByteString -> Either UnpackError (T.Value t)
unpackValue' :: ByteString -> Either UnpackError (Value t)
unpackValue' = LByteString -> Either UnpackError (Value t)
forall (t :: T).
UnpackedValScope t =>
LByteString -> Either UnpackError (Value t)
unpackValue (LByteString -> Either UnpackError (Value t))
-> (ByteString -> LByteString)
-> ByteString
-> Either UnpackError (Value t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LByteString
LBS.fromStrict

-- | Deserialize an instruction into the given value.
unpackInstr' :: ByteString -> Either UnpackError [ExpandedOp]
unpackInstr' :: ByteString -> Either UnpackError [ExpandedOp]
unpackInstr' = Get [ExpandedOp] -> LByteString -> Either UnpackError [ExpandedOp]
forall a. Get a -> LByteString -> Either UnpackError a
launchGet (Get [ExpandedOp] -> Get [ExpandedOp]
forall a. Get a -> Get a
finalizeDecoder Get [ExpandedOp]
decodeOps) (LByteString -> Either UnpackError [ExpandedOp])
-> (ByteString -> LByteString)
-> ByteString
-> Either UnpackError [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LByteString
LBS.fromStrict

-- | Turn composable decoder into a final decoder which will be run over data.
finalizeDecoder :: Get a -> Get a
finalizeDecoder :: Get a -> Get a
finalizeDecoder decoder :: Get a
decoder =
  String -> Word8 -> Get ()
expectTag "Packed data start" 0x05 Get () -> Get a -> Get a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get a
decoder Get a -> Get () -> Get a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get ()
ensureEnd

decodeValue
  :: forall t.
     (HasCallStack, UnpackedValScope t)
  => Get (T.Value t)
decodeValue :: Get (Value t)
decodeValue = String -> Get (Value t) -> Get (Value t)
forall a. String -> Get a -> Get a
Get.label "Value" (Get (Value t) -> Get (Value t)) -> Get (Value t) -> Get (Value t)
forall a b. (a -> b) -> a -> b
$
  case SingI t => Sing t
forall k (a :: k). SingI a => Sing a
sing @t of
    STKey -> PublicKey -> Value' Instr 'TKey
forall (instr :: [T] -> [T] -> *). PublicKey -> Value' instr 'TKey
T.VKey (PublicKey -> Value' Instr 'TKey)
-> Get PublicKey -> Get (Value' Instr 'TKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get PublicKey, Text -> Either CryptoParseError PublicKey)
-> Get PublicKey
forall e a. Buildable e => (Get a, Text -> Either e a) -> Get a
decodeAsBytesOrString
      ( String -> [TaggedDecoder PublicKey] -> Get PublicKey
forall a. String -> [TaggedDecoder a] -> Get a
decodeWithTag "key" [TaggedDecoder PublicKey]
keyDecoders
      , Text -> Either CryptoParseError PublicKey
parsePublicKey
      )
    STUnit -> do
      HasCallStack => String -> Word16 -> Get ()
String -> Word16 -> Get ()
expectDescTag "Unit" 0
      String -> Word8 -> Get ()
expectTag "Unit" 0x0B
      return Value t
forall (instr :: [T] -> [T] -> *). Value' instr 'TUnit
T.VUnit
    STSignature -> Signature -> Value' Instr 'TSignature
forall (instr :: [T] -> [T] -> *).
Signature -> Value' instr 'TSignature
T.VSignature (Signature -> Value' Instr 'TSignature)
-> Get Signature -> Get (Value' Instr 'TSignature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Signature, Text -> Either CryptoParseError Signature)
-> Get Signature
forall e a. Buildable e => (Get a, Text -> Either e a) -> Get a
decodeAsBytesOrString
      ( String -> (ByteString -> Maybe Signature) -> Get Signature
forall a. String -> (ByteString -> Maybe a) -> Get a
decodeBytesLikeMaybe "signature wrong size" ByteString -> Maybe Signature
forall ba. ByteArray ba => ba -> Maybe Signature
mkSignature
      , Text -> Either CryptoParseError Signature
parseSignature
      )
    STChainId -> ChainId -> Value' Instr 'TChainId
forall (instr :: [T] -> [T] -> *).
ChainId -> Value' instr 'TChainId
T.VChainId (ChainId -> Value' Instr 'TChainId)
-> Get ChainId -> Get (Value' Instr 'TChainId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get ChainId, Text -> Either ParseChainIdError ChainId)
-> Get ChainId
forall e a. Buildable e => (Get a, Text -> Either e a) -> Get a
decodeAsBytesOrString
      ( String -> (ByteString -> Maybe ChainId) -> Get ChainId
forall a. String -> (ByteString -> Maybe a) -> Get a
decodeBytesLikeMaybe "chain_id wrong size" ByteString -> Maybe ChainId
mkChainId
      , Text -> Either ParseChainIdError ChainId
parseChainId
      )
    STOption _ -> do
      Int -> Get ByteString
Get.getByteString 2 Get ByteString
-> (ByteString -> Get (Value' Instr ('TOption a)))
-> Get (Value' Instr ('TOption a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        "\x03\x06" -> Value' Instr ('TOption a) -> Get (Value' Instr ('TOption a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Value' Instr a) -> Value' Instr ('TOption a)
forall (t :: T) (instr :: [T] -> [T] -> *).
KnownT t =>
Maybe (Value' instr t) -> Value' instr ('TOption t)
T.VOption Maybe (Value' Instr a)
forall a. Maybe a
Nothing)
        "\x05\x09" -> Maybe (Value' Instr a) -> Value' Instr ('TOption a)
forall (t :: T) (instr :: [T] -> [T] -> *).
KnownT t =>
Maybe (Value' instr t) -> Value' instr ('TOption t)
T.VOption (Maybe (Value' Instr a) -> Value' Instr ('TOption a))
-> (Value' Instr a -> Maybe (Value' Instr a))
-> Value' Instr a
-> Value' Instr ('TOption a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr a -> Maybe (Value' Instr a)
forall a. a -> Maybe a
Just (Value' Instr a -> Value' Instr ('TOption a))
-> Get (Value' Instr a) -> Get (Value' Instr ('TOption a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Value' Instr a)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue
        other :: ByteString
other -> String -> Get (Value' Instr ('TOption a))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Value' Instr ('TOption a)))
-> String -> Get (Value' Instr ('TOption a))
forall a b. (a -> b) -> a -> b
$ "Unknown option tag: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall b a. (Show a, IsString b) => a -> b
show ByteString
other
    STList _ -> do
      Get (Value' Instr ('TList a)) -> Get (Value t)
forall a. Get a -> Get a
decodeAsList (Get (Value' Instr ('TList a)) -> Get (Value t))
-> Get (Value' Instr ('TList a)) -> Get (Value t)
forall a b. (a -> b) -> a -> b
$ [Value' Instr a] -> Value' Instr ('TList a)
forall (t :: T) (instr :: [T] -> [T] -> *).
KnownT t =>
[Value' instr t] -> Value' instr ('TList t)
T.VList ([Value' Instr a] -> Value' Instr ('TList a))
-> Get [Value' Instr a] -> Get (Value' Instr ('TList a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Value' Instr a) -> Get [Value' Instr a]
forall a. Get a -> Get [a]
manyForced Get (Value' Instr a)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue
    STSet (st :: Sing st) -> Sing a -> (Comparable a => Get (Value t)) -> Get (Value t)
forall (a :: T) v (m :: * -> *).
MonadFail m =>
Sing a -> (Comparable a => m v) -> m v
withComparable Sing a
st ((Comparable a => Get (Value t)) -> Get (Value t))
-> (Comparable a => Get (Value t)) -> Get (Value t)
forall a b. (a -> b) -> a -> b
$ do
      Get (Value' Instr ('TSet a)) -> Get (Value t)
forall a. Get a -> Get a
decodeAsList (Get (Value' Instr ('TSet a)) -> Get (Value t))
-> Get (Value' Instr ('TSet a)) -> Get (Value t)
forall a b. (a -> b) -> a -> b
$ do
        [Value' Instr a]
vals <- forall v (m :: * -> *).
(KnownT a, MonadFail m) =>
(UnpackedValScope a => m v) -> m v
forall (a :: T) v (m :: * -> *).
(KnownT a, MonadFail m) =>
(UnpackedValScope a => m v) -> m v
withUnpackedValueScope @st ((UnpackedValScope a => Get [Value' Instr a])
 -> Get [Value' Instr a])
-> (UnpackedValScope a => Get [Value' Instr a])
-> Get [Value' Instr a]
forall a b. (a -> b) -> a -> b
$ Get (Value' Instr a) -> Get [Value' Instr a]
forall a. Get a -> Get [a]
manyForced Get (Value' Instr a)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue
        (Text -> Get (Value' Instr ('TSet a)))
-> (Value' Instr ('TSet a) -> Get (Value' Instr ('TSet a)))
-> Either Text (Value' Instr ('TSet a))
-> Get (Value' Instr ('TSet a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Get (Value' Instr ('TSet a))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Value' Instr ('TSet a)))
-> (Text -> String) -> Text -> Get (Value' Instr ('TSet a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString) Value' Instr ('TSet a) -> Get (Value' Instr ('TSet a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Value' Instr ('TSet a))
 -> Get (Value' Instr ('TSet a)))
-> Either Text (Value' Instr ('TSet a))
-> Get (Value' Instr ('TSet a))
forall a b. (a -> b) -> a -> b
$
          Set (Value' Instr a) -> Value' Instr ('TSet a)
forall (t :: T) (instr :: [T] -> [T] -> *).
(KnownT t, Comparable t) =>
Set (Value' instr t) -> Value' instr ('TSet t)
T.VSet (Set (Value' Instr a) -> Value' Instr ('TSet a))
-> ([Value' Instr a] -> Set (Value' Instr a))
-> [Value' Instr a]
-> Value' Instr ('TSet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value' Instr a] -> Set (Value' Instr a)
forall a. [a] -> Set a
Set.fromDistinctAscList ([Value' Instr a] -> Value' Instr ('TSet a))
-> Either Text [Value' Instr a]
-> Either Text (Value' Instr ('TSet a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value' Instr a -> Value' Instr a)
-> [Value' Instr a] -> Either Text [Value' Instr a]
forall b a. (Ord b, Show a) => (a -> b) -> [a] -> Either Text [a]
ensureDistinctAsc Value' Instr a -> Value' Instr a
forall a. a -> a
id [Value' Instr a]
vals

    STPair (_:: Sing lt) (r :: Sing rt) -> do
      forall v (m :: * -> *).
(KnownT b, MonadFail m) =>
(UnpackedValScope b => m v) -> m v
forall (a :: T) v (m :: * -> *).
(KnownT a, MonadFail m) =>
(UnpackedValScope a => m v) -> m v
withUnpackedValueScope @rt ((UnpackedValScope b => Get (Value t)) -> Get (Value t))
-> (UnpackedValScope b => Get (Value t)) -> Get (Value t)
forall a b. (a -> b) -> a -> b
$ do
        String -> Get Word8
decodeDescTag "Pair" Get Word8
-> (Word8 -> Get (Value ('TPair a b))) -> Get (Value ('TPair a b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          0x07 -> do
            -- "Normal" pair notation, e.g. `Pair 1 2` or `Pair 1 (Pair 2 3)`
            String -> Word8 -> Get ()
expectTag "Pair" 0x07
            (Value' Instr a, Value' Instr b) -> Value ('TPair a b)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
T.VPair ((Value' Instr a, Value' Instr b) -> Value ('TPair a b))
-> (Value' Instr a
    -> Value' Instr b -> (Value' Instr a, Value' Instr b))
-> Value' Instr a
-> Value' Instr b
-> Value ('TPair a b)
forall a b c. SuperComposition a b c => a -> b -> c
... (,) (Value' Instr a -> Value' Instr b -> Value ('TPair a b))
-> Get (Value' Instr a)
-> Get (Value' Instr b -> Value ('TPair a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Value' Instr a)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue Get (Value' Instr b -> Value ('TPair a b))
-> Get (Value' Instr b) -> Get (Value ('TPair a b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Value' Instr b)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue
          0x09 -> do
            -- Right-combed notation, e.g. `Pair 1 2 3`
            String -> Word8 -> Get ()
expectTag "Pair" 0x07

            -- Find out how many bytes it took to encode the pair's elements, and decode them.
            Int
elemLen <- Get Int
decodeLength Get Int -> String -> Get Int
forall a. Get a -> String -> Get a
? "Right-combed pair length"
            Value ('TPair a b)
val <- Int -> Get (Value ('TPair a b)) -> Get (Value ('TPair a b))
forall a. Int -> Get a -> Get a
Get.isolate Int
elemLen (Sing b -> Get (Value ('TPair a b))
forall (l :: T) (r :: T).
(UnpackedValScope l, UnpackedValScope r) =>
Sing r -> Get (Value ('TPair l r))
go @lt @rt Sing b
r) Get (Value ('TPair a b)) -> String -> Get (Value ('TPair a b))
forall a. Get a -> String -> Get a
? "Right-combed pair elements"

            -- Find out how many bytes it took to encode the pair's annotations - there should be no annotations.
            (Get Int
decodeLength Get Int -> String -> Get Int
forall a. Get a -> String -> Get a
? "Right-combed pair annotations' length") Get Int -> (Int -> Get ()) -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              0 -> Get ()
forall (f :: * -> *). Applicative f => f ()
pass
              _ -> String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Cannot decode values with annotations"
            pure Value ('TPair a b)
val
          0x02 -> do
            -- List notation, e.g. `{ 1 ; 2 ; 3 }`
            Int
elemLen <- Get Int
decodeLength Get Int -> String -> Get Int
forall a. Get a -> String -> Get a
? "Right-combed pair length"
            Int -> Get (Value ('TPair a b)) -> Get (Value ('TPair a b))
forall a. Int -> Get a -> Get a
Get.isolate Int
elemLen (Sing b -> Get (Value ('TPair a b))
forall (l :: T) (r :: T).
(UnpackedValScope l, UnpackedValScope r) =>
Sing r -> Get (Value ('TPair l r))
go @lt @rt Sing b
r) Get (Value ('TPair a b)) -> String -> Get (Value ('TPair a b))
forall a. Get a -> String -> Get a
? "Right-combed pair elements"
          tag :: Word8
tag -> String -> Get (Value ('TPair a b))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Value ('TPair a b)))
-> (Builder -> String) -> Builder -> Get (Value ('TPair a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Get (Value ('TPair a b)))
-> Builder -> Get (Value ('TPair a b))
forall a b. (a -> b) -> a -> b
$ "Unexpected preliminary tag: 0x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. FormatAsHex a => a -> Builder
hexF Word8
tag
      where
        go :: forall l r. (UnpackedValScope l, UnpackedValScope r) => Sing r -> Get (T.Value ('T.TPair l r))
        go :: Sing r -> Get (Value ('TPair l r))
go singR :: Sing r
singR =
          case Sing r
singR of
            -- If there are more pairs to the right of the right-combed pair, decode them.
            STPair (_ :: Sing rl) (singRR :: Sing rr) -> do
              forall v (m :: * -> *).
(KnownT b, MonadFail m) =>
(UnpackedValScope b => m v) -> m v
forall (a :: T) v (m :: * -> *).
(KnownT a, MonadFail m) =>
(UnpackedValScope a => m v) -> m v
withUnpackedValueScope @rr ((UnpackedValScope b => Get (Value ('TPair l r)))
 -> Get (Value ('TPair l r)))
-> (UnpackedValScope b => Get (Value ('TPair l r)))
-> Get (Value ('TPair l r))
forall a b. (a -> b) -> a -> b
$ do
                (Value' Instr l, Value' Instr ('TPair a b))
-> Value' Instr ('TPair l ('TPair a b))
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
T.VPair ((Value' Instr l, Value' Instr ('TPair a b))
 -> Value' Instr ('TPair l ('TPair a b)))
-> (Value' Instr l
    -> Value' Instr ('TPair a b)
    -> (Value' Instr l, Value' Instr ('TPair a b)))
-> Value' Instr l
-> Value' Instr ('TPair a b)
-> Value ('TPair l r)
forall a b c. SuperComposition a b c => a -> b -> c
... (,) (Value' Instr l -> Value' Instr ('TPair a b) -> Value ('TPair l r))
-> Get (Value' Instr l)
-> Get (Value' Instr ('TPair a b) -> Value ('TPair l r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HasCallStack, UnpackedValScope l) => Get (Value' Instr l)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue @l Get (Value' Instr ('TPair a b) -> Value ('TPair l r))
-> Get (Value' Instr ('TPair a b)) -> Get (Value ('TPair l r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sing b -> Get (Value' Instr ('TPair a b))
forall (l :: T) (r :: T).
(UnpackedValScope l, UnpackedValScope r) =>
Sing r -> Get (Value ('TPair l r))
go @rl @rr Sing b
singRR
            _ ->
              (Value' Instr l, Value' Instr r) -> Value ('TPair l r)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
T.VPair ((Value' Instr l, Value' Instr r) -> Value ('TPair l r))
-> (Value' Instr l
    -> Value' Instr r -> (Value' Instr l, Value' Instr r))
-> Value' Instr l
-> Value' Instr r
-> Value ('TPair l r)
forall a b c. SuperComposition a b c => a -> b -> c
... (,) (Value' Instr l -> Value' Instr r -> Value ('TPair l r))
-> Get (Value' Instr l)
-> Get (Value' Instr r -> Value ('TPair l r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HasCallStack, UnpackedValScope l) => Get (Value' Instr l)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue @l Get (Value' Instr r -> Value ('TPair l r))
-> Get (Value' Instr r) -> Get (Value ('TPair l r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HasCallStack, UnpackedValScope r) => Get (Value' Instr r)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue @r
    STOr (_ :: Sing lt) _ ->
      forall v (m :: * -> *).
(KnownT a, MonadFail m) =>
(UnpackedValScope a => m v) -> m v
forall (a :: T) v (m :: * -> *).
(KnownT a, MonadFail m) =>
(UnpackedValScope a => m v) -> m v
withUnpackedValueScope @lt ((UnpackedValScope a => Get (Value t)) -> Get (Value t))
-> (UnpackedValScope a => Get (Value t)) -> Get (Value t)
forall a b. (a -> b) -> a -> b
$ do
        HasCallStack => String -> Word16 -> Get ()
String -> Word16 -> Get ()
expectDescTag "Or" 1
        Get Word8
Get.getWord8 Get Word8
-> (Word8 -> Get (Value' Instr ('TOr a b)))
-> Get (Value' Instr ('TOr a b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          0x05 -> Either (Value' Instr a) (Value' Instr b) -> Value' Instr ('TOr a b)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(KnownT l, KnownT r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
T.VOr (Either (Value' Instr a) (Value' Instr b)
 -> Value' Instr ('TOr a b))
-> (Value' Instr a -> Either (Value' Instr a) (Value' Instr b))
-> Value' Instr a
-> Value' Instr ('TOr a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr a -> Either (Value' Instr a) (Value' Instr b)
forall a b. a -> Either a b
Left (Value' Instr a -> Value' Instr ('TOr a b))
-> Get (Value' Instr a) -> Get (Value' Instr ('TOr a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Value' Instr a)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue
          0x08 -> Either (Value' Instr a) (Value' Instr b) -> Value' Instr ('TOr a b)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(KnownT l, KnownT r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
T.VOr (Either (Value' Instr a) (Value' Instr b)
 -> Value' Instr ('TOr a b))
-> (Value' Instr b -> Either (Value' Instr a) (Value' Instr b))
-> Value' Instr b
-> Value' Instr ('TOr a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr b -> Either (Value' Instr a) (Value' Instr b)
forall a b. b -> Either a b
Right (Value' Instr b -> Value' Instr ('TOr a b))
-> Get (Value' Instr b) -> Get (Value' Instr ('TOr a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Value' Instr b)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue
          other :: Word8
other -> String -> Word8 -> Get (Value' Instr ('TOr a b))
forall a. String -> Word8 -> Get a
unknownTag "or constructor" Word8
other
    STLambda (_ :: Sing t1) (_ :: Sing t2) -> do
      [ExpandedOp]
uinstr <- Get [ExpandedOp]
decodeOps
      forall (t :: T) (m :: * -> *) a.
(MonadFail m, SingI t) =>
(WellTyped t => m a) -> m a
forall (m :: * -> *) a.
(MonadFail m, SingI b) =>
(WellTyped b => m a) -> m a
withWTPm @t2 ((WellTyped b => Get (Value t)) -> Get (Value t))
-> (WellTyped b => Get (Value t)) -> Get (Value t)
forall a b. (a -> b) -> a -> b
$
        (WellTyped a => Get (Value t)) -> Get (Value t)
forall (t :: T) (m :: * -> *) a.
(MonadFail m, SingI t) =>
(WellTyped t => m a) -> m a
withWTPm @t1 (RemFail Instr '[a] '[b] -> Value' Instr ('TLambda a b)
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(KnownT inp, KnownT out,
 forall (i :: [T]) (o :: [T]). Show (instr i o),
 forall (i :: [T]) (o :: [T]). Eq (instr i o),
 forall (i :: [T]) (o :: [T]). NFData (instr i o)) =>
RemFail instr '[inp] '[out] -> Value' instr ('TLambda inp out)
T.VLam (RemFail Instr '[a] '[b] -> Value' Instr ('TLambda a b))
-> Get (RemFail Instr '[a] '[b])
-> Get (Value' Instr ('TLambda a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExpandedOp] -> Get (RemFail Instr '[a] '[b])
forall (inp :: T) (out :: T) (m :: * -> *).
(WellTyped inp, WellTyped out, MonadFail m) =>
[ExpandedOp] -> m (RemFail Instr '[inp] '[out])
decodeTypeCheckLam [ExpandedOp]
uinstr)
    STMap (st :: Sing st) (_ :: Sing sv) ->
      forall v (m :: * -> *).
(KnownT a, MonadFail m) =>
(UnpackedValScope a => m v) -> m v
forall (a :: T) v (m :: * -> *).
(KnownT a, MonadFail m) =>
(UnpackedValScope a => m v) -> m v
withUnpackedValueScope @st ((UnpackedValScope a => Get (Value t)) -> Get (Value t))
-> (UnpackedValScope a => Get (Value t)) -> Get (Value t)
forall a b. (a -> b) -> a -> b
$
        Sing a -> (Comparable a => Get (Value t)) -> Get (Value t)
forall (a :: T) v (m :: * -> *).
MonadFail m =>
Sing a -> (Comparable a => m v) -> m v
withComparable Sing a
st ((Comparable a => Get (Value t)) -> Get (Value t))
-> (Comparable a => Get (Value t)) -> Get (Value t)
forall a b. (a -> b) -> a -> b
$ Map (Value' Instr a) (Value' Instr b) -> Value' Instr ('TMap a b)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(KnownT k, KnownT v, Comparable k) =>
Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
T.VMap (Map (Value' Instr a) (Value' Instr b) -> Value' Instr ('TMap a b))
-> Get (Map (Value' Instr a) (Value' Instr b))
-> Get (Value' Instr ('TMap a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Map (Value' Instr a) (Value' Instr b))
forall (k :: T) (v :: T).
(UnpackedValScope k, UnpackedValScope v) =>
Get $ Map (Value k) (Value v)
decodeMap

    STInt -> do
      String -> Word8 -> Get ()
expectTag "Int" 0x00
      Integer -> Value' Instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
T.VInt (Integer -> Value' Instr 'TInt)
-> Get Integer -> Get (Value' Instr 'TInt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
forall i. (Integral i, Bits i) => Get i
decodeInt
    STNat -> do
      String -> Word8 -> Get ()
expectTag "Nat" 0x00
      Natural -> Value' Instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
T.VNat (Natural -> Value' Instr 'TNat)
-> Get Natural -> Get (Value' Instr 'TNat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Natural
forall i. (Integral i, Bits i) => Get i
decodeInt
    STString -> do
      String -> Word8 -> Get ()
expectTag "String" 0x01
      MText -> Value' Instr 'TString
forall (instr :: [T] -> [T] -> *). MText -> Value' instr 'TString
T.VString (MText -> Value' Instr 'TString)
-> Get MText -> Get (Value' Instr 'TString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MText
decodeString
    STBytes -> do
      String -> Word8 -> Get ()
expectTag "Bytes" 0x0a
      ByteString -> Value' Instr 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
T.VBytes (ByteString -> Value' Instr 'TBytes)
-> Get ByteString -> Get (Value' Instr 'TBytes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
decodeBytes
    STMutez -> do
      String -> Word8 -> Get ()
expectTag "Mutez" 0x00
      Maybe Mutez
mmutez <- Word64 -> Maybe Mutez
mkMutez (Word64 -> Maybe Mutez) -> Get Word64 -> Get (Maybe Mutez)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
forall i. (Integral i, Bits i) => Get i
decodeInt
      Get (Value' Instr 'TMutez)
-> (Mutez -> Get (Value' Instr 'TMutez))
-> Maybe Mutez
-> Get (Value' Instr 'TMutez)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get (Value' Instr 'TMutez)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Negative mutez") (Value' Instr 'TMutez -> Get (Value' Instr 'TMutez)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' Instr 'TMutez -> Get (Value' Instr 'TMutez))
-> (Mutez -> Value' Instr 'TMutez)
-> Mutez
-> Get (Value' Instr 'TMutez)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mutez -> Value' Instr 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
T.VMutez) Maybe Mutez
mmutez
    STBool -> do
      HasCallStack => String -> Word16 -> Get ()
String -> Word16 -> Get ()
expectDescTag "Bool" 0
      Get Word8
Get.getWord8 Get Word8
-> (Word8 -> Get (Value' Instr 'TBool))
-> Get (Value' Instr 'TBool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        0x0A -> Value' Instr 'TBool -> Get (Value' Instr 'TBool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value' Instr 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
T.VBool Bool
True)
        0x03 -> Value' Instr 'TBool -> Get (Value' Instr 'TBool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value' Instr 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
T.VBool Bool
False)
        other :: Word8
other -> String -> Word8 -> Get (Value' Instr 'TBool)
forall a. String -> Word8 -> Get a
unknownTag "bool" Word8
other
    STKeyHash -> KeyHash -> Value' Instr 'TKeyHash
forall (instr :: [T] -> [T] -> *).
KeyHash -> Value' instr 'TKeyHash
T.VKeyHash (KeyHash -> Value' Instr 'TKeyHash)
-> Get KeyHash -> Get (Value' Instr 'TKeyHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get KeyHash, Text -> Either CryptoParseError KeyHash)
-> Get KeyHash
forall e a. Buildable e => (Get a, Text -> Either e a) -> Get a
decodeAsBytesOrString
      ( String -> [TaggedDecoder KeyHash] -> Get KeyHash
forall a. String -> [TaggedDecoder a] -> Get a
decodeWithTag "key_hash" [TaggedDecoder KeyHash]
keyHashDecoders
      , Text -> Either CryptoParseError KeyHash
parseKeyHash
      )
    STTimestamp -> String
-> Get (Value' Instr 'TTimestamp) -> Get (Value' Instr 'TTimestamp)
forall a. String -> Get a -> Get a
Get.label "Timestamp" (Get (Value' Instr 'TTimestamp) -> Get (Value t))
-> Get (Value' Instr 'TTimestamp) -> Get (Value t)
forall a b. (a -> b) -> a -> b
$ Get Word8
Get.getWord8 Get Word8
-> (Word8 -> Get (Value' Instr 'TTimestamp))
-> Get (Value' Instr 'TTimestamp)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      0x00 -> do
        Timestamp -> Value' Instr 'TTimestamp
forall (instr :: [T] -> [T] -> *).
Timestamp -> Value' instr 'TTimestamp
T.VTimestamp (Timestamp -> Value' Instr 'TTimestamp)
-> (Integer -> Timestamp) -> Integer -> Value' Instr 'TTimestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Timestamp
timestampFromSeconds (Integer -> Value' Instr 'TTimestamp)
-> Get Integer -> Get (Value' Instr 'TTimestamp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Integer
forall i. (Integral i, Bits i) => Get i
decodeInt
      0x01 -> do
        MText
str <- Get MText
decodeString
        Get (Value' Instr 'TTimestamp)
-> (Timestamp -> Get (Value' Instr 'TTimestamp))
-> Maybe Timestamp
-> Get (Value' Instr 'TTimestamp)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get (Value' Instr 'TTimestamp)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Value' Instr 'TTimestamp))
-> String -> Get (Value' Instr 'TTimestamp)
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ "failed to parse timestamp from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MText -> Text
unMText MText
str)
          (Value' Instr 'TTimestamp -> Get (Value' Instr 'TTimestamp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' Instr 'TTimestamp -> Get (Value' Instr 'TTimestamp))
-> (Timestamp -> Value' Instr 'TTimestamp)
-> Timestamp
-> Get (Value' Instr 'TTimestamp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timestamp -> Value' Instr 'TTimestamp
forall (instr :: [T] -> [T] -> *).
Timestamp -> Value' instr 'TTimestamp
T.VTimestamp) (Maybe Timestamp -> Get (Value' Instr 'TTimestamp))
-> Maybe Timestamp -> Get (Value' Instr 'TTimestamp)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Timestamp
parseTimestamp (Text -> Maybe Timestamp) -> Text -> Maybe Timestamp
forall a b. (a -> b) -> a -> b
$ MText -> Text
unMText MText
str
      other :: Word8
other -> String -> Word8 -> Get (Value' Instr 'TTimestamp)
forall a. String -> Word8 -> Get a
unknownTag "int or string" Word8
other
    STAddress ->
      EpAddress -> Value' Instr 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
T.VAddress (EpAddress -> Value' Instr 'TAddress)
-> Get EpAddress -> Get (Value' Instr 'TAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get EpAddress, Text -> Either ParseEpAddressError EpAddress)
-> Get EpAddress
forall e a. Buildable e => (Get a, Text -> Either e a) -> Get a
decodeAsBytesOrString
      ( String
-> (ByteString -> Either ParseEpAddressError EpAddress)
-> Get EpAddress
forall err a.
Buildable err =>
String -> (ByteString -> Either err a) -> Get a
decodeBytesLike "EpAddress" ByteString -> Either ParseEpAddressError EpAddress
parseEpAddressRaw
      , Text -> Either ParseEpAddressError EpAddress
parseEpAddress
      )

withUnpackedValueScope
  :: forall a v m. (KnownT a, MonadFail m)
  => (T.UnpackedValScope a => m v)
  -> m v
withUnpackedValueScope :: (UnpackedValScope a => m v) -> m v
withUnpackedValueScope act :: UnpackedValScope a => m v
act = case CheckScope (UnpackedValScope a) =>
Either BadTypeForScope (Dict (UnpackedValScope a))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
T.checkScope @(T.UnpackedValScope a) of
  Right Dict -> m v
UnpackedValScope a => m v
act
  _ -> String -> m v
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Unpackable value is required here"

withComparable
  :: forall a v m. (MonadFail m)
  => Sing a
  -> (T.Comparable a => m v)
  -> m v
withComparable :: Sing a -> (Comparable a => m v) -> m v
withComparable a :: Sing a
a act :: Comparable a => m v
act = case Sing a -> Maybe (Dict (Comparable a))
forall (a :: T). Sing a -> Maybe (Dict (Comparable a))
T.getComparableProofS Sing a
a of
  Just Dict -> m v
Comparable a => m v
act
  Nothing -> String -> m v
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Comparable type is required here"

-- | Read length of something (list, string, ...).
decodeLength :: Get Int
decodeLength :: Get Int
decodeLength = String -> Get Int -> Get Int
forall a. String -> Get a -> Get a
Get.label "Length" (Get Int -> Get Int) -> Get Int -> Get Int
forall a b. (a -> b) -> a -> b
$ do
  Word32
len <- Get Word32
Get.getWord32be
  -- @martoon: I'm not sure whether returning 'Int' is valid here.
  -- Strictly speaking, it may be 'Word32', but there seems to be no easy way
  -- to check the reference implementation on that.
  -- One more reason to go with just 'Int' for now is that we need to be able to
  -- deserialize byte arrays, and 'BS.ByteString' keeps length of type 'Int'
  -- inside.
  Word32 -> Either Text Int
forall a b. (Integral a, Integral b) => a -> Either Text b
fromIntegralChecked Word32
len
    Either Text Int -> (Either Text Int -> Get Int) -> Get Int
forall a b. a -> (a -> b) -> b
& (Text -> Get Int) -> (Int -> Get Int) -> Either Text Int -> Get Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Get Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Int) -> (Text -> String) -> Text -> Get Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString) Int -> Get Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Get Int -> String -> Get Int
forall a. Get a -> String -> Get a
? "Length"

decodeAsListRaw :: Get a -> Get a
decodeAsListRaw :: Get a -> Get a
decodeAsListRaw getElems :: Get a
getElems = do
  Int
l <- Get Int
decodeLength Get Int -> String -> Get Int
forall a. Get a -> String -> Get a
? "List length"
  Int -> Get a -> Get a
forall a. Int -> Get a -> Get a
Get.isolate Int
l (Get a
getElems Get a -> String -> Get a
forall a. Get a -> String -> Get a
? "List content")

-- | Given decoder for list content, get a whole list decoder.
decodeAsList :: Get a -> Get a
decodeAsList :: Get a -> Get a
decodeAsList getElems :: Get a
getElems = do
  String -> Word8 -> Get ()
expectTag "List" 0x02
  Get a -> Get a
forall a. Get a -> Get a
decodeAsListRaw Get a
getElems

decodeString :: Get MText
decodeString :: Get MText
decodeString = do
  Int
l <- Get Int
decodeLength Get Int -> String -> Get Int
forall a. Get a -> String -> Get a
? "String length"
  [Word8]
ss <- Int -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
l Get Word8
Get.getWord8 Get [Word8] -> String -> Get [Word8]
forall a. Get a -> String -> Get a
? "String content"
  Text
ss' <- ByteString -> Either UnicodeException Text
decodeUtf8' ([Word8] -> ByteString
BS.pack [Word8]
ss)
    Either UnicodeException Text
-> (Either UnicodeException Text -> Get Text) -> Get Text
forall a b. a -> (a -> b) -> b
& (UnicodeException -> Get Text)
-> (Text -> Get Text) -> Either UnicodeException Text -> Get Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Get Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Text)
-> (UnicodeException -> String) -> UnicodeException -> Get Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> String
forall b a. (Show a, IsString b) => a -> b
show) Text -> Get Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Get Text -> String -> Get Text
forall a. Get a -> String -> Get a
? "String UTF-8 decoding"
  Text -> Either Text MText
mkMText Text
ss'
    Either Text MText -> (Either Text MText -> Get MText) -> Get MText
forall a b. a -> (a -> b) -> b
& (Text -> Get MText)
-> (MText -> Get MText) -> Either Text MText -> Get MText
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Get MText
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get MText) -> (Text -> String) -> Text -> Get MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall b a. (Show a, IsString b) => a -> b
show) MText -> Get MText
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Get MText -> String -> Get MText
forall a. Get a -> String -> Get a
? "Michelson string validity analysis"

decodeAsBytesRaw :: (Int -> Get a) -> Get a
decodeAsBytesRaw :: (Int -> Get a) -> Get a
decodeAsBytesRaw decode :: Int -> Get a
decode = do
  Int
l <- Get Int
decodeLength Get Int -> String -> Get Int
forall a. Get a -> String -> Get a
? "Byte array length"
  Int -> Get a
decode Int
l

decodeAsBytesOrString :: Buildable e => (Get a, Text -> Either e a) -> Get a
decodeAsBytesOrString :: (Get a, Text -> Either e a) -> Get a
decodeAsBytesOrString (bytesDecoder :: Get a
bytesDecoder, strParser :: Text -> Either e a
strParser) =
  Get Word8
Get.getWord8 Get Word8 -> (Word8 -> Get a) -> Get a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    0x01 -> do
      MText
str <- Get MText
decodeString
      (e -> Get a) -> (a -> Get a) -> Either e a -> Get a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get a) -> (e -> String) -> e -> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> Get a) -> Either e a -> Get a
forall a b. (a -> b) -> a -> b
$ Text -> Either e a
strParser (Text -> Either e a) -> Text -> Either e a
forall a b. (a -> b) -> a -> b
$ MText -> Text
unMText MText
str
    0x0A -> do
      (Int -> Get a) -> Get a
forall a. (Int -> Get a) -> Get a
decodeAsBytesRaw ((Int -> Get a) -> Get a) -> (Int -> Get a) -> Get a
forall a b. (a -> b) -> a -> b
$ \l :: Int
l ->
        Int -> Get a -> Get a
forall a. Int -> Get a -> Get a
Get.isolate Int
l Get a
bytesDecoder Get a -> String -> Get a
forall a. Get a -> String -> Get a
? "Binary content"
    other :: Word8
other -> String -> Word8 -> Get a
forall a. String -> Word8 -> Get a
unknownTag "text or string" Word8
other


decodeBytesLikeMaybe
  :: String -> (ByteString -> Maybe a) -> Get a
decodeBytesLikeMaybe :: String -> (ByteString -> Maybe a) -> Get a
decodeBytesLikeMaybe onErr :: String
onErr constructor :: ByteString -> Maybe a
constructor = do
  ByteString
bs <- Get ByteString
getRemainingByteStringCopy
  case ByteString -> Maybe a
constructor ByteString
bs of
    Nothing -> String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
onErr
    Just res :: a
res -> a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

decodeBytes :: Get ByteString
decodeBytes :: Get ByteString
decodeBytes =
  (Int -> Get ByteString) -> Get ByteString
forall a. (Int -> Get a) -> Get a
decodeAsBytesRaw ((Int -> Get ByteString) -> Get ByteString)
-> (Int -> Get ByteString) -> Get ByteString
forall a b. (a -> b) -> a -> b
$ String -> Get ByteString -> Get ByteString
forall a. String -> Get a -> Get a
Get.label "Bytes payload" (Get ByteString -> Get ByteString)
-> (Int -> Get ByteString) -> Int -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get ByteString
getByteStringCopy

decodeMap
  :: forall k v.(UnpackedValScope k, UnpackedValScope v)
  => Get $ Map (T.Value k) (T.Value v)
decodeMap :: Get $ Map (Value k) (Value v)
decodeMap = Sing k
-> (Comparable k => Get $ Map (Value k) (Value v))
-> Get $ Map (Value k) (Value v)
forall (a :: T) v (m :: * -> *).
MonadFail m =>
Sing a -> (Comparable a => m v) -> m v
withComparable (SingI k => Sing k
forall k (a :: k). SingI a => Sing a
sing @k) ((Comparable k => Get $ Map (Value k) (Value v))
 -> Get $ Map (Value k) (Value v))
-> (Comparable k => Get $ Map (Value k) (Value v))
-> Get $ Map (Value k) (Value v)
forall a b. (a -> b) -> a -> b
$ String
-> (Get $ Map (Value k) (Value v)) -> Get $ Map (Value k) (Value v)
forall a. String -> Get a -> Get a
Get.label "Map" ((Get $ Map (Value k) (Value v)) -> Get $ Map (Value k) (Value v))
-> (Get $ Map (Value k) (Value v)) -> Get $ Map (Value k) (Value v)
forall a b. (a -> b) -> a -> b
$
  (Get $ Map (Value k) (Value v)) -> Get $ Map (Value k) (Value v)
forall a. Get a -> Get a
decodeAsList ((Get $ Map (Value k) (Value v)) -> Get $ Map (Value k) (Value v))
-> (Get $ Map (Value k) (Value v)) -> Get $ Map (Value k) (Value v)
forall a b. (a -> b) -> a -> b
$ do
    [(Value k, Value v)]
es <- Get (Value k, Value v) -> Get [(Value k, Value v)]
forall a. Get a -> Get [a]
manyForced (Get (Value k, Value v) -> Get [(Value k, Value v)])
-> Get (Value k, Value v) -> Get [(Value k, Value v)]
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => String -> Word16 -> Get ()
String -> Word16 -> Get ()
expectDescTag "Elt" 2
      String -> Word8 -> Get ()
expectTag "Elt" 0x04
      (,) (Value k -> Value v -> (Value k, Value v))
-> Get (Value k) -> Get (Value v -> (Value k, Value v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Value k)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue Get (Value v -> (Value k, Value v))
-> Get (Value v) -> Get (Value k, Value v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Value v)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue
    (Text -> Get $ Map (Value k) (Value v))
-> (Map (Value k) (Value v) -> Get $ Map (Value k) (Value v))
-> Either Text (Map (Value k) (Value v))
-> Get $ Map (Value k) (Value v)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Get $ Map (Value k) (Value v)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get $ Map (Value k) (Value v))
-> (Text -> String) -> Text -> Get $ Map (Value k) (Value v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString) Map (Value k) (Value v) -> Get $ Map (Value k) (Value v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Map (Value k) (Value v))
 -> Get $ Map (Value k) (Value v))
-> Either Text (Map (Value k) (Value v))
-> Get $ Map (Value k) (Value v)
forall a b. (a -> b) -> a -> b
$
      [(Value k, Value v)] -> Map (Value k) (Value v)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(Value k, Value v)] -> Map (Value k) (Value v))
-> Either Text [(Value k, Value v)]
-> Either Text (Map (Value k) (Value v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Value k, Value v) -> Value k)
-> [(Value k, Value v)] -> Either Text [(Value k, Value v)]
forall b a. (Ord b, Show a) => (a -> b) -> [a] -> Either Text [a]
ensureDistinctAsc (Value k, Value v) -> Value k
forall a b. (a, b) -> a
fst [(Value k, Value v)]
es

-- | Read a numeric value.
decodeInt :: (Integral i, Bits.Bits i) => Get i
decodeInt :: Get i
decodeInt = (forall b.
(Integral Integer, Integral b, Bits Integer, Bits b) =>
Integer -> Maybe b
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized @Integer (Integer -> Maybe i) -> Get Integer -> Get (Maybe i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Integer -> Get Integer
forall b. (Num b, Bits b) => Int -> b -> Get b
loop 0 0 Get (Maybe i) -> String -> Get (Maybe i)
forall a. Get a -> String -> Get a
? "Number")
            Get (Maybe i) -> (Maybe i -> Get i) -> Get i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Get i -> (i -> Get i) -> Maybe i -> Get i
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get i
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Value doesn't satisfy type ranges") i -> Get i
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    loop :: Int -> b -> Get b
loop !Int
offset !b
acc = do
      Word8
byte <- Get Word8
Get.getWord8

      let hasCont :: Bool
hasCont = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit Word8
byte 7
      let doCont :: Int -> b -> Get b
doCont shft :: Int
shft = if Bool
hasCont then Int -> b -> Get b
loop (Int
shft Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) else b -> Get b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      let addAndCont :: Int -> Word8 -> Get b
addAndCont shft :: Int
shft bytePayload :: Word8
bytePayload =
            Int -> b -> Get b
doCont Int
shft (b -> Get b) -> b -> Get b
forall a b. (a -> b) -> a -> b
$ b
acc b -> b -> b
forall a. Num a => a -> a -> a
+ b -> Int -> b
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
bytePayload) Int
offset

      let payload :: Word8
payload = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
Bits.clearBit Word8
byte 7
      if Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
        then Int -> Word8 -> Get b
addAndCont 7 Word8
payload
        else do
          let sign :: b
sign = if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit Word8
byte 6 then -1 else 1
          let upayload :: Word8
upayload = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
Bits.clearBit Word8
payload 6
          (b
sign b -> b -> b
forall a. Num a => a -> a -> a
*) (b -> b) -> Get b -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word8 -> Get b
addAndCont 6 Word8
upayload

-- | Type check instruction occured from a lambda.
decodeTypeCheckLam
  :: forall inp out m.
     (T.WellTyped inp, T.WellTyped out, MonadFail m)
  => [ExpandedOp]
  -> m (RemFail T.Instr '[inp] '[out])
decodeTypeCheckLam :: [ExpandedOp] -> m (RemFail Instr '[inp] '[out])
decodeTypeCheckLam uinstr :: [ExpandedOp]
uinstr =
  (TCError -> m (RemFail Instr '[inp] '[out]))
-> (RemFail Instr '[inp] '[out] -> m (RemFail Instr '[inp] '[out]))
-> Either TCError (RemFail Instr '[inp] '[out])
-> m (RemFail Instr '[inp] '[out])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TCError -> m (RemFail Instr '[inp] '[out])
forall (m :: * -> *) a a. (MonadFail m, Buildable a) => a -> m a
tcErrToFail RemFail Instr '[inp] '[out] -> m (RemFail Instr '[inp] '[out])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TCError (RemFail Instr '[inp] '[out])
 -> m (RemFail Instr '[inp] '[out]))
-> (ReaderT
      TypeCheckOptions
      (ExceptT TCError (StateT TypeCheckEnv Identity))
      (RemFail Instr '[inp] '[out])
    -> Either TCError (RemFail Instr '[inp] '[out]))
-> ReaderT
     TypeCheckOptions
     (ExceptT TCError (StateT TypeCheckEnv Identity))
     (RemFail Instr '[inp] '[out])
-> m (RemFail Instr '[inp] '[out])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
  TypeCheckOptions
  (ExceptT TCError (StateT TypeCheckEnv Identity))
  (RemFail Instr '[inp] '[out])
-> Either TCError (RemFail Instr '[inp] '[out])
forall e a.
ReaderT
  TypeCheckOptions (ExceptT e (StateT TypeCheckEnv Identity)) a
-> Either e a
run (ReaderT
   TypeCheckOptions
   (ExceptT TCError (StateT TypeCheckEnv Identity))
   (RemFail Instr '[inp] '[out])
 -> m (RemFail Instr '[inp] '[out]))
-> ReaderT
     TypeCheckOptions
     (ExceptT TCError (StateT TypeCheckEnv Identity))
     (RemFail Instr '[inp] '[out])
-> m (RemFail Instr '[inp] '[out])
forall a b. (a -> b) -> a -> b
$ do
    let inp :: HST '[inp]
inp = (Notes inp
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped inp)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
forall k (a :: k). Annotation a
noAnn) (Notes inp, Dict (WellTyped inp), Annotation VarTag)
-> HST '[] -> HST '[inp]
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST '[]
SNil
    _ :/ instr' :: SomeInstrOut '[inp]
instr' <- [ExpandedOp] -> HST '[inp] -> TypeCheck (SomeInstr '[inp])
forall (inp :: [T]).
Typeable inp =>
[ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
typeCheckList [ExpandedOp]
uinstr HST '[inp]
inp
    case SomeInstrOut '[inp]
instr' of
      instr :: Instr '[inp] out
instr ::: out' :: HST out
out' ->
        case HST out -> Either TCTypeError (out :~: '[out])
forall (t :: T) (st :: [T]).
(Typeable st, WellTyped t) =>
HST st -> Either TCTypeError (st :~: '[t])
eqHST1 @out HST out
out' of
          Right Refl ->
            RemFail Instr '[inp] out
-> ReaderT
     TypeCheckOptions
     (ExceptT TCError (StateT TypeCheckEnv Identity))
     (RemFail Instr '[inp] '[out])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemFail Instr '[inp] out
 -> ReaderT
      TypeCheckOptions
      (ExceptT TCError (StateT TypeCheckEnv Identity))
      (RemFail Instr '[inp] '[out]))
-> RemFail Instr '[inp] out
-> ReaderT
     TypeCheckOptions
     (ExceptT TCError (StateT TypeCheckEnv Identity))
     (RemFail Instr '[inp] '[out])
forall a b. (a -> b) -> a -> b
$ Instr '[inp] out -> RemFail Instr '[inp] out
forall k (instr :: k -> k -> *) (i :: k) (o :: k).
instr i o -> RemFail instr i o
RfNormal Instr '[inp] out
instr
          Left err :: TCTypeError
err ->
                -- dummy types, we have no full information to build untyped
                -- 'T' anyway
            let tinp :: Type
tinp = T -> TypeAnn -> Type
Type T
TUnit TypeAnn
forall k (a :: k). Annotation a
noAnn
                tout :: Type
tout = T -> TypeAnn -> Type
Type T
TUnit TypeAnn
forall k (a :: k). Annotation a
noAnn
            in TCError
-> ReaderT
     TypeCheckOptions
     (ExceptT TCError (StateT TypeCheckEnv Identity))
     (RemFail Instr '[inp] '[out])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError
 -> ReaderT
      TypeCheckOptions
      (ExceptT TCError (StateT TypeCheckEnv Identity))
      (RemFail Instr '[inp] '[out]))
-> TCError
-> ReaderT
     TypeCheckOptions
     (ExceptT TCError (StateT TypeCheckEnv Identity))
     (RemFail Instr '[inp] '[out])
forall a b. (a -> b) -> a -> b
$
              ExpandedInstr
-> SomeHST
-> InstrCallStack
-> Maybe TypeContext
-> Maybe TCTypeError
-> TCError
TCFailedOnInstr (Annotation VarTag -> Type -> Type -> [ExpandedOp] -> ExpandedInstr
forall op.
Annotation VarTag -> Type -> Type -> [op] -> InstrAbstract op
LAMBDA Annotation VarTag
forall k (a :: k). Annotation a
noAnn Type
tinp Type
tout [ExpandedOp]
uinstr) (HST '[inp] -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST '[inp]
inp) InstrCallStack
forall a. Default a => a
def
              (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
LambdaCode) (TCTypeError -> Maybe TCTypeError
forall a. a -> Maybe a
Just TCTypeError
err)
      AnyOutInstr instr :: forall (out :: [T]). Instr '[inp] out
instr ->
        RemFail Instr '[inp] '[out]
-> ReaderT
     TypeCheckOptions
     (ExceptT TCError (StateT TypeCheckEnv Identity))
     (RemFail Instr '[inp] '[out])
forall (m :: * -> *) a. Monad m => a -> m a
return (RemFail Instr '[inp] '[out]
 -> ReaderT
      TypeCheckOptions
      (ExceptT TCError (StateT TypeCheckEnv Identity))
      (RemFail Instr '[inp] '[out]))
-> RemFail Instr '[inp] '[out]
-> ReaderT
     TypeCheckOptions
     (ExceptT TCError (StateT TypeCheckEnv Identity))
     (RemFail Instr '[inp] '[out])
forall a b. (a -> b) -> a -> b
$ (forall (out :: [T]). Instr '[inp] out)
-> RemFail Instr '[inp] '[out]
forall k (instr :: k -> k -> *) (i :: k) (o :: k).
(forall (o' :: k). instr i o') -> RemFail instr i o
RfAlwaysFails forall (out :: [T]). Instr '[inp] out
instr
  where
    run :: ReaderT
  TypeCheckOptions (ExceptT e (StateT TypeCheckEnv Identity)) a
-> Either e a
run = TypeCheckEnv -> State TypeCheckEnv (Either e a) -> Either e a
forall s a. s -> State s a -> a
evaluatingState TypeCheckEnv
tcInitEnv (State TypeCheckEnv (Either e a) -> Either e a)
-> (ReaderT
      TypeCheckOptions (ExceptT e (StateT TypeCheckEnv Identity)) a
    -> State TypeCheckEnv (Either e a))
-> ReaderT
     TypeCheckOptions (ExceptT e (StateT TypeCheckEnv Identity)) a
-> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e (StateT TypeCheckEnv Identity) a
-> State TypeCheckEnv (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e (StateT TypeCheckEnv Identity) a
 -> State TypeCheckEnv (Either e a))
-> (ReaderT
      TypeCheckOptions (ExceptT e (StateT TypeCheckEnv Identity)) a
    -> ExceptT e (StateT TypeCheckEnv Identity) a)
-> ReaderT
     TypeCheckOptions (ExceptT e (StateT TypeCheckEnv Identity)) a
-> State TypeCheckEnv (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheckOptions
-> ReaderT
     TypeCheckOptions (ExceptT e (StateT TypeCheckEnv Identity)) a
-> ExceptT e (StateT TypeCheckEnv Identity) a
forall r (m :: * -> *) a. r -> ReaderT r m a -> m a
usingReaderT TypeCheckOptions
forall a. Default a => a
def
    tcErrToFail :: a -> m a
tcErrToFail err :: a
err = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ "Type check failed: " Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| a
err a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
    tcInitEnv :: TypeCheckEnv
tcInitEnv =
      TypeCheckEnv :: TcExtFrames -> TypeCheckMode -> TypeCheckEnv
TypeCheckEnv
      { tcExtFrames :: TcExtFrames
tcExtFrames = Text -> TcExtFrames
forall a. HasCallStack => Text -> a
error "runInstrImpl(UNPACK): tcExtFrames touched"
        --- ^ This is safe because @UNPACK@ never produces Ext instructions
      , tcMode :: TypeCheckMode
tcMode = TypeCheckMode
TypeCheckPack
      }

decodeInstr :: Get ExpandedInstr
decodeInstr :: Get ExpandedInstr
decodeInstr = String -> Get ExpandedInstr -> Get ExpandedInstr
forall a. String -> Get a -> Get a
Get.label "Instruction" (Get ExpandedInstr -> Get ExpandedInstr)
-> Get ExpandedInstr -> Get ExpandedInstr
forall a b. (a -> b) -> a -> b
$ do
  Word8
pretag <- Get Word8
Get.getWord8 Get Word8 -> String -> Get Word8
forall a. Get a -> String -> Get a
? "Pre instr tag"
  Word8
tag <- Get Word8
Get.getWord8 Get Word8 -> String -> Get Word8
forall a. Get a -> String -> Get a
? "Instr tag"
  case (Word8
pretag, Word8
tag) of
    (0x03, 0x20) -> ExpandedInstr -> Get ExpandedInstr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpandedInstr -> Get ExpandedInstr)
-> ExpandedInstr -> Get ExpandedInstr
forall a b. (a -> b) -> a -> b
$ ExpandedInstr
forall op. InstrAbstract op
DROP
    (0x05, 0x20) -> Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
DROPN (Word -> ExpandedInstr) -> Get Word -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Word8 -> Get ()
expectTag "'DROP n' parameter" 0x00 Get () -> Get Word -> Get Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get Word
forall i. (Integral i, Bits i) => Get i
decodeInt)
    (0x03, 0x21) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
DUP (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x4C) -> ExpandedInstr -> Get ExpandedInstr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpandedInstr -> Get ExpandedInstr)
-> ExpandedInstr -> Get ExpandedInstr
forall a b. (a -> b) -> a -> b
$ ExpandedInstr
forall op. InstrAbstract op
SWAP
    (0x05, 0x70) -> Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
DIG (Word -> ExpandedInstr) -> Get Word -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Word8 -> Get ()
expectTag "'DIG n' parameter" 0x00 Get () -> Get Word -> Get Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get Word
forall i. (Integral i, Bits i) => Get i
decodeInt)
    (0x05, 0x71) -> Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
DUG (Word -> ExpandedInstr) -> Get Word -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Word8 -> Get ()
expectTag "'DUG n' parameter" 0x00 Get () -> Get Word -> Get Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get Word
forall i. (Integral i, Bits i) => Get i
decodeInt)
    (0x07, 0x43) -> do
      (typ :: Type
typ, val :: Value
val) <- Get (Type, Value)
decodePushVal
      Annotation VarTag
an <- Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
      return $ Annotation VarTag -> Type -> Value -> ExpandedInstr
forall op.
Annotation VarTag -> Type -> Value' op -> InstrAbstract op
PUSH Annotation VarTag
an Type
typ Value
val
    (0x03, 0x46) -> TypeAnn -> Annotation VarTag -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> InstrAbstract op
SOME (TypeAnn -> Annotation VarTag -> ExpandedInstr)
-> Get TypeAnn -> Get (Annotation VarTag -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x05, 0x3E) -> TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> Type -> InstrAbstract op
NONE (TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr)
-> Get TypeAnn -> Get (Annotation VarTag -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (Annotation VarTag -> Type -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
    (0x03, 0x4F) -> TypeAnn -> Annotation VarTag -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> InstrAbstract op
UNIT (TypeAnn -> Annotation VarTag -> ExpandedInstr)
-> Get TypeAnn -> Get (Annotation VarTag -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x07, 0x2F) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_NONE ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ([ExpandedOp] -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ExpandedOp]
decodeOps Get ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [ExpandedOp]
decodeOps
    (0x03, 0x42) -> TypeAnn
-> Annotation VarTag -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn
-> Annotation VarTag -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR (TypeAnn
 -> Annotation VarTag -> FieldAnn -> FieldAnn -> ExpandedInstr)
-> Get TypeAnn
-> Get (Annotation VarTag -> FieldAnn -> FieldAnn -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (Annotation VarTag -> FieldAnn -> FieldAnn -> ExpandedInstr)
-> Get (Annotation VarTag)
-> Get (FieldAnn -> FieldAnn -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> FieldAnn -> ExpandedInstr)
-> Get FieldAnn -> Get (FieldAnn -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> ExpandedInstr)
-> Get FieldAnn -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x16) -> Annotation VarTag -> FieldAnn -> ExpandedInstr
forall op. Annotation VarTag -> FieldAnn -> InstrAbstract op
CAR (Annotation VarTag -> FieldAnn -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (FieldAnn -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> ExpandedInstr)
-> Get FieldAnn -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x17) -> Annotation VarTag -> FieldAnn -> ExpandedInstr
forall op. Annotation VarTag -> FieldAnn -> InstrAbstract op
CDR (Annotation VarTag -> FieldAnn -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (FieldAnn -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> ExpandedInstr)
-> Get FieldAnn -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
    (0x05, 0x33) -> TypeAnn
-> Annotation VarTag
-> FieldAnn
-> FieldAnn
-> Type
-> ExpandedInstr
forall op.
TypeAnn
-> Annotation VarTag
-> FieldAnn
-> FieldAnn
-> Type
-> InstrAbstract op
LEFT (TypeAnn
 -> Annotation VarTag
 -> FieldAnn
 -> FieldAnn
 -> Type
 -> ExpandedInstr)
-> Get TypeAnn
-> Get
     (Annotation VarTag
      -> FieldAnn -> FieldAnn -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get
  (Annotation VarTag
   -> FieldAnn -> FieldAnn -> Type -> ExpandedInstr)
-> Get (Annotation VarTag)
-> Get (FieldAnn -> FieldAnn -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> FieldAnn -> Type -> ExpandedInstr)
-> Get FieldAnn -> Get (FieldAnn -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> Type -> ExpandedInstr)
-> Get FieldAnn -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
                         Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
    (0x05, 0x44) -> TypeAnn
-> Annotation VarTag
-> FieldAnn
-> FieldAnn
-> Type
-> ExpandedInstr
forall op.
TypeAnn
-> Annotation VarTag
-> FieldAnn
-> FieldAnn
-> Type
-> InstrAbstract op
RIGHT (TypeAnn
 -> Annotation VarTag
 -> FieldAnn
 -> FieldAnn
 -> Type
 -> ExpandedInstr)
-> Get TypeAnn
-> Get
     (Annotation VarTag
      -> FieldAnn -> FieldAnn -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get
  (Annotation VarTag
   -> FieldAnn -> FieldAnn -> Type -> ExpandedInstr)
-> Get (Annotation VarTag)
-> Get (FieldAnn -> FieldAnn -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> FieldAnn -> Type -> ExpandedInstr)
-> Get FieldAnn -> Get (FieldAnn -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> Type -> ExpandedInstr)
-> Get FieldAnn -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
                          Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
    (0x07, 0x2E) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ([ExpandedOp] -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ExpandedOp]
decodeOps  Get ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [ExpandedOp]
decodeOps
    (0x05, 0x3D) -> TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> Type -> InstrAbstract op
NIL (TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr)
-> Get TypeAnn -> Get (Annotation VarTag -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (Annotation VarTag -> Type -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
    (0x03, 0x1B) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
CONS (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x07, 0x2D) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_CONS ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ([ExpandedOp] -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ExpandedOp]
decodeOps  Get ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [ExpandedOp]
decodeOps
    (0x03, 0x45) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SIZE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x05, 0x24) -> TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> Type -> InstrAbstract op
EMPTY_SET (TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr)
-> Get TypeAnn -> Get (Annotation VarTag -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (Annotation VarTag -> Type -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeComparable
    (0x07, 0x23) -> TypeAnn -> Annotation VarTag -> Type -> Type -> ExpandedInstr
forall op.
TypeAnn -> Annotation VarTag -> Type -> Type -> InstrAbstract op
EMPTY_MAP (TypeAnn -> Annotation VarTag -> Type -> Type -> ExpandedInstr)
-> Get TypeAnn
-> Get (Annotation VarTag -> Type -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (Annotation VarTag -> Type -> Type -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (Type -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (Type -> Type -> ExpandedInstr)
-> Get Type -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeComparable
                              Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
    (0x07, 0x72) -> TypeAnn -> Annotation VarTag -> Type -> Type -> ExpandedInstr
forall op.
TypeAnn -> Annotation VarTag -> Type -> Type -> InstrAbstract op
EMPTY_BIG_MAP (TypeAnn -> Annotation VarTag -> Type -> Type -> ExpandedInstr)
-> Get TypeAnn
-> Get (Annotation VarTag -> Type -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (Annotation VarTag -> Type -> Type -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (Type -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (Type -> Type -> ExpandedInstr)
-> Get Type -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeComparable
                                  Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
    (0x05, 0x38) -> Annotation VarTag -> [ExpandedOp] -> ExpandedInstr
forall op. Annotation VarTag -> [op] -> InstrAbstract op
MAP (Annotation VarTag -> [ExpandedOp] -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ([ExpandedOp] -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [ExpandedOp]
decodeOps
    (0x05, 0x52) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
ITER ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ExpandedOp]
decodeOps
    (0x03, 0x39) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
MEM (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x29) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
GET (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x50) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
UPDATE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x07, 0x2C) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ([ExpandedOp] -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ExpandedOp]
decodeOps  Get ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [ExpandedOp]
decodeOps
    (0x05, 0x34) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
LOOP ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ExpandedOp]
decodeOps
    (0x05, 0x53) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
LOOP_LEFT ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ExpandedOp]
decodeOps
    (0x09, 0x31) -> do
      (ti :: Type
ti, to :: Type
to, ops :: [ExpandedOp]
ops) <- Get (Type, Type, [ExpandedOp]) -> Get (Type, Type, [ExpandedOp])
forall a. Get a -> Get a
decodeAsListRaw (Get (Type, Type, [ExpandedOp]) -> Get (Type, Type, [ExpandedOp]))
-> Get (Type, Type, [ExpandedOp]) -> Get (Type, Type, [ExpandedOp])
forall a b. (a -> b) -> a -> b
$
        (,,) (Type -> Type -> [ExpandedOp] -> (Type, Type, [ExpandedOp]))
-> Get Type
-> Get (Type -> [ExpandedOp] -> (Type, Type, [ExpandedOp]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeType Get (Type -> [ExpandedOp] -> (Type, Type, [ExpandedOp]))
-> Get Type -> Get ([ExpandedOp] -> (Type, Type, [ExpandedOp]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType Get ([ExpandedOp] -> (Type, Type, [ExpandedOp]))
-> Get [ExpandedOp] -> Get (Type, Type, [ExpandedOp])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [ExpandedOp]
decodeOps
      Annotation VarTag
vAnn <- Get (Annotation VarTag)
decodeVAnnDef
      return $ Annotation VarTag -> Type -> Type -> [ExpandedOp] -> ExpandedInstr
forall op.
Annotation VarTag -> Type -> Type -> [op] -> InstrAbstract op
LAMBDA Annotation VarTag
vAnn Type
ti Type
to [ExpandedOp]
ops
    (0x03, 0x26) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
EXEC (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x73) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
APPLY (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x05, 0x1F) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ExpandedOp]
decodeOps
    (0x07, 0x1F) ->
      Word -> [ExpandedOp] -> ExpandedInstr
forall op. Word -> [op] -> InstrAbstract op
DIPN (Word -> [ExpandedOp] -> ExpandedInstr)
-> Get Word -> Get ([ExpandedOp] -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Word8 -> Get ()
expectTag "'DIP n' parameter" 0x00 Get () -> Get Word -> Get Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Get Word
forall i. (Integral i, Bits i) => Get i
decodeInt) Get ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [ExpandedOp]
decodeOps
    (0x03, 0x27) -> ExpandedInstr -> Get ExpandedInstr
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExpandedInstr
forall op. InstrAbstract op
FAILWITH
    (0x05, 0x57) -> Annotation VarTag -> Type -> ExpandedInstr
forall op. Annotation VarTag -> Type -> InstrAbstract op
CAST (Annotation VarTag -> Type -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
    (0x03, 0x58) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
RENAME (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x0C) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
PACK (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x05, 0x0D) -> TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> Type -> InstrAbstract op
UNPACK (TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr)
-> Get TypeAnn -> Get (Annotation VarTag -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (Annotation VarTag -> Type -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
    (0x03, 0x1A) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
CONCAT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x6F) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SLICE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x56) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
ISNAT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x12) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
ADD (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x4B) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SUB (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x3A) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
MUL (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x22) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
EDIV (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x11) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
ABS (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x3B) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
NEG (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x35) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
LSL (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x36) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
LSR (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x41) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
OR (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x14) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
AND (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x51) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
XOR (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x3F) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
NOT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x19) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
COMPARE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x25) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
EQ (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x3C) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
NEQ (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x37) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
LT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x2A) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
GT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x32) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
LE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x28) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
GE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x30) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
INT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x05, 0x55) -> Annotation VarTag -> FieldAnn -> Type -> ExpandedInstr
forall op.
Annotation VarTag -> FieldAnn -> Type -> InstrAbstract op
CONTRACT (Annotation VarTag -> FieldAnn -> Type -> ExpandedInstr)
-> Get (Annotation VarTag)
-> Get (FieldAnn -> Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> Type -> ExpandedInstr)
-> Get FieldAnn -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
    (0x03, 0x4D) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
TRANSFER_TOKENS (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x4E) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SET_DELEGATE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x05, 0x1D) -> do
      Contract
contract <- Get Contract
decodeContract
      Annotation VarTag -> Annotation VarTag -> Contract -> ExpandedInstr
forall op.
Annotation VarTag
-> Annotation VarTag -> Contract' op -> InstrAbstract op
CREATE_CONTRACT (Annotation VarTag
 -> Annotation VarTag -> Contract -> ExpandedInstr)
-> Get (Annotation VarTag)
-> Get (Annotation VarTag -> Contract -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (Annotation VarTag -> Contract -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (Contract -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (Contract -> ExpandedInstr)
-> Get Contract -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Contract -> Get Contract
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contract
contract
    (0x03, 0x1E) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
IMPLICIT_ACCOUNT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x40) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
NOW (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x13) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
AMOUNT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x15) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
BALANCE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x18) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
CHECK_SIGNATURE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x0F) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SHA256 (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x10) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SHA512 (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x0E) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
BLAKE2B (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x7E) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SHA3 (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x7D) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
KECCAK (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x2B) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
HASH_KEY (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x47) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SOURCE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x48) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SENDER (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x49) -> Annotation VarTag -> FieldAnn -> ExpandedInstr
forall op. Annotation VarTag -> FieldAnn -> InstrAbstract op
SELF (Annotation VarTag -> FieldAnn -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (FieldAnn -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> ExpandedInstr)
-> Get FieldAnn -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x54) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
ADDRESS (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x75) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
CHAIN_ID (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    (0x03, 0x76) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
LEVEL (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
forall t. Get (Annotation t)
decodeNoAnn
    -- Instructions with annotations from here on
    (0x04, 0x21) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
DUP (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x08, 0x43) -> do
      (typ :: Type
typ, val :: Value
val) <- Get (Type, Value)
decodePushVal
      Annotation VarTag
an <- Get (Annotation VarTag)
decodeVAnn
      return $ Annotation VarTag -> Type -> Value -> ExpandedInstr
forall op.
Annotation VarTag -> Type -> Value' op -> InstrAbstract op
PUSH Annotation VarTag
an Type
typ Value
val
    (0x04, 0x46) -> (TypeAnn -> Annotation VarTag -> ExpandedInstr)
-> Get ExpandedInstr
forall a. (TypeAnn -> Annotation VarTag -> a) -> Get a
decodeWithTVAnns TypeAnn -> Annotation VarTag -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> InstrAbstract op
SOME
    (0x06, 0x3E) -> do
      Type
t <- Get Type
decodeType
      (TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr)
-> Get (Type -> ExpandedInstr)
forall a. (TypeAnn -> Annotation VarTag -> a) -> Get a
decodeWithTVAnns TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> Type -> InstrAbstract op
NONE Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
    (0x04, 0x4F) -> (TypeAnn -> Annotation VarTag -> ExpandedInstr)
-> Get ExpandedInstr
forall a. (TypeAnn -> Annotation VarTag -> a) -> Get a
decodeWithTVAnns TypeAnn -> Annotation VarTag -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> InstrAbstract op
UNIT
    (0x04, 0x42) -> (TypeAnn
 -> Annotation VarTag -> FieldAnn -> FieldAnn -> ExpandedInstr)
-> Get ExpandedInstr
forall a.
(TypeAnn -> Annotation VarTag -> FieldAnn -> FieldAnn -> a)
-> Get a
decodeWithTVF2Anns TypeAnn
-> Annotation VarTag -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn
-> Annotation VarTag -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR
    (0x04, 0x16) -> (Annotation VarTag -> FieldAnn -> ExpandedInstr)
-> Get ExpandedInstr
forall a. (Annotation VarTag -> FieldAnn -> a) -> Get a
decodeWithVFAnns Annotation VarTag -> FieldAnn -> ExpandedInstr
forall op. Annotation VarTag -> FieldAnn -> InstrAbstract op
CAR
    (0x04, 0x17) -> (Annotation VarTag -> FieldAnn -> ExpandedInstr)
-> Get ExpandedInstr
forall a. (Annotation VarTag -> FieldAnn -> a) -> Get a
decodeWithVFAnns Annotation VarTag -> FieldAnn -> ExpandedInstr
forall op. Annotation VarTag -> FieldAnn -> InstrAbstract op
CDR
    (0x06, 0x33) -> do
      Type
t <- Get Type
decodeType
      (TypeAnn
 -> Annotation VarTag
 -> FieldAnn
 -> FieldAnn
 -> Type
 -> ExpandedInstr)
-> Get (Type -> ExpandedInstr)
forall a.
(TypeAnn -> Annotation VarTag -> FieldAnn -> FieldAnn -> a)
-> Get a
decodeWithTVF2Anns TypeAnn
-> Annotation VarTag
-> FieldAnn
-> FieldAnn
-> Type
-> ExpandedInstr
forall op.
TypeAnn
-> Annotation VarTag
-> FieldAnn
-> FieldAnn
-> Type
-> InstrAbstract op
LEFT Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
    (0x06, 0x44) -> do
      Type
t <- Get Type
decodeType
      (TypeAnn
 -> Annotation VarTag
 -> FieldAnn
 -> FieldAnn
 -> Type
 -> ExpandedInstr)
-> Get (Type -> ExpandedInstr)
forall a.
(TypeAnn -> Annotation VarTag -> FieldAnn -> FieldAnn -> a)
-> Get a
decodeWithTVF2Anns TypeAnn
-> Annotation VarTag
-> FieldAnn
-> FieldAnn
-> Type
-> ExpandedInstr
forall op.
TypeAnn
-> Annotation VarTag
-> FieldAnn
-> FieldAnn
-> Type
-> InstrAbstract op
RIGHT Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
    (0x06, 0x3D) -> do
      Type
t <- Get Type
decodeType
      (TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr)
-> Get (Type -> ExpandedInstr)
forall a. (TypeAnn -> Annotation VarTag -> a) -> Get a
decodeWithTVAnns TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> Type -> InstrAbstract op
NIL Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
    (0x04, 0x1B) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
CONS (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x45) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SIZE(Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x06, 0x24) -> do
      Type
c <- Get Type
decodeComparable
      (TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr)
-> Get (Type -> ExpandedInstr)
forall a. (TypeAnn -> Annotation VarTag -> a) -> Get a
decodeWithTVAnns TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> Type -> InstrAbstract op
EMPTY_SET Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
c
    (0x08, 0x23) -> do
      Type
c <- Get Type
decodeComparable
      Type
t <- Get Type
decodeType
      (TypeAnn -> Annotation VarTag -> Type -> Type -> ExpandedInstr)
-> Get (Type -> Type -> ExpandedInstr)
forall a. (TypeAnn -> Annotation VarTag -> a) -> Get a
decodeWithTVAnns TypeAnn -> Annotation VarTag -> Type -> Type -> ExpandedInstr
forall op.
TypeAnn -> Annotation VarTag -> Type -> Type -> InstrAbstract op
EMPTY_MAP Get (Type -> Type -> ExpandedInstr)
-> Get Type -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
c Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
    (0x08, 0x72) -> do
      Type
c <- Get Type
decodeComparable
      Type
t <- Get Type
decodeType
      (TypeAnn -> Annotation VarTag -> Type -> Type -> ExpandedInstr)
-> Get (Type -> Type -> ExpandedInstr)
forall a. (TypeAnn -> Annotation VarTag -> a) -> Get a
decodeWithTVAnns TypeAnn -> Annotation VarTag -> Type -> Type -> ExpandedInstr
forall op.
TypeAnn -> Annotation VarTag -> Type -> Type -> InstrAbstract op
EMPTY_BIG_MAP Get (Type -> Type -> ExpandedInstr)
-> Get Type -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
c Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
    (0x06, 0x38) -> do
      [ExpandedOp]
o <- Get [ExpandedOp]
decodeOps
      Annotation VarTag -> [ExpandedOp] -> ExpandedInstr
forall op. Annotation VarTag -> [op] -> InstrAbstract op
MAP (Annotation VarTag -> [ExpandedOp] -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ([ExpandedOp] -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn Get ([ExpandedOp] -> ExpandedInstr)
-> Get [ExpandedOp] -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ExpandedOp] -> Get [ExpandedOp]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ExpandedOp]
o
    (0x04, 0x39) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
MEM (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x29) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
GET (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x50) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
UPDATE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x26) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
EXEC (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x73) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
APPLY (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x06, 0x57) -> do
      Type
t <- Get Type
decodeType
      Annotation VarTag -> Type -> ExpandedInstr
forall op. Annotation VarTag -> Type -> InstrAbstract op
CAST (Annotation VarTag -> Type -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get (Type -> ExpandedInstr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
    (0x04, 0x58) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
RENAME (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x0C) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
PACK (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x06, 0x0D) -> do
      Type
t <- Get Type
decodeType
      (TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr)
-> Get (Type -> ExpandedInstr)
forall a. (TypeAnn -> Annotation VarTag -> a) -> Get a
decodeWithTVAnns TypeAnn -> Annotation VarTag -> Type -> ExpandedInstr
forall op. TypeAnn -> Annotation VarTag -> Type -> InstrAbstract op
UNPACK Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
    (0x04, 0x1A) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
CONCAT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x6F) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SLICE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x56) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
ISNAT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x12) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
ADD (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x4B) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SUB (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x3A) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
MUL (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x22) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
EDIV (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x11) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
ABS (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x3B) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
NEG (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x35) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
LSL (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x36) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
LSR (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x41) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
OR (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x14) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
AND (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x51) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
XOR (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x3F) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
NOT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x19) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
COMPARE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x25) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
EQ (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x3C) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
NEQ (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x37) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
LT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x2A) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
GT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x32) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
LE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x28) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
GE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x30) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
INT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x06, 0x55) -> do
      Type
t <- Get Type
decodeType
      (Annotation VarTag -> FieldAnn -> Type -> ExpandedInstr)
-> Get (Type -> ExpandedInstr)
forall a. (Annotation VarTag -> FieldAnn -> a) -> Get a
decodeWithVFAnns Annotation VarTag -> FieldAnn -> Type -> ExpandedInstr
forall op.
Annotation VarTag -> FieldAnn -> Type -> InstrAbstract op
CONTRACT Get (Type -> ExpandedInstr) -> Get Type -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
    (0x04, 0x4D) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
TRANSFER_TOKENS (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x4E) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SET_DELEGATE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x06, 0x1D) -> do
      Contract
contract <- Get Contract
decodeContract
      (Annotation VarTag
 -> Annotation VarTag -> Contract -> ExpandedInstr)
-> Get (Contract -> ExpandedInstr)
forall a. (Annotation VarTag -> Annotation VarTag -> a) -> Get a
decodeWithV2Anns Annotation VarTag -> Annotation VarTag -> Contract -> ExpandedInstr
forall op.
Annotation VarTag
-> Annotation VarTag -> Contract' op -> InstrAbstract op
CREATE_CONTRACT Get (Contract -> ExpandedInstr)
-> Get Contract -> Get ExpandedInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Contract -> Get Contract
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contract
contract
    (0x04, 0x1E) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
IMPLICIT_ACCOUNT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x40) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
NOW (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x13) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
AMOUNT (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x15) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
BALANCE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x18) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
CHECK_SIGNATURE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x0F) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SHA256 (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x10) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SHA512 (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x0E) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
BLAKE2B (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x7E) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SHA3 (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x7D) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
KECCAK (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x2B) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
HASH_KEY (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x47) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SOURCE (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x48) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
SENDER (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x49) -> (Annotation VarTag -> FieldAnn -> ExpandedInstr)
-> Get ExpandedInstr
forall a. (Annotation VarTag -> FieldAnn -> a) -> Get a
decodeWithVFAnns Annotation VarTag -> FieldAnn -> ExpandedInstr
forall op. Annotation VarTag -> FieldAnn -> InstrAbstract op
SELF
    (0x04, 0x54) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
ADDRESS (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x75) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
CHAIN_ID (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (0x04, 0x76) -> Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
LEVEL (Annotation VarTag -> ExpandedInstr)
-> Get (Annotation VarTag) -> Get ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Annotation VarTag)
decodeVAnn
    (other1 :: Word8
other1, other2 :: Word8
other2) -> String -> Get ExpandedInstr
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ExpandedInstr) -> String -> Get ExpandedInstr
forall a b. (a -> b) -> a -> b
$ "Unknown instruction tag: 0x" Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+|
                        Word8 -> Builder
forall a. FormatAsHex a => a -> Builder
hexF Word8
other1 Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Word8 -> Builder
forall a. FormatAsHex a => a -> Builder
hexF Word8
other2 Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""

decodePushVal :: Get (Type, Value)
decodePushVal :: Get (Type, Value)
decodePushVal = do
  Type
typ <- Get Type
decodeType
  T
-> (forall (a :: T). KnownT a => Sing a -> Get (Type, Value))
-> Get (Type, Value)
forall r. T -> (forall (a :: T). KnownT a => Sing a -> r) -> r
T.withSomeSingT (Type -> T
T.fromUType Type
typ) ((forall (a :: T). KnownT a => Sing a -> Get (Type, Value))
 -> Get (Type, Value))
-> (forall (a :: T). KnownT a => Sing a -> Get (Type, Value))
-> Get (Type, Value)
forall a b. (a -> b) -> a -> b
$ \(_ :: Sing t) ->
    case CheckScope (ConstantScope a) =>
Either BadTypeForScope (Dict (ConstantScope a))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
T.checkScope @(T.ConstantScope t) of
      Left bt :: BadTypeForScope
bt -> String -> Get (Type, Value)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Type, Value)) -> String -> Get (Type, Value)
forall a b. (a -> b) -> a -> b
$ "Type can not appear in PUSH because it " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BadTypeForScope -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty BadTypeForScope
bt
      Right Dict -> do
        Value a
tval <- (HasCallStack, UnpackedValScope a) => Get (Value a)
forall (t :: T).
(HasCallStack, UnpackedValScope t) =>
Get (Value t)
decodeValue @t
        pure $ (Type
typ, Value a -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
T.untypeValue Value a
tval)

decodeContract :: Get Contract
decodeContract :: Get Contract
decodeContract = Get Contract -> Get Contract
forall a. Get a -> Get a
decodeAsList (Get Contract -> Get Contract) -> Get Contract -> Get Contract
forall a b. (a -> b) -> a -> b
$ do
  (ContractBlock ExpandedOp, ContractBlock ExpandedOp,
 ContractBlock ExpandedOp)
result <- Get
  (ContractBlock ExpandedOp, ContractBlock ExpandedOp,
   ContractBlock ExpandedOp)
contractTuple
  case (ContractBlock ExpandedOp, ContractBlock ExpandedOp,
 ContractBlock ExpandedOp)
-> Maybe Contract
forall op.
(ContractBlock op, ContractBlock op, ContractBlock op)
-> Maybe (Contract' op)
orderContractBlock (ContractBlock ExpandedOp, ContractBlock ExpandedOp,
 ContractBlock ExpandedOp)
result of
    Just contract' :: Contract
contract' -> do
      Contract -> Get Contract
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contract
contract'
    Nothing ->
      String -> Get Contract
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Duplicate contract field."
  where
    decodeParamsBlock :: Get (ContractBlock op)
decodeParamsBlock = ParameterType -> ContractBlock op
forall op. ParameterType -> ContractBlock op
CBParam (ParameterType -> ContractBlock op)
-> Get ParameterType -> Get (ContractBlock op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      String -> Word8 -> Get ()
expectTag "Pre contract parameter" 0x05
      String -> Word8 -> Get ()
expectTag "Contract parameter" 0x00
      (t :: T
t, ta :: TypeAnn
ta, root :: FieldAnn
root) <- Get (T, TypeAnn, FieldAnn)
decodeTWithAnns
      pure $ Type -> FieldAnn -> ParameterType
ParameterType (T -> TypeAnn -> Type
Type T
t TypeAnn
ta) FieldAnn
root
    decodeStorageBlock :: Get (ContractBlock op)
decodeStorageBlock = Type -> ContractBlock op
forall op. Type -> ContractBlock op
CBStorage (Type -> ContractBlock op) -> Get Type -> Get (ContractBlock op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      String -> Word8 -> Get ()
expectTag "Pre contract storage" 0x05
      String -> Word8 -> Get ()
expectTag "Contract storage" 0x01
      Get Type
decodeType
    decodeCodeBlock :: Get (ContractBlock ExpandedOp)
decodeCodeBlock = [ExpandedOp] -> ContractBlock ExpandedOp
forall op. [op] -> ContractBlock op
CBCode ([ExpandedOp] -> ContractBlock ExpandedOp)
-> Get [ExpandedOp] -> Get (ContractBlock ExpandedOp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      String -> Word8 -> Get ()
expectTag "Pre contract code" 0x05
      String -> Word8 -> Get ()
expectTag "Contract code" 0x02
      Get [ExpandedOp]
decodeOps

    contractBlock :: Get (ContractBlock ExpandedOp)
contractBlock = Get (ContractBlock ExpandedOp)
forall op. Get (ContractBlock op)
decodeParamsBlock Get (ContractBlock ExpandedOp)
-> Get (ContractBlock ExpandedOp) -> Get (ContractBlock ExpandedOp)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Get (ContractBlock ExpandedOp)
forall op. Get (ContractBlock op)
decodeStorageBlock Get (ContractBlock ExpandedOp)
-> Get (ContractBlock ExpandedOp) -> Get (ContractBlock ExpandedOp)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Get (ContractBlock ExpandedOp)
decodeCodeBlock

    contractTuple :: Get
  (ContractBlock ExpandedOp, ContractBlock ExpandedOp,
   ContractBlock ExpandedOp)
contractTuple = do
      ContractBlock ExpandedOp
result1 <- Get (ContractBlock ExpandedOp)
contractBlock
      ContractBlock ExpandedOp
result2 <- Get (ContractBlock ExpandedOp)
contractBlock
      ContractBlock ExpandedOp
result3 <- Get (ContractBlock ExpandedOp)
contractBlock
      pure (ContractBlock ExpandedOp
result1, ContractBlock ExpandedOp
result2, ContractBlock ExpandedOp
result3)


decodeOp :: Get ExpandedOp
decodeOp :: Get ExpandedOp
decodeOp = String -> Get ExpandedOp -> Get ExpandedOp
forall a. String -> Get a -> Get a
Get.label "Op" (Get ExpandedOp -> Get ExpandedOp)
-> Get ExpandedOp -> Get ExpandedOp
forall a b. (a -> b) -> a -> b
$ do
  Word8
tag <- Get Word8 -> Get Word8
forall a. Get a -> Get a
Get.lookAhead Get Word8
Get.getWord8
  if Word8
tag Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x02
    then [ExpandedOp] -> ExpandedOp
SeqEx ([ExpandedOp] -> ExpandedOp) -> Get [ExpandedOp] -> Get ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ExpandedOp]
decodeOps Get ExpandedOp -> String -> Get ExpandedOp
forall a. Get a -> String -> Get a
? "Ops seq"
    else ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp)
-> Get ExpandedInstr -> Get ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ExpandedInstr
decodeInstr Get ExpandedOp -> String -> Get ExpandedOp
forall a. Get a -> String -> Get a
? "One op"

decodeOps :: Get [ExpandedOp]
decodeOps :: Get [ExpandedOp]
decodeOps = Get [ExpandedOp] -> Get [ExpandedOp]
forall a. Get a -> Get a
decodeAsList (Get [ExpandedOp] -> Get [ExpandedOp])
-> Get [ExpandedOp] -> Get [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Get ExpandedOp -> Get [ExpandedOp]
forall a. Get a -> Get [a]
manyForced Get ExpandedOp
decodeOp

decodeComparable :: Get Type
decodeComparable :: Get Type
decodeComparable = do
  (ct :: T
ct, tAnn :: TypeAnn
tAnn, fAnn :: FieldAnn
fAnn) <- Get (T, TypeAnn, FieldAnn)
decodeComparableTWithAnns
  if FieldAnn
fAnn FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
forall k (a :: k). Annotation a
noAnn
    then Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Get Type) -> Type -> Get Type
forall a b. (a -> b) -> a -> b
$ T -> TypeAnn -> Type
Type T
ct TypeAnn
tAnn
    else String -> Get Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "This Comparable should not have a Field annotation"

decodeType :: Get Type
decodeType :: Get Type
decodeType = do
  (t :: T
t, tAnn :: TypeAnn
tAnn, fAnn :: FieldAnn
fAnn) <- Get (T, TypeAnn, FieldAnn)
decodeTWithAnns
  if FieldAnn
fAnn FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
forall k (a :: k). Annotation a
noAnn
    then Type -> Get Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Get Type) -> Type -> Get Type
forall a b. (a -> b) -> a -> b
$ T -> TypeAnn -> Type
Type T
t TypeAnn
tAnn
    else String -> Get Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "This Type should not have a Field annotation"

decodeComparableTWithAnns :: Get (T, TypeAnn, FieldAnn)
decodeComparableTWithAnns :: Get (T, TypeAnn, FieldAnn)
decodeComparableTWithAnns = String -> Get (T, TypeAnn, FieldAnn) -> Get (T, TypeAnn, FieldAnn)
forall a. String -> Get a -> Get a
Get.label "Comparable primitive type" (Get (T, TypeAnn, FieldAnn) -> Get (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn) -> Get (T, TypeAnn, FieldAnn)
forall a b. (a -> b) -> a -> b
$ do
  Word8
pretag <- Get Word8
Get.getWord8 Get Word8 -> String -> Get Word8
forall a. Get a -> String -> Get a
? "Pre simple comparable type tag"
  Word8
tag <- Get Word8
Get.getWord8 Get Word8 -> String -> Get Word8
forall a. Get a -> String -> Get a
? "Simple comparable type tag"
  let failMessage :: String
failMessage = "Unknown primitive tag: 0x" Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| Word8 -> Builder
forall a. FormatAsHex a => a -> Builder
hexF Word8
pretag Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Word8 -> Builder
forall a. FormatAsHex a => a -> Builder
hexF Word8
tag Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
  T
ct <- case Word8
tag of
    0x5B -> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TInt
    0x62 -> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TNat
    0x68 -> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TString
    0x69 -> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TBytes
    0x6A -> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TMutez
    0x59 -> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TBool
    0x5D -> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TKeyHash
    0x6B -> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TTimestamp
    0x6E -> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TAddress
    0x65 ->
      case Word8
pretag of
        0x07 -> Get T
decodeTPair
        0x08 -> Get T
decodeTPair
        0x09 -> Get T
decodeTPairN
        _ -> String -> Get T
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
failMessage
    _ -> String -> Get T
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
failMessage
  case Word8
pretag of
    0x03 -> (T
ct,,) (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
    0x04 -> (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
ct,,)
    0x05 -> (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
ct,,)
    0x07 -> (T
ct,,) (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
    0x08 -> (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
ct,,)
    0x09 -> (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
ct,,)
    _ -> String -> Get (T, TypeAnn, FieldAnn)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
failMessage

{-# ANN decodeTWithAnns ("HLint: ignore Redundant <$>" :: Text) #-}
decodeTWithAnns :: Get (T, TypeAnn, FieldAnn)
decodeTWithAnns :: Get (T, TypeAnn, FieldAnn)
decodeTWithAnns = Get (T, TypeAnn, FieldAnn)
doDecode Get (T, TypeAnn, FieldAnn)
-> Get (T, TypeAnn, FieldAnn) -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Get (T, TypeAnn, FieldAnn)
decodeComparableTWithAnns Get (T, TypeAnn, FieldAnn) -> String -> Get (T, TypeAnn, FieldAnn)
forall a. Get a -> String -> Get a
? "Type"
  where
    doDecode :: Get (T, TypeAnn, FieldAnn)
doDecode = do
      Word8
pretag <- Get Word8
Get.getWord8 Get Word8 -> String -> Get Word8
forall a. Get a -> String -> Get a
? "Pre complex type tag"
      Word8
tag <- Get Word8
Get.getWord8 Get Word8 -> String -> Get Word8
forall a. Get a -> String -> Get a
? "Complex type tag"
      case (Word8
pretag, Word8
tag) of
        (0x03, 0x5C) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TKey Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x03, 0x6C) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TUnit Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x03, 0x67) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TSignature Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x03, 0x74) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TChainId Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x05, 0x63) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> T
TOption (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeType) Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x05, 0x5F) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> T
TList (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeType) Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x05, 0x66) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> T
TSet (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeComparable) Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x03, 0x6D) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
TOperation Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x05, 0x5A) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> T
TContract (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeType) Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x07, 0x64) -> do
          T
t <- Get T
decodeTOr
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
t Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x07, 0x5E) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> Type -> T
TLambda (Type -> Type -> T) -> Get Type -> Get (Type -> T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeType Get (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType) Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x07, 0x60) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> Type -> T
TMap (Type -> Type -> T) -> Get Type -> Get (Type -> T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeComparable Get (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType) Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        (0x07, 0x61) ->
          (,,) (T -> TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get T -> Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> Type -> T
TBigMap (Type -> Type -> T) -> Get Type -> Get (Type -> T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeComparable Get (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType) Get (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get TypeAnn -> Get (FieldAnn -> (T, TypeAnn, FieldAnn))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get TypeAnn
forall t. Get (Annotation t)
decodeNoAnn Get (FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get FieldAnn -> Get (T, TypeAnn, FieldAnn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get FieldAnn
forall t. Get (Annotation t)
decodeNoAnn
        -- T with annotations from here on
        (0x04, 0x5C) -> (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
TKey,,)
        (0x04, 0x6C) -> (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
TUnit,,)
        (0x04, 0x67) -> (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
TSignature,,)
        (0x04, 0x74) -> (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
TChainId,,)
        (0x06, 0x63) -> do
          T
t <- Type -> T
TOption (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeType
          (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
t,,)
        (0x06, 0x5F) -> do
          T
t <- Type -> T
TList (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeType
          (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
t,,)
        (0x06, 0x66) -> do
          T
t <- Type -> T
TSet (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeComparable
          (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
t,,)
        (0x04, 0x6D) -> (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
TOperation,,)
        (0x06, 0x5A) -> do
          T
t <- Type -> T
TContract (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeType
          (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
t,,)
        (0x08, 0x64) -> do
          T
t <- Get T
decodeTOr
          (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
t,,)
        (0x08, 0x5E) -> do
          T
t <- Type -> Type -> T
TLambda (Type -> Type -> T) -> Get Type -> Get (Type -> T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeType Get (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
          (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
t,,)
        (0x08, 0x60) -> do
          T
t <- Type -> Type -> T
TMap (Type -> Type -> T) -> Get Type -> Get (Type -> T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeComparable Get (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
          (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
t,,)
        (0x08, 0x61) -> do
          T
t <- Type -> Type -> T
TBigMap (Type -> Type -> T) -> Get Type -> Get (Type -> T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Type
decodeComparable Get (Type -> T) -> Get Type -> Get T
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Type
decodeType
          (TypeAnn -> FieldAnn -> (T, TypeAnn, FieldAnn))
-> Get (T, TypeAnn, FieldAnn)
forall a. (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns (T
t,,)
        (other1 :: Word8
other1, other2 :: Word8
other2) -> String -> Get (T, TypeAnn, FieldAnn)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (T, TypeAnn, FieldAnn))
-> String -> Get (T, TypeAnn, FieldAnn)
forall a b. (a -> b) -> a -> b
$ "Unknown primitive tag: 0x" Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+|
                            Word8 -> Builder
forall a. FormatAsHex a => a -> Builder
hexF Word8
other1 Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Word8 -> Builder
forall a. FormatAsHex a => a -> Builder
hexF Word8
other2 Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""

-- | "Normal" pair notation, e.g. `pair int int` or `pair int (pair int int)`
decodeTPair :: Get T
decodeTPair :: Get T
decodeTPair = do
  (t1 :: T
t1, tAnn1 :: TypeAnn
tAnn1, fAnn1 :: FieldAnn
fAnn1) <- Get (T, TypeAnn, FieldAnn)
decodeTWithAnns
  (t2 :: T
t2, tAnn2 :: TypeAnn
tAnn2, fAnn2 :: FieldAnn
fAnn2) <- Get (T, TypeAnn, FieldAnn)
decodeTWithAnns
  T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure (T -> Get T) -> T -> Get T
forall a b. (a -> b) -> a -> b
$ FieldAnn -> FieldAnn -> Type -> Type -> T
TPair FieldAnn
fAnn1 FieldAnn
fAnn2 (T -> TypeAnn -> Type
Type T
t1 TypeAnn
tAnn1) (T -> TypeAnn -> Type
Type T
t2 TypeAnn
tAnn2)

-- | Right-combed notation, e.g. `pair int int int`
decodeTPairN :: Get T
decodeTPairN :: Get T
decodeTPairN = do
  -- Find out how many bytes it took to encode the pair's fields, and decode them.
  Int
fieldsLen <- Get Int
decodeLength Get Int -> String -> Get Int
forall a. Get a -> String -> Get a
? "'pair' number of type arguments"
  [(T, TypeAnn, FieldAnn)]
fields <- Int -> Get [(T, TypeAnn, FieldAnn)] -> Get [(T, TypeAnn, FieldAnn)]
forall a. Int -> Get a -> Get a
Get.isolate Int
fieldsLen (Get (T, TypeAnn, FieldAnn) -> Get [(T, TypeAnn, FieldAnn)]
forall a. Get a -> Get [a]
manyForced Get (T, TypeAnn, FieldAnn)
decodeTWithAnns) Get [(T, TypeAnn, FieldAnn)]
-> String -> Get [(T, TypeAnn, FieldAnn)]
forall a. Get a -> String -> Get a
? "'pair' type arguments"
  [(T, TypeAnn, FieldAnn)] -> Get T
go [(T, TypeAnn, FieldAnn)]
fields
  where
    go :: [(T, TypeAnn, FieldAnn)] -> Get T
    go :: [(T, TypeAnn, FieldAnn)] -> Get T
go = \case
      [] -> String -> Get T
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "The 'pair' type expects at least 2 type arguments, but 0 were given."
      [(t :: T
t, _, _)] -> String -> Get T
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get T) -> String -> Get T
forall a b. (a -> b) -> a -> b
$ "The 'pair' type expects at least 2 type arguments, but only 1 was given: '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> T -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty T
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "'."
      [(t1 :: T
t1, tAnn1 :: TypeAnn
tAnn1, fAnn1 :: FieldAnn
fAnn1), (t2 :: T
t2, tAnn2 :: TypeAnn
tAnn2, fAnn2 :: FieldAnn
fAnn2)] ->
        T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure (T -> Get T) -> T -> Get T
forall a b. (a -> b) -> a -> b
$ FieldAnn -> FieldAnn -> Type -> Type -> T
TPair FieldAnn
fAnn1 FieldAnn
fAnn2 (T -> TypeAnn -> Type
Type T
t1 TypeAnn
tAnn1) (T -> TypeAnn -> Type
Type T
t2 TypeAnn
tAnn2)
      (t1 :: T
t1, t1Ann1 :: TypeAnn
t1Ann1, fAnn1 :: FieldAnn
fAnn1) : fields :: [(T, TypeAnn, FieldAnn)]
fields -> do
        T
rightCombedT <- [(T, TypeAnn, FieldAnn)] -> Get T
go [(T, TypeAnn, FieldAnn)]
fields
        pure $ FieldAnn -> FieldAnn -> Type -> Type -> T
TPair FieldAnn
fAnn1 FieldAnn
forall k (a :: k). Annotation a
noAnn (T -> TypeAnn -> Type
Type T
t1 TypeAnn
t1Ann1) (T -> TypeAnn -> Type
Type T
rightCombedT TypeAnn
forall k (a :: k). Annotation a
noAnn)

decodeTOr :: Get T
decodeTOr :: Get T
decodeTOr = do
  (t1 :: T
t1, tAnn1 :: TypeAnn
tAnn1, fAnn1 :: FieldAnn
fAnn1) <- Get (T, TypeAnn, FieldAnn)
decodeTWithAnns
  (t2 :: T
t2, tAnn2 :: TypeAnn
tAnn2, fAnn2 :: FieldAnn
fAnn2) <- Get (T, TypeAnn, FieldAnn)
decodeTWithAnns
  T -> Get T
forall (f :: * -> *) a. Applicative f => a -> f a
pure (T -> Get T) -> T -> Get T
forall a b. (a -> b) -> a -> b
$ FieldAnn -> FieldAnn -> Type -> Type -> T
TOr FieldAnn
fAnn1 FieldAnn
fAnn2 (T -> TypeAnn -> Type
Type T
t1 TypeAnn
tAnn1) (T -> TypeAnn -> Type
Type T
t2 TypeAnn
tAnn2)

----------------------------------------------------------------------------
-- Annotations
----------------------------------------------------------------------------

-- | Utility function to fill a constructor with an empty annotation
decodeNoAnn :: forall (t :: Kind.Type). Get (Annotation t)
decodeNoAnn :: Get (Annotation t)
decodeNoAnn = Annotation t -> Get (Annotation t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Annotation t
forall k (a :: k). Annotation a
noAnn

-- | Decodes an annotations' string and uses the provided `Parser` to parse
-- untyped annotations from it. This has to produce at least one annotation
-- (Annotations' String parsing will fail otherwise)
decodeAnns :: Parser a -> Get a
decodeAnns :: Parser a -> Get a
decodeAnns annsParser :: Parser a
annsParser = do
  Int
l <- Get Int
decodeLength Get Int -> String -> Get Int
forall a. Get a -> String -> Get a
? "Annotations' String length"
  [Word8]
ss <- Int -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
l Get Word8
Get.getWord8 Get [Word8] -> String -> Get [Word8]
forall a. Get a -> String -> Get a
? "Annotations' String content"
  Text
s <- ByteString -> Either UnicodeException Text
decodeUtf8' ([Word8] -> ByteString
BS.pack [Word8]
ss)
    Either UnicodeException Text
-> (Either UnicodeException Text -> Get Text) -> Get Text
forall a b. a -> (a -> b) -> b
& (UnicodeException -> Get Text)
-> (Text -> Get Text) -> Either UnicodeException Text -> Get Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Get Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Text)
-> (UnicodeException -> String) -> UnicodeException -> Get Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> String
forall b a. (Show a, IsString b) => a -> b
show) Text -> Get Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Get Text -> String -> Get Text
forall a. Get a -> String -> Get a
? "Annotations' String UTF-8 decoding"
  (ParseErrorBundle Text CustomParserException -> Get a)
-> (a -> Get a)
-> Either (ParseErrorBundle Text CustomParserException) a
-> Get a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get a)
-> (ParseErrorBundle Text CustomParserException -> String)
-> ParseErrorBundle Text CustomParserException
-> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserException -> String
forall e. Exception e => e -> String
displayException (ParserException -> String)
-> (ParseErrorBundle Text CustomParserException -> ParserException)
-> ParseErrorBundle Text CustomParserException
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text CustomParserException -> ParserException
ParserException) a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ParseErrorBundle Text CustomParserException) a -> Get a)
-> Either (ParseErrorBundle Text CustomParserException) a -> Get a
forall a b. (a -> b) -> a -> b
$ Parser a
-> String
-> Text
-> Either (ParseErrorBundle Text CustomParserException) a
forall a.
Parser a
-> String
-> Text
-> Either (ParseErrorBundle Text CustomParserException) a
parseNoEnv Parser a
annsParser "" Text
s

decodeVAnn :: Get VarAnn
decodeVAnn :: Get (Annotation VarTag)
decodeVAnn = Parser (Annotation VarTag) -> Get (Annotation VarTag)
forall a. Parser a -> Get a
decodeAnns Parser (Annotation VarTag)
PA.noteV

decodeVAnnDef :: Get VarAnn
decodeVAnnDef :: Get (Annotation VarTag)
decodeVAnnDef = Parser (Annotation VarTag) -> Get (Annotation VarTag)
forall a. Parser a -> Get a
decodeAnns Parser (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
PA.noteDef

decodeWithTVAnns :: (TypeAnn -> VarAnn -> a) -> Get a
decodeWithTVAnns :: (TypeAnn -> Annotation VarTag -> a) -> Get a
decodeWithTVAnns f :: TypeAnn -> Annotation VarTag -> a
f = do
  (tAnn :: TypeAnn
tAnn, vAnn :: Annotation VarTag
vAnn) <- Parser (TypeAnn, Annotation VarTag)
-> Get (TypeAnn, Annotation VarTag)
forall a. Parser a -> Get a
decodeAnns Parser (TypeAnn, Annotation VarTag)
PA.notesTV
  a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ TypeAnn -> Annotation VarTag -> a
f TypeAnn
tAnn Annotation VarTag
vAnn

decodeWithTVF2Anns :: (TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> a) -> Get a
decodeWithTVF2Anns :: (TypeAnn -> Annotation VarTag -> FieldAnn -> FieldAnn -> a)
-> Get a
decodeWithTVF2Anns f :: TypeAnn -> Annotation VarTag -> FieldAnn -> FieldAnn -> a
f = do
  (tAnn :: TypeAnn
tAnn, vAnn :: Annotation VarTag
vAnn, (fAnn1 :: FieldAnn
fAnn1, fAnn2 :: FieldAnn
fAnn2)) <- Parser (TypeAnn, Annotation VarTag, (FieldAnn, FieldAnn))
-> Get (TypeAnn, Annotation VarTag, (FieldAnn, FieldAnn))
forall a. Parser a -> Get a
decodeAnns Parser (TypeAnn, Annotation VarTag, (FieldAnn, FieldAnn))
PA.notesTVF2Def
  a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ TypeAnn -> Annotation VarTag -> FieldAnn -> FieldAnn -> a
f TypeAnn
tAnn Annotation VarTag
vAnn FieldAnn
fAnn1 FieldAnn
fAnn2

decodeWithTFAnns :: (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns :: (TypeAnn -> FieldAnn -> a) -> Get a
decodeWithTFAnns f :: TypeAnn -> FieldAnn -> a
f =  do
  (tAnn :: TypeAnn
tAnn, fAnn :: FieldAnn
fAnn) <- Parser (TypeAnn, FieldAnn) -> Get (TypeAnn, FieldAnn)
forall a. Parser a -> Get a
decodeAnns Parser (TypeAnn, FieldAnn)
PA.notesTF
  a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ TypeAnn -> FieldAnn -> a
f TypeAnn
tAnn FieldAnn
fAnn

decodeWithV2Anns :: (VarAnn -> VarAnn -> a) -> Get a
decodeWithV2Anns :: (Annotation VarTag -> Annotation VarTag -> a) -> Get a
decodeWithV2Anns f :: Annotation VarTag -> Annotation VarTag -> a
f = do
  (vAnn1 :: Annotation VarTag
vAnn1, vAnn2 :: Annotation VarTag
vAnn2) <- Parser (Annotation VarTag, Annotation VarTag)
-> Get (Annotation VarTag, Annotation VarTag)
forall a. Parser a -> Get a
decodeAnns Parser (Annotation VarTag, Annotation VarTag)
PA.noteV2Def
  a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ Annotation VarTag -> Annotation VarTag -> a
f Annotation VarTag
vAnn1 Annotation VarTag
vAnn2

decodeWithVFAnns :: (VarAnn -> FieldAnn -> a) -> Get a
decodeWithVFAnns :: (Annotation VarTag -> FieldAnn -> a) -> Get a
decodeWithVFAnns f :: Annotation VarTag -> FieldAnn -> a
f = do
  (vAnn :: Annotation VarTag
vAnn, fAnn :: FieldAnn
fAnn) <- Parser (Annotation VarTag, FieldAnn)
-> Get (Annotation VarTag, FieldAnn)
forall a. Parser a -> Get a
decodeAnns Parser (Annotation VarTag, FieldAnn)
PA.notesVF
  a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ Annotation VarTag -> FieldAnn -> a
f Annotation VarTag
vAnn FieldAnn
fAnn