-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Module, containing function to interpret Michelson
-- instructions against given context and input stack.
module Morley.Michelson.Interpret
  ( ContractEnv
  , ContractEnv' (..)
  , InterpreterState (..)
  , MichelsonFailed (..)
  , MichelsonFailureWithStack(..)
  , RemainingSteps (..)
  , SomeItStack (..)
  , MorleyLogs (..)
  , buildMorleyLogs
  , MorleyLogsBuilder (..)

  , interpret
  , interpretInstr
  , interpretInstrAnnotated
  , InterpretReturn
  , ContractReturn
  , RunEvalOpReturn
  , ResultStateLogs(..)

  , mkInitStack
  , InterpretError (..)
  , InterpretResult
  , ContractResult
  , extractValOps
  , EvalM
  , EvalM'
  , InterpreterStateMonad (..)
  , StkEl (.., StkEl)
  , NoStkElMeta(..)
  , seValueL
  , seMetaL
  , InstrRunner
  , runInstr
  , runInstrNoGas
  , runUnpack

    -- * Views
  , ViewLookupError (..)
  , interpretView
  , getViewByName
  , getViewByNameAndType

    -- * Internals
  , initInterpreterState
  , handleReturn
  , runEvalOp
  , runInstrImpl
  , assignBigMapIds
  , mapToStkEl
  , mapToValue
  , mkStkEl
  , mkDuplicateStkEl
  , runEvalOpT
  , interpret'
  , interpretView'
  , StkElMeta(..)
  , EvalOpT (..)
  , EvalOp

    -- * Prisms
  , _MorleyLogs
  ) where

import Prelude hiding (EQ, GT, LT)

import Control.Lens (makeLensesFor, makePrisms, (<<+=))
import Control.Monad.Except (MonadError, liftEither, throwError)
import Control.Monad.RWS.Strict (RWST, runRWST)
import Control.Monad.Writer (MonadWriter, WriterT, tell)
import Data.Default (Default(..))
import Data.GADT.Compare (GEq(..))
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Singletons (demote)
import Data.Singletons.Decide (decideEquality)
import Data.Vinyl (Rec(..), (<+>))
import Data.Vinyl.Recursive (rmap, rtraverse)
import Fmt
  (Buildable(build), blockListF, nameF, pretty, quoteOrIndentF, (++|), (+|), (|+), (|++), (|++^))
import Unsafe qualified (fromIntegral)

import Morley.Michelson.ErrorPos
import Morley.Michelson.Interpret.Pack (packValue')
import Morley.Michelson.Interpret.Unpack (UnpackError, unpackValue')
import Morley.Michelson.Runtime.GState
import Morley.Michelson.TypeCheck (eqType)
import Morley.Michelson.Typed hiding (Branch(..))
import Morley.Michelson.Typed.Instr.Constraints
import Morley.Michelson.Typed.Operation
  (OperationHash(..), OriginationOperation(..), mkContractAddress, mkOriginationOperationHash)
import Morley.Michelson.Untyped (unAnnotation)
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core (ChainId, Mutez, Timestamp, zeroMutez)
import Morley.Tezos.Crypto
  (KeyHash, OpeningResult(..), blake2b, checkSignature, hashKey, keccak, mkTLTime, openChest,
  sha256, sha3, sha512)
import Morley.Tezos.Crypto.BLS12381 (checkPairing)
import Morley.Util.Lens
import Morley.Util.MismatchError
import Morley.Util.Peano (LongerThan, Peano)
import Morley.Util.PeanoNatural (PeanoNatural(..))
import Morley.Util.Sing (eqParamSing)
import Morley.Util.Typeable

{- $setup
>>> import Morley.Michelson.ErrorPos
>>> import Morley.Michelson.Typed
>>> import Fmt (pretty)
-}

-- | Morley logs appearing as interpreter result.
newtype MorleyLogs = MorleyLogs { MorleyLogs -> [Text]
unMorleyLogs :: [Text] }
  deriving stock (Int -> MorleyLogs -> ShowS
[MorleyLogs] -> ShowS
MorleyLogs -> String
(Int -> MorleyLogs -> ShowS)
-> (MorleyLogs -> String)
-> ([MorleyLogs] -> ShowS)
-> Show MorleyLogs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MorleyLogs -> ShowS
showsPrec :: Int -> MorleyLogs -> ShowS
$cshow :: MorleyLogs -> String
show :: MorleyLogs -> String
$cshowList :: [MorleyLogs] -> ShowS
showList :: [MorleyLogs] -> ShowS
Show, MorleyLogs -> MorleyLogs -> Bool
(MorleyLogs -> MorleyLogs -> Bool)
-> (MorleyLogs -> MorleyLogs -> Bool) -> Eq MorleyLogs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MorleyLogs -> MorleyLogs -> Bool
== :: MorleyLogs -> MorleyLogs -> Bool
$c/= :: MorleyLogs -> MorleyLogs -> Bool
/= :: MorleyLogs -> MorleyLogs -> Bool
Eq, (forall x. MorleyLogs -> Rep MorleyLogs x)
-> (forall x. Rep MorleyLogs x -> MorleyLogs) -> Generic MorleyLogs
forall x. Rep MorleyLogs x -> MorleyLogs
forall x. MorleyLogs -> Rep MorleyLogs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MorleyLogs -> Rep MorleyLogs x
from :: forall x. MorleyLogs -> Rep MorleyLogs x
$cto :: forall x. Rep MorleyLogs x -> MorleyLogs
to :: forall x. Rep MorleyLogs x -> MorleyLogs
Generic)
  deriving newtype (NonEmpty MorleyLogs -> MorleyLogs
MorleyLogs -> MorleyLogs -> MorleyLogs
(MorleyLogs -> MorleyLogs -> MorleyLogs)
-> (NonEmpty MorleyLogs -> MorleyLogs)
-> (forall b. Integral b => b -> MorleyLogs -> MorleyLogs)
-> Semigroup MorleyLogs
forall b. Integral b => b -> MorleyLogs -> MorleyLogs
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: MorleyLogs -> MorleyLogs -> MorleyLogs
<> :: MorleyLogs -> MorleyLogs -> MorleyLogs
$csconcat :: NonEmpty MorleyLogs -> MorleyLogs
sconcat :: NonEmpty MorleyLogs -> MorleyLogs
$cstimes :: forall b. Integral b => b -> MorleyLogs -> MorleyLogs
stimes :: forall b. Integral b => b -> MorleyLogs -> MorleyLogs
Semigroup, Semigroup MorleyLogs
MorleyLogs
Semigroup MorleyLogs
-> MorleyLogs
-> (MorleyLogs -> MorleyLogs -> MorleyLogs)
-> ([MorleyLogs] -> MorleyLogs)
-> Monoid MorleyLogs
[MorleyLogs] -> MorleyLogs
MorleyLogs -> MorleyLogs -> MorleyLogs
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: MorleyLogs
mempty :: MorleyLogs
$cmappend :: MorleyLogs -> MorleyLogs -> MorleyLogs
mappend :: MorleyLogs -> MorleyLogs -> MorleyLogs
$cmconcat :: [MorleyLogs] -> MorleyLogs
mconcat :: [MorleyLogs] -> MorleyLogs
Monoid)
  deriving anyclass (MorleyLogs -> ()
(MorleyLogs -> ()) -> NFData MorleyLogs
forall a. (a -> ()) -> NFData a
$crnf :: MorleyLogs -> ()
rnf :: MorleyLogs -> ()
NFData)

instance Buildable MorleyLogs where
  build :: MorleyLogs -> Doc
build = [Text] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
blockListF ([Text] -> Doc) -> (MorleyLogs -> [Text]) -> MorleyLogs -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MorleyLogs -> [Text]
unMorleyLogs

-- | Morley logs accumulator, for incremental building.
newtype MorleyLogsBuilder = MorleyLogsBuilder (Endo [Text])
  deriving stock ((forall x. MorleyLogsBuilder -> Rep MorleyLogsBuilder x)
-> (forall x. Rep MorleyLogsBuilder x -> MorleyLogsBuilder)
-> Generic MorleyLogsBuilder
forall x. Rep MorleyLogsBuilder x -> MorleyLogsBuilder
forall x. MorleyLogsBuilder -> Rep MorleyLogsBuilder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MorleyLogsBuilder -> Rep MorleyLogsBuilder x
from :: forall x. MorleyLogsBuilder -> Rep MorleyLogsBuilder x
$cto :: forall x. Rep MorleyLogsBuilder x -> MorleyLogsBuilder
to :: forall x. Rep MorleyLogsBuilder x -> MorleyLogsBuilder
Generic)
  deriving newtype (MorleyLogsBuilder
MorleyLogsBuilder -> Default MorleyLogsBuilder
forall a. a -> Default a
$cdef :: MorleyLogsBuilder
def :: MorleyLogsBuilder
Default, NonEmpty MorleyLogsBuilder -> MorleyLogsBuilder
MorleyLogsBuilder -> MorleyLogsBuilder -> MorleyLogsBuilder
(MorleyLogsBuilder -> MorleyLogsBuilder -> MorleyLogsBuilder)
-> (NonEmpty MorleyLogsBuilder -> MorleyLogsBuilder)
-> (forall b.
    Integral b =>
    b -> MorleyLogsBuilder -> MorleyLogsBuilder)
-> Semigroup MorleyLogsBuilder
forall b. Integral b => b -> MorleyLogsBuilder -> MorleyLogsBuilder
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: MorleyLogsBuilder -> MorleyLogsBuilder -> MorleyLogsBuilder
<> :: MorleyLogsBuilder -> MorleyLogsBuilder -> MorleyLogsBuilder
$csconcat :: NonEmpty MorleyLogsBuilder -> MorleyLogsBuilder
sconcat :: NonEmpty MorleyLogsBuilder -> MorleyLogsBuilder
$cstimes :: forall b. Integral b => b -> MorleyLogsBuilder -> MorleyLogsBuilder
stimes :: forall b. Integral b => b -> MorleyLogsBuilder -> MorleyLogsBuilder
Semigroup, Semigroup MorleyLogsBuilder
MorleyLogsBuilder
Semigroup MorleyLogsBuilder
-> MorleyLogsBuilder
-> (MorleyLogsBuilder -> MorleyLogsBuilder -> MorleyLogsBuilder)
-> ([MorleyLogsBuilder] -> MorleyLogsBuilder)
-> Monoid MorleyLogsBuilder
[MorleyLogsBuilder] -> MorleyLogsBuilder
MorleyLogsBuilder -> MorleyLogsBuilder -> MorleyLogsBuilder
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: MorleyLogsBuilder
mempty :: MorleyLogsBuilder
$cmappend :: MorleyLogsBuilder -> MorleyLogsBuilder -> MorleyLogsBuilder
mappend :: MorleyLogsBuilder -> MorleyLogsBuilder -> MorleyLogsBuilder
$cmconcat :: [MorleyLogsBuilder] -> MorleyLogsBuilder
mconcat :: [MorleyLogsBuilder] -> MorleyLogsBuilder
Monoid)

buildMorleyLogs :: MorleyLogsBuilder -> MorleyLogs
buildMorleyLogs :: MorleyLogsBuilder -> MorleyLogs
buildMorleyLogs (MorleyLogsBuilder Endo [Text]
builder) =
  [Text] -> MorleyLogs
MorleyLogs ([Text] -> MorleyLogs) -> [Text] -> MorleyLogs
forall a b. (a -> b) -> a -> b
$ Endo [Text] -> [Text] -> [Text]
forall a. Endo a -> a -> a
appEndo Endo [Text]
builder []

instance One MorleyLogsBuilder where
  type OneItem MorleyLogsBuilder = Text
  one :: OneItem MorleyLogsBuilder -> MorleyLogsBuilder
one OneItem MorleyLogsBuilder
log = Endo [Text] -> MorleyLogsBuilder
MorleyLogsBuilder (Endo [Text] -> MorleyLogsBuilder)
-> Endo [Text] -> MorleyLogsBuilder
forall a b. (a -> b) -> a -> b
$ ([Text] -> [Text]) -> Endo [Text]
forall a. (a -> a) -> Endo a
Endo (Text
OneItem MorleyLogsBuilder
log Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)

newtype RemainingSteps = RemainingSteps Word64
  deriving stock (Int -> RemainingSteps -> ShowS
[RemainingSteps] -> ShowS
RemainingSteps -> String
(Int -> RemainingSteps -> ShowS)
-> (RemainingSteps -> String)
-> ([RemainingSteps] -> ShowS)
-> Show RemainingSteps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemainingSteps -> ShowS
showsPrec :: Int -> RemainingSteps -> ShowS
$cshow :: RemainingSteps -> String
show :: RemainingSteps -> String
$cshowList :: [RemainingSteps] -> ShowS
showList :: [RemainingSteps] -> ShowS
Show, (forall x. RemainingSteps -> Rep RemainingSteps x)
-> (forall x. Rep RemainingSteps x -> RemainingSteps)
-> Generic RemainingSteps
forall x. Rep RemainingSteps x -> RemainingSteps
forall x. RemainingSteps -> Rep RemainingSteps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemainingSteps -> Rep RemainingSteps x
from :: forall x. RemainingSteps -> Rep RemainingSteps x
$cto :: forall x. Rep RemainingSteps x -> RemainingSteps
to :: forall x. Rep RemainingSteps x -> RemainingSteps
Generic)
  deriving newtype (RemainingSteps -> RemainingSteps -> Bool
(RemainingSteps -> RemainingSteps -> Bool)
-> (RemainingSteps -> RemainingSteps -> Bool) -> Eq RemainingSteps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemainingSteps -> RemainingSteps -> Bool
== :: RemainingSteps -> RemainingSteps -> Bool
$c/= :: RemainingSteps -> RemainingSteps -> Bool
/= :: RemainingSteps -> RemainingSteps -> Bool
Eq, Eq RemainingSteps
Eq RemainingSteps
-> (RemainingSteps -> RemainingSteps -> Ordering)
-> (RemainingSteps -> RemainingSteps -> Bool)
-> (RemainingSteps -> RemainingSteps -> Bool)
-> (RemainingSteps -> RemainingSteps -> Bool)
-> (RemainingSteps -> RemainingSteps -> Bool)
-> (RemainingSteps -> RemainingSteps -> RemainingSteps)
-> (RemainingSteps -> RemainingSteps -> RemainingSteps)
-> Ord RemainingSteps
RemainingSteps -> RemainingSteps -> Bool
RemainingSteps -> RemainingSteps -> Ordering
RemainingSteps -> RemainingSteps -> RemainingSteps
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RemainingSteps -> RemainingSteps -> Ordering
compare :: RemainingSteps -> RemainingSteps -> Ordering
$c< :: RemainingSteps -> RemainingSteps -> Bool
< :: RemainingSteps -> RemainingSteps -> Bool
$c<= :: RemainingSteps -> RemainingSteps -> Bool
<= :: RemainingSteps -> RemainingSteps -> Bool
$c> :: RemainingSteps -> RemainingSteps -> Bool
> :: RemainingSteps -> RemainingSteps -> Bool
$c>= :: RemainingSteps -> RemainingSteps -> Bool
>= :: RemainingSteps -> RemainingSteps -> Bool
$cmax :: RemainingSteps -> RemainingSteps -> RemainingSteps
max :: RemainingSteps -> RemainingSteps -> RemainingSteps
$cmin :: RemainingSteps -> RemainingSteps -> RemainingSteps
min :: RemainingSteps -> RemainingSteps -> RemainingSteps
Ord, [RemainingSteps] -> Doc
RemainingSteps -> Doc
(RemainingSteps -> Doc)
-> ([RemainingSteps] -> Doc) -> Buildable RemainingSteps
forall a. (a -> Doc) -> ([a] -> Doc) -> Buildable a
$cbuild :: RemainingSteps -> Doc
build :: RemainingSteps -> Doc
$cbuildList :: [RemainingSteps] -> Doc
buildList :: [RemainingSteps] -> Doc
Buildable, Integer -> RemainingSteps
RemainingSteps -> RemainingSteps
RemainingSteps -> RemainingSteps -> RemainingSteps
(RemainingSteps -> RemainingSteps -> RemainingSteps)
-> (RemainingSteps -> RemainingSteps -> RemainingSteps)
-> (RemainingSteps -> RemainingSteps -> RemainingSteps)
-> (RemainingSteps -> RemainingSteps)
-> (RemainingSteps -> RemainingSteps)
-> (RemainingSteps -> RemainingSteps)
-> (Integer -> RemainingSteps)
-> Num RemainingSteps
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: RemainingSteps -> RemainingSteps -> RemainingSteps
+ :: RemainingSteps -> RemainingSteps -> RemainingSteps
$c- :: RemainingSteps -> RemainingSteps -> RemainingSteps
- :: RemainingSteps -> RemainingSteps -> RemainingSteps
$c* :: RemainingSteps -> RemainingSteps -> RemainingSteps
* :: RemainingSteps -> RemainingSteps -> RemainingSteps
$cnegate :: RemainingSteps -> RemainingSteps
negate :: RemainingSteps -> RemainingSteps
$cabs :: RemainingSteps -> RemainingSteps
abs :: RemainingSteps -> RemainingSteps
$csignum :: RemainingSteps -> RemainingSteps
signum :: RemainingSteps -> RemainingSteps
$cfromInteger :: Integer -> RemainingSteps
fromInteger :: Integer -> RemainingSteps
Num)

instance NFData RemainingSteps

data InterpreterState = InterpreterState
  { InterpreterState -> RemainingSteps
isRemainingSteps :: RemainingSteps
  , InterpreterState -> GlobalCounter
isGlobalCounter :: GlobalCounter
  , InterpreterState -> BigMapCounter
isBigMapCounter :: BigMapCounter
  } deriving stock (Int -> InterpreterState -> ShowS
[InterpreterState] -> ShowS
InterpreterState -> String
(Int -> InterpreterState -> ShowS)
-> (InterpreterState -> String)
-> ([InterpreterState] -> ShowS)
-> Show InterpreterState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InterpreterState -> ShowS
showsPrec :: Int -> InterpreterState -> ShowS
$cshow :: InterpreterState -> String
show :: InterpreterState -> String
$cshowList :: [InterpreterState] -> ShowS
showList :: [InterpreterState] -> ShowS
Show, (forall x. InterpreterState -> Rep InterpreterState x)
-> (forall x. Rep InterpreterState x -> InterpreterState)
-> Generic InterpreterState
forall x. Rep InterpreterState x -> InterpreterState
forall x. InterpreterState -> Rep InterpreterState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InterpreterState -> Rep InterpreterState x
from :: forall x. InterpreterState -> Rep InterpreterState x
$cto :: forall x. Rep InterpreterState x -> InterpreterState
to :: forall x. Rep InterpreterState x -> InterpreterState
Generic)

instance NFData InterpreterState
makeLensesFor
  [ ("isBigMapCounter", "isBigMapCounterL")
  ]
  ''InterpreterState

makePrisms ''MorleyLogs

-- | Represents a value on the stack. Aside from the value itself, it contains
-- arbitrary user-defined metadata. The metadata in question is defined by
-- 'StkElMeta' type class, the interpreter doesn't know anything about it.
--
-- The metadata should not be copied between different stack elements, the only
-- case where it can be copied is when the stack element is copied in its
-- entirety, i.e. when running instructions like @DUP@.
--
-- To create a new t'StkEl' from a value, 'mkStkEl' should always be used. For
-- duplicated stack elements, 'mkDuplicateStkEl' should be used instead, to
-- still give the user an option to override metadata for the duplicated
-- element.
--
-- The data constructor should almost never be used by itself.
data StkEl meta t = MkStkEl
  { forall (meta :: T -> *) (t :: T). StkEl meta t -> meta t
seMeta :: meta t
  , forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue :: Value t
  } deriving stock (StkEl meta t -> StkEl meta t -> Bool
(StkEl meta t -> StkEl meta t -> Bool)
-> (StkEl meta t -> StkEl meta t -> Bool) -> Eq (StkEl meta t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (meta :: T -> *) (t :: T).
Eq (meta t) =>
StkEl meta t -> StkEl meta t -> Bool
$c== :: forall (meta :: T -> *) (t :: T).
Eq (meta t) =>
StkEl meta t -> StkEl meta t -> Bool
== :: StkEl meta t -> StkEl meta t -> Bool
$c/= :: forall (meta :: T -> *) (t :: T).
Eq (meta t) =>
StkEl meta t -> StkEl meta t -> Bool
/= :: StkEl meta t -> StkEl meta t -> Bool
Eq, Int -> StkEl meta t -> ShowS
[StkEl meta t] -> ShowS
StkEl meta t -> String
(Int -> StkEl meta t -> ShowS)
-> (StkEl meta t -> String)
-> ([StkEl meta t] -> ShowS)
-> Show (StkEl meta t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (meta :: T -> *) (t :: T).
Show (meta t) =>
Int -> StkEl meta t -> ShowS
forall (meta :: T -> *) (t :: T).
Show (meta t) =>
[StkEl meta t] -> ShowS
forall (meta :: T -> *) (t :: T).
Show (meta t) =>
StkEl meta t -> String
$cshowsPrec :: forall (meta :: T -> *) (t :: T).
Show (meta t) =>
Int -> StkEl meta t -> ShowS
showsPrec :: Int -> StkEl meta t -> ShowS
$cshow :: forall (meta :: T -> *) (t :: T).
Show (meta t) =>
StkEl meta t -> String
show :: StkEl meta t -> String
$cshowList :: forall (meta :: T -> *) (t :: T).
Show (meta t) =>
[StkEl meta t] -> ShowS
showList :: [StkEl meta t] -> ShowS
Show)

makeLensesWith postfixLFields ''StkEl

instance (forall t. Eq (meta t)) => GEq (StkEl meta) where
  geq :: forall (a :: T) (b :: T).
StkEl meta a -> StkEl meta b -> Maybe (a :~: b)
geq StkEl meta a
se1 StkEl meta b
se2
    | Just a :~: b
Refl <- Value' Instr a -> Value' Instr b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: T) (b :: T).
Value' Instr a -> Value' Instr b -> Maybe (a :~: b)
geq (StkEl meta a -> Value' Instr a
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta a
se1) (StkEl meta b -> Value' Instr b
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta b
se2)
    , StkEl meta a -> meta a
forall (meta :: T -> *) (t :: T). StkEl meta t -> meta t
seMeta StkEl meta a
se1 meta a -> meta a -> Bool
forall a. Eq a => a -> a -> Bool
== StkEl meta a -> meta a
forall (meta :: T -> *) (t :: T). StkEl meta t -> meta t
seMeta StkEl meta a
StkEl meta b
se2
    = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
    | Bool
otherwise = Maybe (a :~: b)
forall a. Maybe a
Nothing

-- | Arbitrary stack element metadata that can be constructed in a particular
-- monad. Interpreter doesn't know anything about metadata, and doesn't try to
-- do anything with it. 'mkStkElMeta' describes how to construct metadata for
-- new stack elements based on its value. When a stack element is duplicated,
-- specifically with instructions like @DUP@, old metadata is passed to
-- 'mkStkElMeta' to provide an opportunity to modify it. Implementation is free
-- to either copy it verbatim or ignore the old and generate new.
--
-- See t'StkEl' documentation for an overview of the motivation and design.
type StkElMeta :: (T -> Type) -> (Type -> Type) -> Constraint
class (forall t. Eq (meta t), forall t. Show (meta t)) => StkElMeta meta m where
  -- | How to construct new metadata.
  mkStkElMeta
    :: Maybe (meta t)
    -- ^ For instructions duplicating the value, this @Just meta@ from the
    -- original instruction, @Nothing@ otherwise
    -> Value t
    -- ^ The value for the new stack element.
    -> m (meta t)

-- | Default metadata that does nothing.
data NoStkElMeta t = NoStkElMeta
  deriving stock (NoStkElMeta t -> NoStkElMeta t -> Bool
(NoStkElMeta t -> NoStkElMeta t -> Bool)
-> (NoStkElMeta t -> NoStkElMeta t -> Bool) -> Eq (NoStkElMeta t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (t :: k). NoStkElMeta t -> NoStkElMeta t -> Bool
$c== :: forall k (t :: k). NoStkElMeta t -> NoStkElMeta t -> Bool
== :: NoStkElMeta t -> NoStkElMeta t -> Bool
$c/= :: forall k (t :: k). NoStkElMeta t -> NoStkElMeta t -> Bool
/= :: NoStkElMeta t -> NoStkElMeta t -> Bool
Eq, Int -> NoStkElMeta t -> ShowS
[NoStkElMeta t] -> ShowS
NoStkElMeta t -> String
(Int -> NoStkElMeta t -> ShowS)
-> (NoStkElMeta t -> String)
-> ([NoStkElMeta t] -> ShowS)
-> Show (NoStkElMeta t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k). Int -> NoStkElMeta t -> ShowS
forall k (t :: k). [NoStkElMeta t] -> ShowS
forall k (t :: k). NoStkElMeta t -> String
$cshowsPrec :: forall k (t :: k). Int -> NoStkElMeta t -> ShowS
showsPrec :: Int -> NoStkElMeta t -> ShowS
$cshow :: forall k (t :: k). NoStkElMeta t -> String
show :: NoStkElMeta t -> String
$cshowList :: forall k (t :: k). [NoStkElMeta t] -> ShowS
showList :: [NoStkElMeta t] -> ShowS
Show)

instance Applicative m => StkElMeta NoStkElMeta m where
  mkStkElMeta :: forall (t :: T).
Maybe (NoStkElMeta t) -> Value t -> m (NoStkElMeta t)
mkStkElMeta Maybe (NoStkElMeta t)
_ Value t
_ = NoStkElMeta t -> m (NoStkElMeta t)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoStkElMeta t
forall {k} (t :: k). NoStkElMeta t
NoStkElMeta

-- | Make an entirely new t'StkEl' from a value.
mkStkEl :: forall meta t m. (Applicative m, StkElMeta meta m) => Value t -> m (StkEl meta t)
mkStkEl :: forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value t
val = (meta t -> Value t -> StkEl meta t)
-> Value t -> meta t -> StkEl meta t
forall a b c. (a -> b -> c) -> b -> a -> c
flip meta t -> Value t -> StkEl meta t
forall (meta :: T -> *) (t :: T). meta t -> Value t -> StkEl meta t
MkStkEl Value t
val (meta t -> StkEl meta t) -> m (meta t) -> m (StkEl meta t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (meta t) -> Value t -> m (meta t)
forall (t :: T). Maybe (meta t) -> Value t -> m (meta t)
forall (meta :: T -> *) (m :: * -> *) (t :: T).
StkElMeta meta m =>
Maybe (meta t) -> Value t -> m (meta t)
mkStkElMeta Maybe (meta t)
forall a. Maybe a
Nothing Value t
val

-- | Make a duplicate t'StkEl', constructing metadata via 'mkStkElMeta'.
mkDuplicateStkEl
  :: forall meta t m. (Applicative m, StkElMeta meta m)
  => StkEl meta t -> m (StkEl meta t)
mkDuplicateStkEl :: forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
StkEl meta t -> m (StkEl meta t)
mkDuplicateStkEl MkStkEl{meta t
Value t
seMeta :: forall (meta :: T -> *) (t :: T). StkEl meta t -> meta t
seValue :: forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seMeta :: meta t
seValue :: Value t
..} = (meta t -> Value t -> StkEl meta t)
-> Value t -> meta t -> StkEl meta t
forall a b c. (a -> b -> c) -> b -> a -> c
flip meta t -> Value t -> StkEl meta t
forall (meta :: T -> *) (t :: T). meta t -> Value t -> StkEl meta t
MkStkEl Value t
seValue (meta t -> StkEl meta t) -> m (meta t) -> m (StkEl meta t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (meta t) -> Value t -> m (meta t)
forall (t :: T). Maybe (meta t) -> Value t -> m (meta t)
forall (meta :: T -> *) (m :: * -> *) (t :: T).
StkElMeta meta m =>
Maybe (meta t) -> Value t -> m (meta t)
mkStkElMeta (meta t -> Maybe (meta t)
forall a. a -> Maybe a
Just meta t
seMeta) Value t
seValue

pattern StkEl :: Value t -> StkEl meta t
pattern $mStkEl :: forall {r} {t :: T} {meta :: T -> *}.
StkEl meta t -> (Value t -> r) -> ((# #) -> r) -> r
StkEl x <- MkStkEl _ x
{-# COMPLETE StkEl #-}

-- | Helper function to convert a record of @Value@ to @StkEl@.
mapToStkEl
  :: forall meta inp m. (Applicative m, StkElMeta meta m)
  => Rec Value inp -> m (Rec (StkEl meta) inp)
mapToStkEl :: forall (meta :: T -> *) (inp :: [T]) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Rec (Value' Instr) inp -> m (Rec (StkEl meta) inp)
mapToStkEl = (forall (x :: T). Value x -> m (StkEl meta x))
-> Rec (Value' Instr) inp -> m (Rec (StkEl meta) inp)
forall {u} (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]).
Applicative h =>
(forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs)
rtraverse ((forall (x :: T). Value x -> m (StkEl meta x))
 -> Rec (Value' Instr) inp -> m (Rec (StkEl meta) inp))
-> (forall (x :: T). Value x -> m (StkEl meta x))
-> Rec (Value' Instr) inp
-> m (Rec (StkEl meta) inp)
forall a b. (a -> b) -> a -> b
$ Value x -> m (StkEl meta x)
forall (x :: T). Value x -> m (StkEl meta x)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl

-- | Helper function to convert a record of @StkEl@ to @Value@.
mapToValue :: Rec (StkEl meta) inp -> Rec Value inp
mapToValue :: forall (meta :: T -> *) (inp :: [T]).
Rec (StkEl meta) inp -> Rec (Value' Instr) inp
mapToValue = (forall (x :: T). StkEl meta x -> Value x)
-> Rec (StkEl meta) inp -> Rec (Value' Instr) inp
forall {u} (f :: u -> *) (g :: u -> *) (rs :: [u]).
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap StkEl meta x -> Value x
forall (x :: T). StkEl meta x -> Value x
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue

type ContractEnv :: Type
type ContractEnv = ContractEnv' EvalOp

-- | Environment for contract execution. Parametrized by the execution monad,
-- i.e. 'EvalOp' by default, but downstream consumers may define their own if
-- using low-level runners.
data ContractEnv' m = ContractEnv
  { forall (m :: * -> *). ContractEnv' m -> Timestamp
ceNow :: Timestamp
  -- ^ Timestamp returned by the 'NOW' instruction.
  , forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceMaxSteps :: RemainingSteps
  -- ^ Number of steps after which execution unconditionally terminates.
  , forall (m :: * -> *). ContractEnv' m -> Mutez
ceBalance :: Mutez
  -- ^ Current amount of mutez of the current contract.
  , forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceContracts :: ContractAddress -> m (Maybe ContractState)
  -- ^ Information stored about the existing contracts.
  , forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSelf :: ContractAddress
  -- ^ Address of the interpreted contract.
  , forall (m :: * -> *). ContractEnv' m -> L1Address
ceSource :: L1Address
  -- ^ The contract that initiated the current transaction. Note that this
  -- contract should in normal operation be an implicit account.
  , forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: L1Address
  -- ^ The contract that initiated the current internal transaction. This may
  -- either be an implicit account or a smart contract.
  , forall (m :: * -> *). ContractEnv' m -> Mutez
ceAmount :: Mutez
  -- ^ Amount of the current transaction.
  , forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceVotingPowers :: VotingPowers
  -- ^ Distribution of voting power.
  , forall (m :: * -> *). ContractEnv' m -> ChainId
ceChainId :: ChainId
  -- ^ Identifier of the current chain.
  , forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceOperationHash :: Maybe OperationHash
  -- ^ Hash of the currently executed operation, required for
  -- correct contract address computation in @CREATE_CONTRACT@ instruction.
  , forall (m :: * -> *). ContractEnv' m -> Natural
ceLevel :: Natural
  -- ^ Number of blocks before the given one in the chain
  , forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceErrorSrcPos :: ErrorSrcPos
  -- ^ Current source position information
  , forall (m :: * -> *). ContractEnv' m -> Natural
ceMinBlockTime :: Natural
  -- ^ Minimum time between blocks
  , forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper :: forall i o. Instr i o -> Instr i o
  -- ^ Saves outer wrapping 'Meta' and 'WithLoc' while traversing the tree,
  -- used internally when reiterating on 'LOOP' and other similar instructions.
  -- If unsure, initialize it with 'id'.
  }

-- | Errors that can be thrown by the interpreter. The @ext@ type variable
-- allow the downstreams consumer to add additional exceptions.
data MichelsonFailed ext where
  MichelsonFailedWith :: (SingI t, ConstantScope t) => Value t -> MichelsonFailed ext
    -- ^ Represents @[FAILED]@ state of a Michelson program. Contains
    -- value that was on top of the stack when @FAILWITH@ was called.
  MichelsonArithError
    :: (Typeable n, Typeable m)
    => ArithError (Value n) (Value m) -> MichelsonFailed ext
  MichelsonGasExhaustion :: MichelsonFailed ext
  MichelsonFailedTestAssert :: Text -> MichelsonFailed ext
  MichelsonUnsupported :: Text -> MichelsonFailed ext
  MichelsonExt :: ext -> MichelsonFailed ext

deriving stock instance Show ext => Show (MichelsonFailed ext)

instance Eq ext => Eq (MichelsonFailed ext) where
  MichelsonFailedWith Value t
v1 == :: MichelsonFailed ext -> MichelsonFailed ext -> Bool
== MichelsonFailedWith Value t
v2 = Value t
v1 Value t -> Value t -> Bool
forall {k} (a1 :: k) (a2 :: k) (t :: k -> *).
(SingI a1, SingI a2, SDecide k, Eq (t a1)) =>
t a1 -> t a2 -> Bool
`eqParamSing` Value t
v2
  MichelsonFailedWith Value t
_ == MichelsonFailed ext
_ = Bool
False
  MichelsonArithError ArithError (Value n) (Value m)
ae1 == MichelsonArithError ArithError (Value n) (Value m)
ae2 = ArithError (Value n) (Value m)
ae1 ArithError (Value n) (Value m)
-> ArithError (Value n) (Value m) -> Bool
forall {k1} {k2} (a1 :: k1) (a2 :: k1) (b1 :: k2) (b2 :: k2)
       (t :: k1 -> k2 -> *).
(Typeable a1, Typeable a2, Typeable b1, Typeable b2,
 Eq (t a1 b2)) =>
t a1 b1 -> t a2 b2 -> Bool
`eqParam2` ArithError (Value n) (Value m)
ae2
  MichelsonArithError ArithError (Value n) (Value m)
_ == MichelsonFailed ext
_ = Bool
False
  MichelsonFailed ext
MichelsonGasExhaustion == MichelsonFailed ext
MichelsonGasExhaustion = Bool
True
  MichelsonFailed ext
MichelsonGasExhaustion == MichelsonFailed ext
_ = Bool
False
  MichelsonFailedTestAssert Text
t1 == MichelsonFailedTestAssert Text
t2 = Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t2
  MichelsonFailedTestAssert Text
_ == MichelsonFailed ext
_ = Bool
False
  MichelsonUnsupported Text
i1 == MichelsonUnsupported Text
i2 = Text
i1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
i2
  MichelsonUnsupported Text
_ == MichelsonFailed ext
_ = Bool
False
  MichelsonExt ext
i1 == MichelsonExt ext
i2 = ext
i1 ext -> ext -> Bool
forall a. Eq a => a -> a -> Bool
== ext
i2
  MichelsonExt ext
_ == MichelsonFailed ext
_ = Bool
False

instance Buildable ext => Buildable (MichelsonFailed ext) where
  build :: MichelsonFailed ext -> Doc
build =
    \case
      MichelsonFailedWith Value t
v ->
        Text
"Reached FAILWITH instruction with" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Value t -> Doc
forall a. Buildable a => a -> Doc
quoteOrIndentF Value t
v Doc -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++^ Doc
""
      MichelsonArithError ArithError (Value n) (Value m)
v -> ArithError (Value n) (Value m) -> Doc
forall a. Buildable a => a -> Doc
build ArithError (Value n) (Value m)
v
      MichelsonFailed ext
MichelsonGasExhaustion ->
        Doc
"Gas limit exceeded on contract execution"
      MichelsonFailedTestAssert Text
t -> Text -> Doc
forall a. Buildable a => a -> Doc
build Text
t
      MichelsonUnsupported Text
instr ->
        Text -> Doc
forall a. Buildable a => a -> Doc
build Text
instr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" instruction is not supported."
      MichelsonExt ext
x -> ext -> Doc
forall a. Buildable a => a -> Doc
build ext
x

-- | Carries a 'MichelsonFailed' @ext@ error and the 'ErrorSrcPos' at which it was raised
data MichelsonFailureWithStack ext = MichelsonFailureWithStack
  { forall ext. MichelsonFailureWithStack ext -> MichelsonFailed ext
mfwsFailed :: MichelsonFailed ext
  , forall ext. MichelsonFailureWithStack ext -> ErrorSrcPos
mfwsErrorSrcPos :: ErrorSrcPos
  } deriving stock (Int -> MichelsonFailureWithStack ext -> ShowS
[MichelsonFailureWithStack ext] -> ShowS
MichelsonFailureWithStack ext -> String
(Int -> MichelsonFailureWithStack ext -> ShowS)
-> (MichelsonFailureWithStack ext -> String)
-> ([MichelsonFailureWithStack ext] -> ShowS)
-> Show (MichelsonFailureWithStack ext)
forall ext.
Show ext =>
Int -> MichelsonFailureWithStack ext -> ShowS
forall ext. Show ext => [MichelsonFailureWithStack ext] -> ShowS
forall ext. Show ext => MichelsonFailureWithStack ext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ext.
Show ext =>
Int -> MichelsonFailureWithStack ext -> ShowS
showsPrec :: Int -> MichelsonFailureWithStack ext -> ShowS
$cshow :: forall ext. Show ext => MichelsonFailureWithStack ext -> String
show :: MichelsonFailureWithStack ext -> String
$cshowList :: forall ext. Show ext => [MichelsonFailureWithStack ext] -> ShowS
showList :: [MichelsonFailureWithStack ext] -> ShowS
Show, (forall x.
 MichelsonFailureWithStack ext
 -> Rep (MichelsonFailureWithStack ext) x)
-> (forall x.
    Rep (MichelsonFailureWithStack ext) x
    -> MichelsonFailureWithStack ext)
-> Generic (MichelsonFailureWithStack ext)
forall x.
Rep (MichelsonFailureWithStack ext) x
-> MichelsonFailureWithStack ext
forall x.
MichelsonFailureWithStack ext
-> Rep (MichelsonFailureWithStack ext) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ext x.
Rep (MichelsonFailureWithStack ext) x
-> MichelsonFailureWithStack ext
forall ext x.
MichelsonFailureWithStack ext
-> Rep (MichelsonFailureWithStack ext) x
$cfrom :: forall ext x.
MichelsonFailureWithStack ext
-> Rep (MichelsonFailureWithStack ext) x
from :: forall x.
MichelsonFailureWithStack ext
-> Rep (MichelsonFailureWithStack ext) x
$cto :: forall ext x.
Rep (MichelsonFailureWithStack ext) x
-> MichelsonFailureWithStack ext
to :: forall x.
Rep (MichelsonFailureWithStack ext) x
-> MichelsonFailureWithStack ext
Generic, MichelsonFailureWithStack ext
-> MichelsonFailureWithStack ext -> Bool
(MichelsonFailureWithStack ext
 -> MichelsonFailureWithStack ext -> Bool)
-> (MichelsonFailureWithStack ext
    -> MichelsonFailureWithStack ext -> Bool)
-> Eq (MichelsonFailureWithStack ext)
forall ext.
Eq ext =>
MichelsonFailureWithStack ext
-> MichelsonFailureWithStack ext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ext.
Eq ext =>
MichelsonFailureWithStack ext
-> MichelsonFailureWithStack ext -> Bool
== :: MichelsonFailureWithStack ext
-> MichelsonFailureWithStack ext -> Bool
$c/= :: forall ext.
Eq ext =>
MichelsonFailureWithStack ext
-> MichelsonFailureWithStack ext -> Bool
/= :: MichelsonFailureWithStack ext
-> MichelsonFailureWithStack ext -> Bool
Eq)

{- | Pretty-printer for 'MichelsonFailureWithStack'.

>>> let pos = ErrorSrcPos $ SrcPos (Pos 123) (Pos 456)
>>> let largeValue = VList $ replicate 10 VUnit

>>> pretty $ MichelsonFailureWithStack @Void MichelsonGasExhaustion pos
Gas limit exceeded on contract execution at line 124 char 457.

>>> pretty $ MichelsonFailureWithStack @Void (MichelsonFailedWith VUnit) pos
Reached FAILWITH instruction with 'Unit' at line 124 char 457.

>>> pretty $ MichelsonFailureWithStack @Void (MichelsonFailedWith largeValue) pos
Reached FAILWITH instruction with
  { Unit; Unit; Unit; Unit; Unit; Unit; Unit; Unit; Unit; Unit }
at line 124 char 457.

>>> pretty $ MichelsonFailureWithStack @Void (MichelsonFailedWith $ VPair (largeValue, largeValue)) pos
Reached FAILWITH instruction with
  Pair
    { Unit; Unit; Unit; Unit; Unit; Unit; Unit; Unit; Unit; Unit }
    { Unit; Unit; Unit; Unit; Unit; Unit; Unit; Unit; Unit; Unit }
at line 124 char 457.
-}
instance Buildable ext => Buildable (MichelsonFailureWithStack ext) where
  build :: MichelsonFailureWithStack ext -> Doc
build (MichelsonFailureWithStack MichelsonFailed ext
err ErrorSrcPos
loc)
    | SrcPos (Pos Word
row) (Pos Word
col) <- ErrorSrcPos -> SrcPos
unErrorSrcPos ErrorSrcPos
loc
    = Text
"" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| MichelsonFailed ext
err MichelsonFailed ext -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Text
"at line" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Word -> Doc
forall a. Buildable a => a -> Doc
build (Word
row Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) Doc -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Text
"char" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Word -> Doc
forall a. Buildable a => a -> Doc
build (Word
col Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"." Doc -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""

data InterpretError ext = InterpretError
  { forall ext. InterpretError ext -> MorleyLogs
ieLogs :: MorleyLogs
  , forall ext. InterpretError ext -> MichelsonFailureWithStack ext
ieFailure :: MichelsonFailureWithStack ext
  } deriving stock ((forall x. InterpretError ext -> Rep (InterpretError ext) x)
-> (forall x. Rep (InterpretError ext) x -> InterpretError ext)
-> Generic (InterpretError ext)
forall x. Rep (InterpretError ext) x -> InterpretError ext
forall x. InterpretError ext -> Rep (InterpretError ext) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ext x. Rep (InterpretError ext) x -> InterpretError ext
forall ext x. InterpretError ext -> Rep (InterpretError ext) x
$cfrom :: forall ext x. InterpretError ext -> Rep (InterpretError ext) x
from :: forall x. InterpretError ext -> Rep (InterpretError ext) x
$cto :: forall ext x. Rep (InterpretError ext) x -> InterpretError ext
to :: forall x. Rep (InterpretError ext) x -> InterpretError ext
Generic)

deriving stock instance Show ext => Show (InterpretError ext)

instance Buildable ext => Buildable (InterpretError ext) where
  build :: InterpretError ext -> Doc
build InterpretError{MorleyLogs
MichelsonFailureWithStack ext
ieLogs :: forall ext. InterpretError ext -> MorleyLogs
ieFailure :: forall ext. InterpretError ext -> MichelsonFailureWithStack ext
ieLogs :: MorleyLogs
ieFailure :: MichelsonFailureWithStack ext
..} = MichelsonFailureWithStack ext -> Doc
forall a b. (Buildable a, FromDoc b) => a -> b
pretty MichelsonFailureWithStack ext
ieFailure

data ResultStateLogs res = ResultStateLogs
  { forall res. ResultStateLogs res -> res
rslResult :: res
  , forall res. ResultStateLogs res -> InterpreterState
rslState :: InterpreterState
  , forall res. ResultStateLogs res -> MorleyLogs
rslLogs :: MorleyLogs
  } deriving stock ((forall a b. (a -> b) -> ResultStateLogs a -> ResultStateLogs b)
-> (forall a b. a -> ResultStateLogs b -> ResultStateLogs a)
-> Functor ResultStateLogs
forall a b. a -> ResultStateLogs b -> ResultStateLogs a
forall a b. (a -> b) -> ResultStateLogs a -> ResultStateLogs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ResultStateLogs a -> ResultStateLogs b
fmap :: forall a b. (a -> b) -> ResultStateLogs a -> ResultStateLogs b
$c<$ :: forall a b. a -> ResultStateLogs b -> ResultStateLogs a
<$ :: forall a b. a -> ResultStateLogs b -> ResultStateLogs a
Functor, (forall m. Monoid m => ResultStateLogs m -> m)
-> (forall m a. Monoid m => (a -> m) -> ResultStateLogs a -> m)
-> (forall m a. Monoid m => (a -> m) -> ResultStateLogs a -> m)
-> (forall a b. (a -> b -> b) -> b -> ResultStateLogs a -> b)
-> (forall a b. (a -> b -> b) -> b -> ResultStateLogs a -> b)
-> (forall b a. (b -> a -> b) -> b -> ResultStateLogs a -> b)
-> (forall b a. (b -> a -> b) -> b -> ResultStateLogs a -> b)
-> (forall a. (a -> a -> a) -> ResultStateLogs a -> a)
-> (forall a. (a -> a -> a) -> ResultStateLogs a -> a)
-> (forall a. ResultStateLogs a -> [a])
-> (forall a. ResultStateLogs a -> Bool)
-> (forall a. ResultStateLogs a -> Int)
-> (forall a. Eq a => a -> ResultStateLogs a -> Bool)
-> (forall a. Ord a => ResultStateLogs a -> a)
-> (forall a. Ord a => ResultStateLogs a -> a)
-> (forall a. Num a => ResultStateLogs a -> a)
-> (forall a. Num a => ResultStateLogs a -> a)
-> Foldable ResultStateLogs
forall a. Eq a => a -> ResultStateLogs a -> Bool
forall a. Num a => ResultStateLogs a -> a
forall a. Ord a => ResultStateLogs a -> a
forall m. Monoid m => ResultStateLogs m -> m
forall a. ResultStateLogs a -> Bool
forall a. ResultStateLogs a -> Int
forall a. ResultStateLogs a -> [a]
forall a. (a -> a -> a) -> ResultStateLogs a -> a
forall m a. Monoid m => (a -> m) -> ResultStateLogs a -> m
forall b a. (b -> a -> b) -> b -> ResultStateLogs a -> b
forall a b. (a -> b -> b) -> b -> ResultStateLogs a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ResultStateLogs m -> m
fold :: forall m. Monoid m => ResultStateLogs m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ResultStateLogs a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ResultStateLogs a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ResultStateLogs a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ResultStateLogs a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ResultStateLogs a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ResultStateLogs a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ResultStateLogs a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ResultStateLogs a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ResultStateLogs a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ResultStateLogs a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ResultStateLogs a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ResultStateLogs a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ResultStateLogs a -> a
foldr1 :: forall a. (a -> a -> a) -> ResultStateLogs a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ResultStateLogs a -> a
foldl1 :: forall a. (a -> a -> a) -> ResultStateLogs a -> a
$ctoList :: forall a. ResultStateLogs a -> [a]
toList :: forall a. ResultStateLogs a -> [a]
$cnull :: forall a. ResultStateLogs a -> Bool
null :: forall a. ResultStateLogs a -> Bool
$clength :: forall a. ResultStateLogs a -> Int
length :: forall a. ResultStateLogs a -> Int
$celem :: forall a. Eq a => a -> ResultStateLogs a -> Bool
elem :: forall a. Eq a => a -> ResultStateLogs a -> Bool
$cmaximum :: forall a. Ord a => ResultStateLogs a -> a
maximum :: forall a. Ord a => ResultStateLogs a -> a
$cminimum :: forall a. Ord a => ResultStateLogs a -> a
minimum :: forall a. Ord a => ResultStateLogs a -> a
$csum :: forall a. Num a => ResultStateLogs a -> a
sum :: forall a. Num a => ResultStateLogs a -> a
$cproduct :: forall a. Num a => ResultStateLogs a -> a
product :: forall a. Num a => ResultStateLogs a -> a
Foldable, Functor ResultStateLogs
Foldable ResultStateLogs
Functor ResultStateLogs
-> Foldable ResultStateLogs
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ResultStateLogs a -> f (ResultStateLogs b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ResultStateLogs (f a) -> f (ResultStateLogs a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ResultStateLogs a -> m (ResultStateLogs b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ResultStateLogs (m a) -> m (ResultStateLogs a))
-> Traversable ResultStateLogs
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ResultStateLogs (m a) -> m (ResultStateLogs a)
forall (f :: * -> *) a.
Applicative f =>
ResultStateLogs (f a) -> f (ResultStateLogs a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ResultStateLogs a -> m (ResultStateLogs b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ResultStateLogs a -> f (ResultStateLogs b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ResultStateLogs a -> f (ResultStateLogs b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ResultStateLogs a -> f (ResultStateLogs b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ResultStateLogs (f a) -> f (ResultStateLogs a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ResultStateLogs (f a) -> f (ResultStateLogs a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ResultStateLogs a -> m (ResultStateLogs b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ResultStateLogs a -> m (ResultStateLogs b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ResultStateLogs (m a) -> m (ResultStateLogs a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ResultStateLogs (m a) -> m (ResultStateLogs a)
Traversable, Int -> ResultStateLogs res -> ShowS
[ResultStateLogs res] -> ShowS
ResultStateLogs res -> String
(Int -> ResultStateLogs res -> ShowS)
-> (ResultStateLogs res -> String)
-> ([ResultStateLogs res] -> ShowS)
-> Show (ResultStateLogs res)
forall res. Show res => Int -> ResultStateLogs res -> ShowS
forall res. Show res => [ResultStateLogs res] -> ShowS
forall res. Show res => ResultStateLogs res -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall res. Show res => Int -> ResultStateLogs res -> ShowS
showsPrec :: Int -> ResultStateLogs res -> ShowS
$cshow :: forall res. Show res => ResultStateLogs res -> String
show :: ResultStateLogs res -> String
$cshowList :: forall res. Show res => [ResultStateLogs res] -> ShowS
showList :: [ResultStateLogs res] -> ShowS
Show, (forall x. ResultStateLogs res -> Rep (ResultStateLogs res) x)
-> (forall x. Rep (ResultStateLogs res) x -> ResultStateLogs res)
-> Generic (ResultStateLogs res)
forall x. Rep (ResultStateLogs res) x -> ResultStateLogs res
forall x. ResultStateLogs res -> Rep (ResultStateLogs res) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall res x. Rep (ResultStateLogs res) x -> ResultStateLogs res
forall res x. ResultStateLogs res -> Rep (ResultStateLogs res) x
$cfrom :: forall res x. ResultStateLogs res -> Rep (ResultStateLogs res) x
from :: forall x. ResultStateLogs res -> Rep (ResultStateLogs res) x
$cto :: forall res x. Rep (ResultStateLogs res) x -> ResultStateLogs res
to :: forall x. Rep (ResultStateLogs res) x -> ResultStateLogs res
Generic)
    deriving anyclass ResultStateLogs res -> ()
(ResultStateLogs res -> ()) -> NFData (ResultStateLogs res)
forall res. NFData res => ResultStateLogs res -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall res. NFData res => ResultStateLogs res -> ()
rnf :: ResultStateLogs res -> ()
NFData

-- | Pure result of an interpretation, i.e. return value, final interpreter
-- state and execution logs.
type InterpretResult ty = ResultStateLogs (Value ty)

-- | Pure result of contract interpretation. A specialized version of
-- 'InterpretResult'.
type ContractResult ty = InterpretResult (ContractOut1 ty)

-- | Result of 'runEvalOp'. Essentially, return value (possibly failing), state
-- and logs.
type RunEvalOpReturn a = ResultStateLogs (Either (MichelsonFailureWithStack Void) a)

-- | Result of 'interpretView'. A version of 'RunEvalOpReturn' specialized to 'Value'.
type InterpretReturn ty = RunEvalOpReturn (Value ty)

-- | Result of 'interpret'. A version of 'InterpretReturn' specialized to 'ContractOut1'.
type ContractReturn st = InterpretReturn (ContractOut1 st)

-- | On failure, attach logs to failure, but throw away the final state.
handleReturn
  :: InterpretReturn res
  -> Either (InterpretError Void) (ResultStateLogs (Value res))
handleReturn :: forall (res :: T).
InterpretReturn res
-> Either (InterpretError Void) (ResultStateLogs (Value res))
handleReturn rsl :: InterpretReturn res
rsl@ResultStateLogs{Either (MichelsonFailureWithStack Void) (Value res)
InterpreterState
MorleyLogs
rslResult :: forall res. ResultStateLogs res -> res
rslState :: forall res. ResultStateLogs res -> InterpreterState
rslLogs :: forall res. ResultStateLogs res -> MorleyLogs
rslResult :: Either (MichelsonFailureWithStack Void) (Value res)
rslState :: InterpreterState
rslLogs :: MorleyLogs
..} = (MichelsonFailureWithStack Void -> InterpretError Void)
-> Either
     (MichelsonFailureWithStack Void) (ResultStateLogs (Value res))
-> Either (InterpretError Void) (ResultStateLogs (Value res))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MorleyLogs -> MichelsonFailureWithStack Void -> InterpretError Void
forall ext.
MorleyLogs -> MichelsonFailureWithStack ext -> InterpretError ext
InterpretError MorleyLogs
rslLogs) (Either
   (MichelsonFailureWithStack Void) (ResultStateLogs (Value res))
 -> Either (InterpretError Void) (ResultStateLogs (Value res)))
-> (InterpretReturn res
    -> Either
         (MichelsonFailureWithStack Void) (ResultStateLogs (Value res)))
-> InterpretReturn res
-> Either (InterpretError Void) (ResultStateLogs (Value res))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpretReturn res
-> Either
     (MichelsonFailureWithStack Void) (ResultStateLogs (Value res))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
ResultStateLogs (m a) -> m (ResultStateLogs a)
sequence (InterpretReturn res
 -> Either (InterpretError Void) (ResultStateLogs (Value res)))
-> InterpretReturn res
-> Either (InterpretError Void) (ResultStateLogs (Value res))
forall a b. (a -> b) -> a -> b
$ InterpretReturn res
rsl

-- | Reset 'ceMetaWrapper` after it is used with an instr.
withMetaWrapper :: forall ext meta m. EvalM' ext m => InstrRunner meta m -> InstrRunner meta m
withMetaWrapper :: forall ext (meta :: T -> *) (m :: * -> *).
EvalM' ext m =>
InstrRunner meta m -> InstrRunner meta m
withMetaWrapper InstrRunner meta m
runner Instr inp out
instr Rec (StkEl meta) inp
s = do
  ContractEnv{forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  (ContractEnv' m -> ContractEnv' m)
-> m (Rec (StkEl meta) out) -> m (Rec (StkEl meta) out)
forall a. (ContractEnv' m -> ContractEnv' m) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ContractEnv' m
env -> ContractEnv' m
env {ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper = Instr i o -> Instr i o
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
forall a. a -> a
id}) (m (Rec (StkEl meta) out) -> m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) out) -> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$
    Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner (Instr inp out -> Instr inp out
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper Instr inp out
instr) Rec (StkEl meta) inp
s

-- | Extract list of operations from 'ContractOut1' 'Value'.
extractValOps :: Value (ContractOut1 st) -> ([Operation], Value st)
extractValOps :: forall (st :: T).
Value (ContractOut1 st) -> ([Operation], Value st)
extractValOps (VPair (Value' Instr l, Value' Instr r)
x) = (Value' Instr l -> [Operation])
-> (Value' Instr l, Value st) -> ([Operation], Value st)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Value' Instr l -> [Operation]
Value (ToT [Operation]) -> [Operation]
forall a. IsoValue a => Value (ToT a) -> a
fromVal (Value' Instr l, Value st)
(Value' Instr l, Value' Instr r)
x

interpret'
  :: forall cp st arg m. (Monad m)
  => Contract cp st
  -> EntrypointCallT cp arg
  -> Value arg
  -> Value st
  -> ContractEnv' (EvalOpT m)
  -> InterpreterState
  -> m (ContractReturn st)
interpret' :: forall (cp :: T) (st :: T) (arg :: T) (m :: * -> *).
Monad m =>
Contract cp st
-> EntrypointCallT cp arg
-> Value arg
-> Value st
-> ContractEnv' (EvalOpT m)
-> InterpreterState
-> m (ContractReturn st)
interpret' Contract{EntriesOrder
Notes st
ViewsSet' Instr st
ParamNotes cp
ContractCode' Instr cp st
cCode :: ContractCode' Instr cp st
cParamNotes :: ParamNotes cp
cStoreNotes :: Notes st
cViews :: ViewsSet' Instr st
cEntriesOrder :: EntriesOrder
cCode :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
cParamNotes :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ParamNotes cp
cStoreNotes :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> Notes st
cViews :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ViewsSet' instr st
cEntriesOrder :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> EntriesOrder
..} EntrypointCallT cp arg
epc Value arg
param Value st
initSt ContractEnv' (EvalOpT m)
env InterpreterState
ist = ((Either
   (MichelsonFailureWithStack Void)
   (Rec (StkEl NoStkElMeta) (ContractOut st))
 -> Either
      (MichelsonFailureWithStack Void) (Value (ContractOut1 st)))
-> ResultStateLogs
     (Either
        (MichelsonFailureWithStack Void)
        (Rec (StkEl NoStkElMeta) (ContractOut st)))
-> ResultStateLogs
     (Either (MichelsonFailureWithStack Void) (Value (ContractOut1 st)))
forall a b. (a -> b) -> ResultStateLogs a -> ResultStateLogs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either
    (MichelsonFailureWithStack Void)
    (Rec (StkEl NoStkElMeta) (ContractOut st))
  -> Either
       (MichelsonFailureWithStack Void) (Value (ContractOut1 st)))
 -> ResultStateLogs
      (Either
         (MichelsonFailureWithStack Void)
         (Rec (StkEl NoStkElMeta) (ContractOut st)))
 -> ResultStateLogs
      (Either
         (MichelsonFailureWithStack Void) (Value (ContractOut1 st))))
-> ((Rec (StkEl NoStkElMeta) (ContractOut st)
     -> Value (ContractOut1 st))
    -> Either
         (MichelsonFailureWithStack Void)
         (Rec (StkEl NoStkElMeta) (ContractOut st))
    -> Either
         (MichelsonFailureWithStack Void) (Value (ContractOut1 st)))
-> (Rec (StkEl NoStkElMeta) (ContractOut st)
    -> Value (ContractOut1 st))
-> ResultStateLogs
     (Either
        (MichelsonFailureWithStack Void)
        (Rec (StkEl NoStkElMeta) (ContractOut st)))
-> ResultStateLogs
     (Either (MichelsonFailureWithStack Void) (Value (ContractOut1 st)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rec (StkEl NoStkElMeta) (ContractOut st)
 -> Value (ContractOut1 st))
-> Either
     (MichelsonFailureWithStack Void)
     (Rec (StkEl NoStkElMeta) (ContractOut st))
-> Either
     (MichelsonFailureWithStack Void) (Value (ContractOut1 st))
forall a b.
(a -> b)
-> Either (MichelsonFailureWithStack Void) a
-> Either (MichelsonFailureWithStack Void) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (\(StkEl Value (ContractOut1 st)
val :& Rec (StkEl NoStkElMeta) rs
RNil) -> Value (ContractOut1 st)
val) (ResultStateLogs
   (Either
      (MichelsonFailureWithStack Void)
      (Rec (StkEl NoStkElMeta) (ContractOut st)))
 -> ResultStateLogs
      (Either
         (MichelsonFailureWithStack Void) (Value (ContractOut1 st))))
-> m (ResultStateLogs
        (Either
           (MichelsonFailureWithStack Void)
           (Rec (StkEl NoStkElMeta) (ContractOut st))))
-> m (ResultStateLogs
        (Either
           (MichelsonFailureWithStack Void) (Value (ContractOut1 st))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  EvalOpT m (Rec (StkEl NoStkElMeta) (ContractOut st))
-> ContractEnv' (EvalOpT m)
-> InterpreterState
-> m (ResultStateLogs
        (Either
           (MichelsonFailureWithStack Void)
           (Rec (StkEl NoStkElMeta) (ContractOut st))))
forall (m :: * -> *) a.
Monad m =>
EvalOpT m a
-> ContractEnv' (EvalOpT m)
-> InterpreterState
-> m (RunEvalOpReturn a)
runEvalOpT
    (Instr (ContractInp cp st) (ContractOut st)
-> Rec (StkEl NoStkElMeta) (ContractInp cp st)
-> EvalOpT m (Rec (StkEl NoStkElMeta) (ContractOut st))
InstrRunner NoStkElMeta (EvalOpT m)
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr (ContractCode' Instr cp st
-> Instr (ContractInp cp st) (ContractOut st)
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
ContractCode' instr cp st
-> instr (ContractInp cp st) (ContractOut st)
unContractCode ContractCode' Instr cp st
cCode) (Rec (StkEl NoStkElMeta) (ContractInp cp st)
 -> EvalOpT m (Rec (StkEl NoStkElMeta) (ContractOut st)))
-> EvalOpT m (Rec (StkEl NoStkElMeta) (ContractInp cp st))
-> EvalOpT m (Rec (StkEl NoStkElMeta) (ContractOut st))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (meta :: T -> *) (inp :: [T]) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Rec (Value' Instr) inp -> m (Rec (StkEl meta) inp)
mapToStkEl @NoStkElMeta Rec (Value' Instr) (ContractInp cp st)
initStack)
    ContractEnv' (EvalOpT m)
env
    InterpreterState
ist
  where
    initStack :: Rec (Value' Instr) (ContractInp cp st)
initStack = Value cp -> Value st -> Rec (Value' Instr) (ContractInp cp st)
forall (param :: T) (st :: T).
Value param
-> Value st -> Rec (Value' Instr) (ContractInp param st)
mkInitStack (EntrypointCallT cp arg -> Value arg -> Value cp
forall (param :: T) (arg :: T) (instr :: [T] -> [T] -> *).
EntrypointCallT param arg -> Value' instr arg -> Value' instr param
liftCallArg EntrypointCallT cp arg
epc Value arg
param) Value st
initSt

mkInitStack
  :: Value param
  -> Value st
  -> Rec Value (ContractInp param st)
mkInitStack :: forall (param :: T) (st :: T).
Value param
-> Value st -> Rec (Value' Instr) (ContractInp param st)
mkInitStack Value param
param Value st
st = (Value param, Value st) -> Value' Instr ('TPair param st)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value param
param, Value st
st) Value' Instr ('TPair param st)
-> Rec (Value' Instr) '[] -> Rec (Value' Instr) '[ 'TPair param st]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Value' Instr) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil

interpret
  :: Contract cp st
  -> EntrypointCallT cp arg
  -> Value arg
  -> Value st
  -> GlobalCounter
  -> BigMapCounter
  -> ContractEnv
  -> ContractReturn st
interpret :: forall (cp :: T) (st :: T) (arg :: T).
Contract cp st
-> EntrypointCallT cp arg
-> Value arg
-> Value st
-> GlobalCounter
-> BigMapCounter
-> ContractEnv
-> ContractReturn st
interpret Contract cp st
contract EntrypointCallT cp arg
epc Value arg
param Value st
initSt GlobalCounter
globalCounter BigMapCounter
bmCounter ContractEnv
env = Identity (ContractReturn st) -> ContractReturn st
forall a. Identity a -> a
runIdentity (Identity (ContractReturn st) -> ContractReturn st)
-> Identity (ContractReturn st) -> ContractReturn st
forall a b. (a -> b) -> a -> b
$
  Contract cp st
-> EntrypointCallT cp arg
-> Value arg
-> Value st
-> ContractEnv
-> InterpreterState
-> Identity (ContractReturn st)
forall (cp :: T) (st :: T) (arg :: T) (m :: * -> *).
Monad m =>
Contract cp st
-> EntrypointCallT cp arg
-> Value arg
-> Value st
-> ContractEnv' (EvalOpT m)
-> InterpreterState
-> m (ContractReturn st)
interpret' Contract cp st
contract EntrypointCallT cp arg
epc Value arg
param Value st
initSt ContractEnv
env (GlobalCounter -> BigMapCounter -> ContractEnv -> InterpreterState
initInterpreterState GlobalCounter
globalCounter BigMapCounter
bmCounter ContractEnv
env)

initInterpreterState :: GlobalCounter -> BigMapCounter -> ContractEnv -> InterpreterState
initInterpreterState :: GlobalCounter -> BigMapCounter -> ContractEnv -> InterpreterState
initInterpreterState GlobalCounter
globalCounter BigMapCounter
bmCounter ContractEnv
env =
  RemainingSteps
-> GlobalCounter -> BigMapCounter -> InterpreterState
InterpreterState (ContractEnv -> RemainingSteps
forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceMaxSteps ContractEnv
env) GlobalCounter
globalCounter BigMapCounter
bmCounter

-- | Interpret an instruction in vacuum, putting no extra constraints on
-- its execution.
--
-- Mostly for testing purposes.
interpretInstr
  :: ContractEnv
  -> Instr inp out
  -> Rec Value inp
  -> Either (MichelsonFailureWithStack Void) (Rec Value out)
interpretInstr :: forall (inp :: [T]) (out :: [T]).
ContractEnv
-> Instr inp out
-> Rec (Value' Instr) inp
-> Either (MichelsonFailureWithStack Void) (Rec (Value' Instr) out)
interpretInstr = (Rec (StkEl NoStkElMeta) out -> Rec (Value' Instr) out)
-> Either
     (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out)
-> Either (MichelsonFailureWithStack Void) (Rec (Value' Instr) out)
forall a b.
(a -> b)
-> Either (MichelsonFailureWithStack Void) a
-> Either (MichelsonFailureWithStack Void) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rec (StkEl NoStkElMeta) out -> Rec (Value' Instr) out
forall (meta :: T -> *) (inp :: [T]).
Rec (StkEl meta) inp -> Rec (Value' Instr) inp
mapToValue (Either
   (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out)
 -> Either
      (MichelsonFailureWithStack Void) (Rec (Value' Instr) out))
-> (ContractEnv
    -> Instr inp out
    -> Rec (Value' Instr) inp
    -> Either
         (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out))
-> ContractEnv
-> Instr inp out
-> Rec (Value' Instr) inp
-> Either (MichelsonFailureWithStack Void) (Rec (Value' Instr) out)
forall a b c. SuperComposition a b c => a -> b -> c
... ContractEnv
-> Instr inp out
-> Rec (Value' Instr) inp
-> Either
     (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out)
forall (inp :: [T]) (out :: [T]).
ContractEnv
-> Instr inp out
-> Rec (Value' Instr) inp
-> Either
     (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out)
interpretInstrAnnotated

-- | Interpret an instruction in vacuum, putting no extra constraints on
-- its execution while preserving its annotations.
--
-- Mostly for testing purposes.
interpretInstrAnnotated
  :: ContractEnv
  -> Instr inp out
  -> Rec Value inp
  -> Either (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out)
interpretInstrAnnotated :: forall (inp :: [T]) (out :: [T]).
ContractEnv
-> Instr inp out
-> Rec (Value' Instr) inp
-> Either
     (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out)
interpretInstrAnnotated ContractEnv
env Instr inp out
instr Rec (Value' Instr) inp
inpSt =
  ResultStateLogs
  (Either
     (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out))
-> Either
     (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out)
forall res. ResultStateLogs res -> res
rslResult (ResultStateLogs
   (Either
      (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out))
 -> Either
      (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out))
-> ResultStateLogs
     (Either
        (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out))
-> Either
     (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out)
forall a b. (a -> b) -> a -> b
$
  EvalOp (Rec (StkEl NoStkElMeta) out)
-> ContractEnv
-> InterpreterState
-> ResultStateLogs
     (Either
        (MichelsonFailureWithStack Void) (Rec (StkEl NoStkElMeta) out))
forall a.
EvalOp a -> ContractEnv -> InterpreterState -> RunEvalOpReturn a
runEvalOp
    (Instr inp out
-> Rec (StkEl NoStkElMeta) inp
-> EvalOp (Rec (StkEl NoStkElMeta) out)
InstrRunner NoStkElMeta (EvalOpT Identity)
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr Instr inp out
instr (Rec (StkEl NoStkElMeta) inp
 -> EvalOp (Rec (StkEl NoStkElMeta) out))
-> EvalOpT Identity (Rec (StkEl NoStkElMeta) inp)
-> EvalOp (Rec (StkEl NoStkElMeta) out)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (meta :: T -> *) (inp :: [T]) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Rec (Value' Instr) inp -> m (Rec (StkEl meta) inp)
mapToStkEl @NoStkElMeta Rec (Value' Instr) inp
inpSt)
    ContractEnv
env
    InterpreterState
      { isRemainingSteps :: RemainingSteps
isRemainingSteps = RemainingSteps
9999999999
      , isBigMapCounter :: BigMapCounter
isBigMapCounter = BigMapCounter
0
      , isGlobalCounter :: GlobalCounter
isGlobalCounter = GlobalCounter
0
      }

data SomeItStack meta where
  SomeItStack :: ExtInstr inp -> Rec (StkEl meta) inp -> SomeItStack meta

-- | The main interpreter monad, used by the higher-level functions like
-- 'interpret' and 'interpretView'.
--
-- Downstream consumers which use 'runInstrImpl' directly may define their own
-- monad similar to this one, or alternatively use 'EvalOpT' with the slightly
-- lower-level functions, e.g. `interpret'` and `interpretView'`.
type EvalOp = EvalOpT Identity

-- | The main interpreter monad transformer. Provides a more convenient way of
-- enriching the interpreter monad without redefining it entirely.
--
-- This is a newtype and not a type synonym due to the reader environment, i.e.
-- t'ContractEnv', being parameterized by the interpreter monad.
newtype EvalOpT m a = EvalOpT
  (ExceptT (MichelsonFailureWithStack Void)
    (RWST (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m) a)
  deriving newtype
    ( MonadError (MichelsonFailureWithStack Void)
    , MonadState InterpreterState
    , Monad (EvalOpT m)
EvalOpT m InterpreterState
Monad (EvalOpT m)
-> EvalOpT m InterpreterState
-> (InterpreterState -> EvalOpT m ())
-> (forall a.
    (InterpreterState -> (a, InterpreterState)) -> EvalOpT m a)
-> ((InterpreterState -> InterpreterState) -> EvalOpT m ())
-> InterpreterStateMonad (EvalOpT m)
InterpreterState -> EvalOpT m ()
(InterpreterState -> InterpreterState) -> EvalOpT m ()
forall a.
(InterpreterState -> (a, InterpreterState)) -> EvalOpT m a
forall (m :: * -> *). Monad m => Monad (EvalOpT m)
forall (m :: * -> *). Monad m => EvalOpT m InterpreterState
forall (m :: * -> *).
Monad m
-> m InterpreterState
-> (InterpreterState -> m ())
-> (forall a. (InterpreterState -> (a, InterpreterState)) -> m a)
-> ((InterpreterState -> InterpreterState) -> m ())
-> InterpreterStateMonad m
forall (m :: * -> *). Monad m => InterpreterState -> EvalOpT m ()
forall (m :: * -> *).
Monad m =>
(InterpreterState -> InterpreterState) -> EvalOpT m ()
forall (m :: * -> *) a.
Monad m =>
(InterpreterState -> (a, InterpreterState)) -> EvalOpT m a
$cgetInterpreterState :: forall (m :: * -> *). Monad m => EvalOpT m InterpreterState
getInterpreterState :: EvalOpT m InterpreterState
$cputInterpreterState :: forall (m :: * -> *). Monad m => InterpreterState -> EvalOpT m ()
putInterpreterState :: InterpreterState -> EvalOpT m ()
$cstateInterpreterState :: forall (m :: * -> *) a.
Monad m =>
(InterpreterState -> (a, InterpreterState)) -> EvalOpT m a
stateInterpreterState :: forall a.
(InterpreterState -> (a, InterpreterState)) -> EvalOpT m a
$cmodifyInterpreterState :: forall (m :: * -> *).
Monad m =>
(InterpreterState -> InterpreterState) -> EvalOpT m ()
modifyInterpreterState :: (InterpreterState -> InterpreterState) -> EvalOpT m ()
InterpreterStateMonad
    , MonadWriter MorleyLogsBuilder
    , MonadReader (ContractEnv' (EvalOpT m))
    , Applicative (EvalOpT m)
Applicative (EvalOpT m)
-> (forall a b. EvalOpT m a -> (a -> EvalOpT m b) -> EvalOpT m b)
-> (forall a b. EvalOpT m a -> EvalOpT m b -> EvalOpT m b)
-> (forall a. a -> EvalOpT m a)
-> Monad (EvalOpT m)
forall a. a -> EvalOpT m a
forall a b. EvalOpT m a -> EvalOpT m b -> EvalOpT m b
forall a b. EvalOpT m a -> (a -> EvalOpT m b) -> EvalOpT m b
forall (m :: * -> *). Monad m => Applicative (EvalOpT m)
forall (m :: * -> *) a. Monad m => a -> EvalOpT m a
forall (m :: * -> *) a b.
Monad m =>
EvalOpT m a -> EvalOpT m b -> EvalOpT m b
forall (m :: * -> *) a b.
Monad m =>
EvalOpT m a -> (a -> EvalOpT m b) -> EvalOpT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
EvalOpT m a -> (a -> EvalOpT m b) -> EvalOpT m b
>>= :: forall a b. EvalOpT m a -> (a -> EvalOpT m b) -> EvalOpT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
EvalOpT m a -> EvalOpT m b -> EvalOpT m b
>> :: forall a b. EvalOpT m a -> EvalOpT m b -> EvalOpT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> EvalOpT m a
return :: forall a. a -> EvalOpT m a
Monad
    , Functor (EvalOpT m)
Functor (EvalOpT m)
-> (forall a. a -> EvalOpT m a)
-> (forall a b. EvalOpT m (a -> b) -> EvalOpT m a -> EvalOpT m b)
-> (forall a b c.
    (a -> b -> c) -> EvalOpT m a -> EvalOpT m b -> EvalOpT m c)
-> (forall a b. EvalOpT m a -> EvalOpT m b -> EvalOpT m b)
-> (forall a b. EvalOpT m a -> EvalOpT m b -> EvalOpT m a)
-> Applicative (EvalOpT m)
forall a. a -> EvalOpT m a
forall a b. EvalOpT m a -> EvalOpT m b -> EvalOpT m a
forall a b. EvalOpT m a -> EvalOpT m b -> EvalOpT m b
forall a b. EvalOpT m (a -> b) -> EvalOpT m a -> EvalOpT m b
forall a b c.
(a -> b -> c) -> EvalOpT m a -> EvalOpT m b -> EvalOpT m c
forall {m :: * -> *}. Monad m => Functor (EvalOpT m)
forall (m :: * -> *) a. Monad m => a -> EvalOpT m a
forall (m :: * -> *) a b.
Monad m =>
EvalOpT m a -> EvalOpT m b -> EvalOpT m a
forall (m :: * -> *) a b.
Monad m =>
EvalOpT m a -> EvalOpT m b -> EvalOpT m b
forall (m :: * -> *) a b.
Monad m =>
EvalOpT m (a -> b) -> EvalOpT m a -> EvalOpT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> EvalOpT m a -> EvalOpT m b -> EvalOpT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> EvalOpT m a
pure :: forall a. a -> EvalOpT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
EvalOpT m (a -> b) -> EvalOpT m a -> EvalOpT m b
<*> :: forall a b. EvalOpT m (a -> b) -> EvalOpT m a -> EvalOpT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> EvalOpT m a -> EvalOpT m b -> EvalOpT m c
liftA2 :: forall a b c.
(a -> b -> c) -> EvalOpT m a -> EvalOpT m b -> EvalOpT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
EvalOpT m a -> EvalOpT m b -> EvalOpT m b
*> :: forall a b. EvalOpT m a -> EvalOpT m b -> EvalOpT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
EvalOpT m a -> EvalOpT m b -> EvalOpT m a
<* :: forall a b. EvalOpT m a -> EvalOpT m b -> EvalOpT m a
Applicative
    , (forall a b. (a -> b) -> EvalOpT m a -> EvalOpT m b)
-> (forall a b. a -> EvalOpT m b -> EvalOpT m a)
-> Functor (EvalOpT m)
forall a b. a -> EvalOpT m b -> EvalOpT m a
forall a b. (a -> b) -> EvalOpT m a -> EvalOpT m b
forall (m :: * -> *) a b.
Functor m =>
a -> EvalOpT m b -> EvalOpT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> EvalOpT m a -> EvalOpT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> EvalOpT m a -> EvalOpT m b
fmap :: forall a b. (a -> b) -> EvalOpT m a -> EvalOpT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> EvalOpT m b -> EvalOpT m a
<$ :: forall a b. a -> EvalOpT m b -> EvalOpT m a
Functor
    , Monad (EvalOpT m)
Monad (EvalOpT m)
-> (forall a. IO a -> EvalOpT m a) -> MonadIO (EvalOpT m)
forall a. IO a -> EvalOpT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (EvalOpT m)
forall (m :: * -> *) a. MonadIO m => IO a -> EvalOpT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> EvalOpT m a
liftIO :: forall a. IO a -> EvalOpT m a
MonadIO
    )

instance MonadTrans EvalOpT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> EvalOpT m a
lift = ExceptT
  (MichelsonFailureWithStack Void)
  (RWST
     (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m)
  a
-> EvalOpT m a
forall (m :: * -> *) a.
ExceptT
  (MichelsonFailureWithStack Void)
  (RWST
     (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m)
  a
-> EvalOpT m a
EvalOpT (ExceptT
   (MichelsonFailureWithStack Void)
   (RWST
      (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m)
   a
 -> EvalOpT m a)
-> (m a
    -> ExceptT
         (MichelsonFailureWithStack Void)
         (RWST
            (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m)
         a)
-> m a
-> EvalOpT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWST
  (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m a
-> ExceptT
     (MichelsonFailureWithStack Void)
     (RWST
        (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m)
     a
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (MichelsonFailureWithStack Void) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RWST
   (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m a
 -> ExceptT
      (MichelsonFailureWithStack Void)
      (RWST
         (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m)
      a)
-> (m a
    -> RWST
         (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m a)
-> m a
-> ExceptT
     (MichelsonFailureWithStack Void)
     (RWST
        (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a
-> RWST
     (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m a
forall (m :: * -> *) a.
Monad m =>
m a
-> RWST
     (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runEvalOp :: EvalOp a -> ContractEnv -> InterpreterState -> RunEvalOpReturn a
runEvalOp :: forall a.
EvalOp a -> ContractEnv -> InterpreterState -> RunEvalOpReturn a
runEvalOp = Identity (RunEvalOpReturn a) -> RunEvalOpReturn a
forall a. Identity a -> a
runIdentity (Identity (RunEvalOpReturn a) -> RunEvalOpReturn a)
-> (EvalOpT Identity a
    -> ContractEnv -> InterpreterState -> Identity (RunEvalOpReturn a))
-> EvalOpT Identity a
-> ContractEnv
-> InterpreterState
-> RunEvalOpReturn a
forall a b c. SuperComposition a b c => a -> b -> c
... EvalOpT Identity a
-> ContractEnv -> InterpreterState -> Identity (RunEvalOpReturn a)
forall (m :: * -> *) a.
Monad m =>
EvalOpT m a
-> ContractEnv' (EvalOpT m)
-> InterpreterState
-> m (RunEvalOpReturn a)
runEvalOpT

runEvalOpT
  :: Monad m
  => EvalOpT m a
  -> ContractEnv' (EvalOpT m)
  -> InterpreterState
  -> m (RunEvalOpReturn a)
runEvalOpT :: forall (m :: * -> *) a.
Monad m =>
EvalOpT m a
-> ContractEnv' (EvalOpT m)
-> InterpreterState
-> m (RunEvalOpReturn a)
runEvalOpT (EvalOpT ExceptT
  (MichelsonFailureWithStack Void)
  (RWST
     (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m)
  a
act) ContractEnv' (EvalOpT m)
env InterpreterState
initSt = do
  (Either (MichelsonFailureWithStack Void) a
rslResult, InterpreterState
rslState, MorleyLogsBuilder -> MorleyLogs
buildMorleyLogs -> MorleyLogs
rslLogs) <- RWST
  (ContractEnv' (EvalOpT m))
  MorleyLogsBuilder
  InterpreterState
  m
  (Either (MichelsonFailureWithStack Void) a)
-> ContractEnv' (EvalOpT m)
-> InterpreterState
-> m (Either (MichelsonFailureWithStack Void) a, InterpreterState,
      MorleyLogsBuilder)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (ExceptT
  (MichelsonFailureWithStack Void)
  (RWST
     (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m)
  a
-> RWST
     (ContractEnv' (EvalOpT m))
     MorleyLogsBuilder
     InterpreterState
     m
     (Either (MichelsonFailureWithStack Void) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT
  (MichelsonFailureWithStack Void)
  (RWST
     (ContractEnv' (EvalOpT m)) MorleyLogsBuilder InterpreterState m)
  a
act) ContractEnv' (EvalOpT m)
env InterpreterState
initSt
  RunEvalOpReturn a -> m (RunEvalOpReturn a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultStateLogs{Either (MichelsonFailureWithStack Void) a
InterpreterState
MorleyLogs
rslResult :: Either (MichelsonFailureWithStack Void) a
rslState :: InterpreterState
rslLogs :: MorleyLogs
rslResult :: Either (MichelsonFailureWithStack Void) a
rslState :: InterpreterState
rslLogs :: MorleyLogs
..}

class Monad m => InterpreterStateMonad m where
  getInterpreterState :: m InterpreterState
  getInterpreterState = (InterpreterState -> (InterpreterState, InterpreterState))
-> m InterpreterState
forall a. (InterpreterState -> (a, InterpreterState)) -> m a
forall (m :: * -> *) a.
InterpreterStateMonad m =>
(InterpreterState -> (a, InterpreterState)) -> m a
stateInterpreterState (\InterpreterState
s -> (InterpreterState
s, InterpreterState
s))

  putInterpreterState :: InterpreterState -> m ()
  putInterpreterState InterpreterState
s = (InterpreterState -> ((), InterpreterState)) -> m ()
forall a. (InterpreterState -> (a, InterpreterState)) -> m a
forall (m :: * -> *) a.
InterpreterStateMonad m =>
(InterpreterState -> (a, InterpreterState)) -> m a
stateInterpreterState (\InterpreterState
_ -> ((), InterpreterState
s))

  stateInterpreterState :: (InterpreterState -> (a, InterpreterState)) -> m a
  stateInterpreterState InterpreterState -> (a, InterpreterState)
f = do
    InterpreterState
s <- m InterpreterState
forall (m :: * -> *). InterpreterStateMonad m => m InterpreterState
getInterpreterState
    let (a
a, InterpreterState
s') = InterpreterState -> (a, InterpreterState)
f InterpreterState
s
    a
a a -> m () -> m a
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ InterpreterState -> m ()
forall (m :: * -> *).
InterpreterStateMonad m =>
InterpreterState -> m ()
putInterpreterState InterpreterState
s'

  modifyInterpreterState :: (InterpreterState -> InterpreterState) -> m ()
  modifyInterpreterState InterpreterState -> InterpreterState
f = (InterpreterState -> ((), InterpreterState)) -> m ()
forall a. (InterpreterState -> (a, InterpreterState)) -> m a
forall (m :: * -> *) a.
InterpreterStateMonad m =>
(InterpreterState -> (a, InterpreterState)) -> m a
stateInterpreterState (((), ) (InterpreterState -> ((), InterpreterState))
-> (InterpreterState -> InterpreterState)
-> InterpreterState
-> ((), InterpreterState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpreterState -> InterpreterState
f)

instance Monad m => InterpreterStateMonad (StateT InterpreterState m) where
  stateInterpreterState :: forall a.
(InterpreterState -> (a, InterpreterState))
-> StateT InterpreterState m a
stateInterpreterState = (InterpreterState -> (a, InterpreterState))
-> StateT InterpreterState m a
forall a.
(InterpreterState -> (a, InterpreterState))
-> StateT InterpreterState m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
instance (Monad m, Monoid w) => InterpreterStateMonad (RWST r w InterpreterState m) where
  stateInterpreterState :: forall a.
(InterpreterState -> (a, InterpreterState))
-> RWST r w InterpreterState m a
stateInterpreterState = (InterpreterState -> (a, InterpreterState))
-> RWST r w InterpreterState m a
forall a.
(InterpreterState -> (a, InterpreterState))
-> RWST r w InterpreterState m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance InterpreterStateMonad m => InterpreterStateMonad (ReaderT r m) where
  stateInterpreterState :: forall a.
(InterpreterState -> (a, InterpreterState)) -> ReaderT r m a
stateInterpreterState = m a -> ReaderT r m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> ((InterpreterState -> (a, InterpreterState)) -> m a)
-> (InterpreterState -> (a, InterpreterState))
-> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InterpreterState -> (a, InterpreterState)) -> m a
forall a. (InterpreterState -> (a, InterpreterState)) -> m a
forall (m :: * -> *) a.
InterpreterStateMonad m =>
(InterpreterState -> (a, InterpreterState)) -> m a
stateInterpreterState
instance (InterpreterStateMonad m, Monoid w) => InterpreterStateMonad (WriterT w m) where
  stateInterpreterState :: forall a.
(InterpreterState -> (a, InterpreterState)) -> WriterT w m a
stateInterpreterState = m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> ((InterpreterState -> (a, InterpreterState)) -> m a)
-> (InterpreterState -> (a, InterpreterState))
-> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InterpreterState -> (a, InterpreterState)) -> m a
forall a. (InterpreterState -> (a, InterpreterState)) -> m a
forall (m :: * -> *) a.
InterpreterStateMonad m =>
(InterpreterState -> (a, InterpreterState)) -> m a
stateInterpreterState
instance {-# OVERLAPPABLE #-} InterpreterStateMonad m => InterpreterStateMonad (StateT w m) where
  stateInterpreterState :: forall a.
(InterpreterState -> (a, InterpreterState)) -> StateT w m a
stateInterpreterState = m a -> StateT w m a
forall (m :: * -> *) a. Monad m => m a -> StateT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT w m a)
-> ((InterpreterState -> (a, InterpreterState)) -> m a)
-> (InterpreterState -> (a, InterpreterState))
-> StateT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InterpreterState -> (a, InterpreterState)) -> m a
forall a. (InterpreterState -> (a, InterpreterState)) -> m a
forall (m :: * -> *) a.
InterpreterStateMonad m =>
(InterpreterState -> (a, InterpreterState)) -> m a
stateInterpreterState
instance {-# OVERLAPPABLE #-}
         (InterpreterStateMonad m, Monoid w) => InterpreterStateMonad (RWST r w s m) where
  stateInterpreterState :: forall a.
(InterpreterState -> (a, InterpreterState)) -> RWST r w s m a
stateInterpreterState = m a -> RWST r w s m a
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a)
-> ((InterpreterState -> (a, InterpreterState)) -> m a)
-> (InterpreterState -> (a, InterpreterState))
-> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InterpreterState -> (a, InterpreterState)) -> m a
forall a. (InterpreterState -> (a, InterpreterState)) -> m a
forall (m :: * -> *) a.
InterpreterStateMonad m =>
(InterpreterState -> (a, InterpreterState)) -> m a
stateInterpreterState
instance InterpreterStateMonad m => InterpreterStateMonad (ExceptT e m) where
  stateInterpreterState :: forall a.
(InterpreterState -> (a, InterpreterState)) -> ExceptT e m a
stateInterpreterState = m a -> ExceptT e m a
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT e m a)
-> ((InterpreterState -> (a, InterpreterState)) -> m a)
-> (InterpreterState -> (a, InterpreterState))
-> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InterpreterState -> (a, InterpreterState)) -> m a
forall a. (InterpreterState -> (a, InterpreterState)) -> m a
forall (m :: * -> *) a.
InterpreterStateMonad m =>
(InterpreterState -> (a, InterpreterState)) -> m a
stateInterpreterState

type EvalM' ext m =
  ( MonadReader (ContractEnv' m) m
  , InterpreterStateMonad m
  , MonadWriter MorleyLogsBuilder m
  , MonadError (MichelsonFailureWithStack ext) m
  )

type EvalM m = EvalM' Void m

type InstrRunner meta m =
  forall inp out.
     Instr inp out
  -> Rec (StkEl meta) inp
  -> m (Rec (StkEl meta) out)

throwMichelson :: EvalM' ext m => MichelsonFailed ext -> m a
throwMichelson :: forall ext (m :: * -> *) a.
EvalM' ext m =>
MichelsonFailed ext -> m a
throwMichelson MichelsonFailed ext
mf = (ContractEnv' m -> ErrorSrcPos) -> m ErrorSrcPos
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ContractEnv' m -> ErrorSrcPos
forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceErrorSrcPos m ErrorSrcPos -> (ErrorSrcPos -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MichelsonFailureWithStack ext -> m a
forall a. MichelsonFailureWithStack ext -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MichelsonFailureWithStack ext -> m a)
-> (ErrorSrcPos -> MichelsonFailureWithStack ext)
-> ErrorSrcPos
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MichelsonFailed ext -> ErrorSrcPos -> MichelsonFailureWithStack ext
forall ext.
MichelsonFailed ext -> ErrorSrcPos -> MichelsonFailureWithStack ext
MichelsonFailureWithStack MichelsonFailed ext
mf

-- | Function to change amount of remaining steps stored in State monad.
runInstr :: forall ext meta m. (StkElMeta meta m, EvalM' ext m) => InstrRunner meta m
runInstr :: forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr i :: Instr inp out
i@(Seq Instr inp b
_i1 Instr b out
_i2) Rec (StkEl meta) inp
r = InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr Instr inp out
i Rec (StkEl meta) inp
r
runInstr i :: Instr inp out
i@(WithLoc ErrorSrcPos
_ Instr inp out
_) Rec (StkEl meta) inp
r = InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr Instr inp out
i Rec (StkEl meta) inp
r
runInstr i :: Instr inp out
i@(Meta SomeMeta
_ Instr inp out
_i1) Rec (StkEl meta) inp
r = InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr Instr inp out
i Rec (StkEl meta) inp
r
runInstr i :: Instr inp out
i@Instr inp out
Nop Rec (StkEl meta) inp
r = InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr Instr inp out
i Rec (StkEl meta) inp
r
runInstr i :: Instr inp out
i@(Nested Instr inp out
_) Rec (StkEl meta) inp
r = InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr Instr inp out
i Rec (StkEl meta) inp
r
runInstr i :: Instr inp out
i@(DocGroup DocGrouping
_ Instr inp out
_i1) Rec (StkEl meta) inp
r = InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr Instr inp out
i Rec (StkEl meta) inp
r
runInstr Instr inp out
i Rec (StkEl meta) inp
r = do
  RemainingSteps
rs <- InterpreterState -> RemainingSteps
isRemainingSteps (InterpreterState -> RemainingSteps)
-> m InterpreterState -> m RemainingSteps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InterpreterState
forall (m :: * -> *). InterpreterStateMonad m => m InterpreterState
getInterpreterState
  if RemainingSteps
rs RemainingSteps -> RemainingSteps -> Bool
forall a. Eq a => a -> a -> Bool
== RemainingSteps
0
  then MichelsonFailed ext -> m (Rec (StkEl meta) out)
forall ext (m :: * -> *) a.
EvalM' ext m =>
MichelsonFailed ext -> m a
throwMichelson MichelsonFailed ext
forall ext. MichelsonFailed ext
MichelsonGasExhaustion
  else do
    (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
InterpreterStateMonad m =>
(InterpreterState -> InterpreterState) -> m ()
modifyInterpreterState (\InterpreterState
s -> InterpreterState
s {isRemainingSteps :: RemainingSteps
isRemainingSteps = RemainingSteps
rs RemainingSteps -> RemainingSteps -> RemainingSteps
forall a. Num a => a -> a -> a
- RemainingSteps
1})
    InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr Instr inp out
i Rec (StkEl meta) inp
r

runInstrNoGas :: EvalM m => InstrRunner NoStkElMeta m
runInstrNoGas :: forall (m :: * -> *). EvalM m => InstrRunner NoStkElMeta m
runInstrNoGas = InstrRunner NoStkElMeta m -> InstrRunner NoStkElMeta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out
-> Rec (StkEl NoStkElMeta) inp -> m (Rec (StkEl NoStkElMeta) out)
InstrRunner NoStkElMeta m
forall (m :: * -> *). EvalM m => InstrRunner NoStkElMeta m
runInstrNoGas

(<:&>) :: Functor f => f (a r) -> Rec a rs -> f (Rec a (r : rs))
f (a r)
m <:&> :: forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec a rs
r = (a r -> Rec a (r : rs)) -> f (a r) -> f (Rec a (r : rs))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a r -> Rec a rs -> Rec a (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec a rs
r) f (a r)
m
infixr 7 <:&>

-- | Function to interpret Michelson instruction(s) against given stack.
-- The @ext@ type variable specifies additional exceptions that can be thrown from the inner
-- runner function (via 'MichelsonExt'). In Morley, it's set to 'Void', but downstream consumers
-- may use other type here.
runInstrImpl
  :: forall ext meta m. (EvalM' ext m, StkElMeta meta m)
  => InstrRunner meta m -> InstrRunner meta m
runInstrImpl :: forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl InstrRunner meta m
runner (Seq Instr inp b
i1 Instr b out
i2) Rec (StkEl meta) inp
r = Instr inp b -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) b)
InstrRunner meta m
runner Instr inp b
i1 Rec (StkEl meta) inp
r m (Rec (StkEl meta) b)
-> (Rec (StkEl meta) b -> m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) out)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Rec (StkEl meta) b
r' -> Instr b out -> Rec (StkEl meta) b -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr b out
i2 Rec (StkEl meta) b
r'
runInstrImpl InstrRunner meta m
runner (WithLoc ErrorSrcPos
ics Instr inp out
i) Rec (StkEl meta) inp
r = do
    -- Add wrapper which will be used later on in loop-like instr.
    let updateEnv :: ContractEnv' m -> ContractEnv' m
updateEnv env :: ContractEnv' m
env@ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..}
          = ContractEnv' m
env { ceErrorSrcPos :: ErrorSrcPos
ceErrorSrcPos = ErrorSrcPos
ics, ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper = Instr i o -> Instr i o
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper (Instr i o -> Instr i o)
-> (Instr i o -> Instr i o) -> Instr i o -> Instr i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorSrcPos -> Instr i o -> Instr i o
forall (inp :: [T]) (out :: [T]).
ErrorSrcPos -> Instr inp out -> Instr inp out
WithLoc ErrorSrcPos
ics }
    (ContractEnv' m -> ContractEnv' m)
-> m (Rec (StkEl meta) out) -> m (Rec (StkEl meta) out)
forall a. (ContractEnv' m -> ContractEnv' m) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ContractEnv' m -> ContractEnv' m
updateEnv (m (Rec (StkEl meta) out) -> m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) out) -> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$ Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr inp out
i Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
runner (Meta SomeMeta
meta Instr inp out
i) Rec (StkEl meta) inp
r = do
    -- Add wrapper which will be used later on in loop-like instr.
    let updateEnv :: ContractEnv' m -> ContractEnv' m
updateEnv env :: ContractEnv' m
env@ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..}
          = ContractEnv' m
env { ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper = Instr i o -> Instr i o
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper (Instr i o -> Instr i o)
-> (Instr i o -> Instr i o) -> Instr i o -> Instr i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeMeta -> Instr i o -> Instr i o
forall (inp :: [T]) (out :: [T]).
SomeMeta -> Instr inp out -> Instr inp out
Meta SomeMeta
meta }
    (ContractEnv' m -> ContractEnv' m)
-> m (Rec (StkEl meta) out) -> m (Rec (StkEl meta) out)
forall a. (ContractEnv' m -> ContractEnv' m) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ContractEnv' m -> ContractEnv' m
updateEnv (m (Rec (StkEl meta) out) -> m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) out) -> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$ Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr inp out
i Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ Instr inp out
Nop Rec (StkEl meta) inp
r = Rec (StkEl meta) inp -> m (Rec (StkEl meta) inp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rec (StkEl meta) inp -> m (Rec (StkEl meta) inp))
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) inp)
forall a b. (a -> b) -> a -> b
$ Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
runner (Ext ExtInstr inp
nop) Rec (StkEl meta) inp
r = Rec (StkEl meta) inp
Rec (StkEl meta) out
r Rec (StkEl meta) out -> m () -> m (Rec (StkEl meta) out)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ InstrRunner meta m -> SomeItStack meta -> m ()
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m -> SomeItStack meta -> m ()
interpretExt Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner (ExtInstr inp -> Rec (StkEl meta) inp -> SomeItStack meta
forall (n :: [T]) (meta :: T -> *).
ExtInstr n -> Rec (StkEl meta) n -> SomeItStack meta
SomeItStack ExtInstr inp
nop Rec (StkEl meta) inp
r)
runInstrImpl InstrRunner meta m
runner (Nested Instr inp out
sq) Rec (StkEl meta) inp
r = Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr inp out
sq Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
runner (DocGroup DocGrouping
_ Instr inp out
sq) Rec (StkEl meta) inp
r = InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr inp out
sq Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ Instr inp out
DROP (StkEl meta r
_ :& Rec (StkEl meta) rs
r) = Rec (StkEl meta) rs -> m (Rec (StkEl meta) rs)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rec (StkEl meta) rs -> m (Rec (StkEl meta) rs))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) rs)
forall a b. (a -> b) -> a -> b
$ Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (DROPN PeanoNatural n
n) Rec (StkEl meta) inp
stack =
  case PeanoNatural n
n of
    PeanoNatural n
Zero    -> Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec (StkEl meta) inp
Rec (StkEl meta) out
stack
    Succ PeanoNatural m
s' -> case Rec (StkEl meta) inp
stack of
      (StkEl meta r
_ :& Rec (StkEl meta) rs
r) -> InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner (PeanoNatural m -> Instr rs (Drop m rs)
forall (n :: Peano) (inp :: [T]).
RequireLongerOrSameLength inp n =>
PeanoNatural n -> Instr inp (Drop n inp)
DROPN PeanoNatural m
s') Rec (StkEl meta) rs
r
      -- Note: we intentionally do not use `runner` to recursively
      -- interpret `DROPN` here.
      -- All these recursive calls together correspond to a single
      -- Michelson instruction call.
      -- This recursion is implementation detail of `DROPN`.
      -- The same reasoning applies to other instructions parameterized
      -- by a natural number like 'DIPN'.
runInstrImpl InstrRunner meta m
_ AnnDUP{} (StkEl meta r
stkEl :& Rec (StkEl meta) rs
r) = do
  -- If we're duplicating a big_map, or a value containing big_map(s), we need to generate new big_map ID(s).
  StkEl meta r
duplicateStkEl <- (Value r -> m (Value r)) -> StkEl meta r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (f :: * -> *).
Functor f =>
(Value t -> f (Value t)) -> StkEl meta t -> f (StkEl meta t)
seValueL Value r -> m (Value r)
forall ext (m :: * -> *) (t :: T).
EvalM' ext m =>
Value t -> m (Value t)
assignBigMapIds' (StkEl meta r -> m (StkEl meta r))
-> m (StkEl meta r) -> m (StkEl meta r)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StkEl meta r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
StkEl meta t -> m (StkEl meta t)
mkDuplicateStkEl StkEl meta r
stkEl
  pure $ StkEl meta r
duplicateStkEl StkEl meta r
-> Rec (StkEl meta) (r : rs) -> Rec (StkEl meta) (r : r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StkEl meta r
stkEl StkEl meta r -> Rec (StkEl meta) rs -> Rec (StkEl meta) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ (AnnDUPN AnnVar
_ PeanoNatural n
s) Rec (StkEl meta) inp
stack = PeanoNatural n -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
forall (n :: Peano) (inp :: [T]) (out :: [T]) (a :: T).
ConstraintDUPN n inp out a =>
PeanoNatural n -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
go PeanoNatural n
s Rec (StkEl meta) inp
stack
  where
    go :: forall (n :: Peano) inp out a. ConstraintDUPN n inp out a
       => PeanoNatural n -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
    go :: forall (n :: Peano) (inp :: [T]) (out :: [T]) (a :: T).
ConstraintDUPN n inp out a =>
PeanoNatural n -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
go (Succ PeanoNatural m
Zero) stk :: Rec (StkEl meta) inp
stk@(StkEl meta r
stkEl :& Rec (StkEl meta) rs
_) = do
        -- If we're duplicating a big_map, or a value containing big_map(s), we need to generate new big_map ID(s).
        StkEl meta r
duplicateStkEl <- (Value r -> m (Value r)) -> StkEl meta r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (f :: * -> *).
Functor f =>
(Value t -> f (Value t)) -> StkEl meta t -> f (StkEl meta t)
seValueL Value r -> m (Value r)
forall ext (m :: * -> *) (t :: T).
EvalM' ext m =>
Value t -> m (Value t)
assignBigMapIds' (StkEl meta r -> m (StkEl meta r))
-> m (StkEl meta r) -> m (StkEl meta r)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StkEl meta r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
StkEl meta t -> m (StkEl meta t)
mkDuplicateStkEl StkEl meta r
stkEl
        pure $ StkEl meta r
duplicateStkEl StkEl meta r -> Rec (StkEl meta) inp -> Rec (StkEl meta) (r : inp)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) inp
stk
    go (Succ n :: PeanoNatural m
n@(Succ PeanoNatural m
_)) (StkEl meta r
b :& Rec (StkEl meta) rs
r) =
      PeanoNatural m
-> Rec (StkEl meta) rs
-> m (Rec
        (StkEl meta)
        (a : (LazyTake m (Tail inp) ++ (a : Drop ('S ('S m)) inp))))
forall (n :: Peano) (inp :: [T]) (out :: [T]) (a :: T).
ConstraintDUPN n inp out a =>
PeanoNatural n -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
go PeanoNatural m
n Rec (StkEl meta) rs
r m (Rec
     (StkEl meta)
     (a : (LazyTake m (Tail inp) ++ (a : Drop ('S ('S m)) inp))))
-> (Rec
      (StkEl meta)
      (a : (LazyTake m (Tail inp) ++ (a : Drop ('S ('S m)) inp)))
    -> Rec (StkEl meta) out)
-> m (Rec (StkEl meta) out)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        (StkEl meta r
a :& Rec (StkEl meta) rs
resTail) -> StkEl meta r
a StkEl meta r
-> Rec (StkEl meta) (r : rs) -> Rec (StkEl meta) (r : r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StkEl meta r
b StkEl meta r -> Rec (StkEl meta) rs -> Rec (StkEl meta) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) rs
resTail
runInstrImpl InstrRunner meta m
_ Instr inp out
SWAP (StkEl meta r
a :& StkEl meta r
b :& Rec (StkEl meta) rs
r) = Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rec (StkEl meta) out -> m (Rec (StkEl meta) out))
-> Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$ StkEl meta r
b StkEl meta r
-> Rec (StkEl meta) (r : rs) -> Rec (StkEl meta) (r : r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StkEl meta r
a StkEl meta r -> Rec (StkEl meta) rs -> Rec (StkEl meta) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ (DIG @_ @_ @_ @a PeanoNatural n
s) Rec (StkEl meta) inp
input0 =
  Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rec (StkEl meta) out -> m (Rec (StkEl meta) out))
-> Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$ PeanoNatural n -> Rec (StkEl meta) inp -> Rec (StkEl meta) out
forall (n :: Peano) (inp :: [T]) (out :: [T]).
ConstraintDIG n inp out a =>
PeanoNatural n -> Rec (StkEl meta) inp -> Rec (StkEl meta) out
go PeanoNatural n
s Rec (StkEl meta) inp
input0
  where
    go :: forall (n :: Peano) inp out. ConstraintDIG n inp out a
       => PeanoNatural n -> Rec (StkEl meta) inp -> Rec (StkEl meta) out
    go :: forall (n :: Peano) (inp :: [T]) (out :: [T]).
ConstraintDIG n inp out a =>
PeanoNatural n -> Rec (StkEl meta) inp -> Rec (StkEl meta) out
go PeanoNatural n
Zero Rec (StkEl meta) inp
stack = Rec (StkEl meta) inp
Rec (StkEl meta) out
stack
    go (Succ PeanoNatural m
n') (StkEl meta r
b :& Rec (StkEl meta) rs
r) =
      case PeanoNatural m
-> Rec (StkEl meta) rs
-> Rec
     (StkEl meta)
     (a : (LazyTake
             m
             (LazyTake m (LazyTake m (Tail inp) ++ Drop ('S ('S m)) inp)
              ++ (a : Drop m (LazyTake m (Tail inp) ++ Drop ('S ('S m)) inp)))
           ++ Drop
                ('S m)
                (LazyTake m (LazyTake m (Tail inp) ++ Drop ('S ('S m)) inp)
                 ++ (a : Drop m (LazyTake m (Tail inp) ++ Drop ('S ('S m)) inp)))))
forall (n :: Peano) (inp :: [T]) (out :: [T]).
ConstraintDIG n inp out a =>
PeanoNatural n -> Rec (StkEl meta) inp -> Rec (StkEl meta) out
go PeanoNatural m
n' Rec (StkEl meta) rs
r of
        StkEl meta r
a :& Rec (StkEl meta) rs
resTail -> StkEl meta r
a StkEl meta r
-> Rec (StkEl meta) (r : rs) -> Rec (StkEl meta) (r : r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StkEl meta r
b StkEl meta r -> Rec (StkEl meta) rs -> Rec (StkEl meta) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) rs
resTail
runInstrImpl InstrRunner meta m
_ (DUG @_ @_ @_ @a PeanoNatural n
s) Rec (StkEl meta) inp
input0 =
  Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rec (StkEl meta) out -> m (Rec (StkEl meta) out))
-> Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$ PeanoNatural n -> Rec (StkEl meta) inp -> Rec (StkEl meta) out
forall (n :: Peano) (inp :: [T]) (out :: [T]).
ConstraintDUG n inp out a =>
PeanoNatural n -> Rec (StkEl meta) inp -> Rec (StkEl meta) out
go PeanoNatural n
s Rec (StkEl meta) inp
input0
  where
    go :: forall (n :: Peano) inp out. ConstraintDUG n inp out a
       => PeanoNatural n -> Rec (StkEl meta) inp -> Rec (StkEl meta) out
    go :: forall (n :: Peano) (inp :: [T]) (out :: [T]).
ConstraintDUG n inp out a =>
PeanoNatural n -> Rec (StkEl meta) inp -> Rec (StkEl meta) out
go PeanoNatural n
Zero Rec (StkEl meta) inp
stack = Rec (StkEl meta) inp
Rec (StkEl meta) out
stack
    go (Succ PeanoNatural m
n') (StkEl meta r
a :& StkEl meta r
b :& Rec (StkEl meta) rs
r) = StkEl meta r
b StkEl meta r
-> Rec
     (StkEl meta)
     (LazyTake m (LazyTake m (Tail out) ++ Drop ('S ('S m)) out)
      ++ (a : Drop m (LazyTake m (Tail out) ++ Drop ('S ('S m)) out)))
-> Rec
     (StkEl meta)
     (r : (LazyTake m (LazyTake m (Tail out) ++ Drop ('S ('S m)) out)
           ++ (a : Drop m (LazyTake m (Tail out) ++ Drop ('S ('S m)) out))))
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& PeanoNatural m
-> Rec (StkEl meta) (r : rs)
-> Rec
     (StkEl meta)
     (LazyTake m (LazyTake m (Tail out) ++ Drop ('S ('S m)) out)
      ++ (a : Drop m (LazyTake m (Tail out) ++ Drop ('S ('S m)) out)))
forall (n :: Peano) (inp :: [T]) (out :: [T]).
ConstraintDUG n inp out a =>
PeanoNatural n -> Rec (StkEl meta) inp -> Rec (StkEl meta) out
go PeanoNatural m
n' (StkEl meta r
a StkEl meta r -> Rec (StkEl meta) rs -> Rec (StkEl meta) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) rs
r)
runInstrImpl InstrRunner meta m
_ AnnSOME{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
r) =
  Value r
-> (SingI r => m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) out)
forall (instr :: [T] -> [T] -> *) (t :: T) a.
Value' instr t -> (SingI t => a) -> a
withValueTypeSanity Value r
a ((SingI r => m (Rec (StkEl meta) out)) -> m (Rec (StkEl meta) out))
-> (SingI r => m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$
    Value ('TOption r) -> m (StkEl meta ('TOption r))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Maybe (Value r) -> Value ('TOption r)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Value r -> Maybe (Value r)
forall a. a -> Maybe a
Just Value r
a)) m (StkEl meta ('TOption r))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TOption r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ (AnnPUSH Anns '[VarAnn, Notes t]
_ Value' Instr t
v) Rec (StkEl meta) inp
r = Value' Instr t -> m (StkEl meta t)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr t
v m (StkEl meta t)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) (t : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnNONE{} Rec (StkEl meta) inp
r = Value ('TOption a) -> m (StkEl meta ('TOption a))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Maybe (Value' Instr a) -> Value ('TOption a)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption Maybe (Value' Instr a)
forall a. Maybe a
Nothing) m (StkEl meta ('TOption a))
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TOption a : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnUNIT{} Rec (StkEl meta) inp
r = Value 'TUnit -> m (StkEl meta 'TUnit)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value 'TUnit
forall (instr :: [T] -> [T] -> *). Value' instr 'TUnit
VUnit m (StkEl meta 'TUnit)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TUnit : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
runner (IF_NONE Instr s out
_bNone Instr (a : s) out
bJust) (StkEl (VOption (Just Value' Instr t1
a)) :& Rec (StkEl meta) rs
r) =
  Instr (a : s) out
-> Rec (StkEl meta) (a : s) -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr (a : s) out
bJust (Rec (StkEl meta) (a : s) -> m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) (a : s)) -> m (Rec (StkEl meta) out)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value a -> m (StkEl meta a)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value a
Value' Instr t1
a m (StkEl meta a)
-> Rec (StkEl meta) s -> m (Rec (StkEl meta) (a : s))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) s
Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (IF_NONE Instr s out
bNone Instr (a : s) out
_bJust) (StkEl (VOption Maybe (Value' Instr t1)
Nothing) :& Rec (StkEl meta) rs
r) =
  Instr s out -> Rec (StkEl meta) s -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr s out
bNone Rec (StkEl meta) s
Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ Instr inp out
NEVER Rec (StkEl meta) inp
inp = case Rec (StkEl meta) inp
inp of {}
runInstrImpl InstrRunner meta m
_ (AnnPAIR{}) ((StkEl Value r
a) :& (StkEl Value r
b) :& Rec (StkEl meta) rs
r) =
  Value ('TPair r r) -> m (StkEl meta ('TPair r r))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl ((Value r, Value r) -> Value ('TPair r r)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value r
a, Value r
b)) m (StkEl meta ('TPair r r))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TPair r r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ (AnnUNPAIR{}) ((StkEl (VPair (Value' Instr l
a, Value' Instr r
b))) :& Rec (StkEl meta) rs
r) = do
  StkEl meta l
el1 <- Value' Instr l -> m (StkEl meta l)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr l
a
  StkEl meta r
el2 <- Value' Instr r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr r
b
  pure $ StkEl meta l
el1 StkEl meta l
-> Rec (StkEl meta) (r : rs) -> Rec (StkEl meta) (l : r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StkEl meta r
el2 StkEl meta r -> Rec (StkEl meta) rs -> Rec (StkEl meta) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ (AnnPAIRN AnnVar
_ PeanoNatural n
s) Rec (StkEl meta) inp
stack = PeanoNatural n
-> Rec (StkEl meta) inp
-> m (Rec (StkEl meta) (RightComb (LazyTake n inp) : Drop n inp))
forall (n :: Peano) (inp :: [T]).
ConstraintPairN n inp =>
PeanoNatural n
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) (PairN n inp))
go PeanoNatural n
s Rec (StkEl meta) inp
stack
  where
    go :: forall n inp. ConstraintPairN n inp
       => PeanoNatural n
       -> Rec (StkEl meta) inp
       -> m (Rec (StkEl meta) (PairN n inp))
    go :: forall (n :: Peano) (inp :: [T]).
ConstraintPairN n inp =>
PeanoNatural n
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) (PairN n inp))
go (Succ (Succ PeanoNatural m
Zero)) (StkEl Value r
a :& StkEl Value r
b :& Rec (StkEl meta) rs
r) =
      -- if n=2
      Value ('TPair r r) -> m (StkEl meta ('TPair r r))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl ((Value r, Value r) -> Value ('TPair r r)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value r
a, Value r
b)) m (StkEl meta ('TPair r r))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TPair r r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
    go (Succ n :: PeanoNatural m
n@(Succ (Succ PeanoNatural m
_))) (StkEl Value r
a :& r :: Rec (StkEl meta) rs
r@(StkEl meta r
_ :& StkEl meta r
_ :& Rec (StkEl meta) rs
_)) =
      -- if n>2
      PeanoNatural m
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) (PairN m rs))
forall (n :: Peano) (inp :: [T]).
ConstraintPairN n inp =>
PeanoNatural n
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) (PairN n inp))
go PeanoNatural m
n Rec (StkEl meta) rs
r m (Rec
     (StkEl meta) (RightComb (r : r : LazyTake m rs) : Drop m rs))
-> (Rec
      (StkEl meta) (RightComb (r : r : LazyTake m rs) : Drop m rs)
    -> m (Rec
            (StkEl meta)
            ('TPair r (RightComb (r : r : LazyTake m rs)) : Drop m rs)))
-> m (Rec
        (StkEl meta)
        ('TPair r (RightComb (r : r : LazyTake m rs)) : Drop m rs))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        StkEl Value r
combed :& Rec (StkEl meta) rs
r' ->
            Value ('TPair r r) -> m (StkEl meta ('TPair r r))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl ((Value r, Value r) -> Value ('TPair r r)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value r
a, Value r
combed)) m (StkEl meta ('TPair r r))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TPair r r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r'
runInstrImpl InstrRunner meta m
_ (UNPAIRN PeanoNatural n
s) (StkEl Value r
pair0 :& Rec (StkEl meta) rs
r) = do
  Rec (StkEl meta) (UnpairN n pair)
r' <- PeanoNatural n -> Value r -> m (Rec (StkEl meta) (UnpairN n r))
forall (n :: Peano) (pair :: T).
ConstraintUnpairN n pair =>
PeanoNatural n
-> Value pair -> m (Rec (StkEl meta) (UnpairN n pair))
go PeanoNatural n
s Value r
pair0
  pure $ Rec (StkEl meta) (UnpairN n pair)
r' Rec (StkEl meta) (UnpairN n pair)
-> Rec (StkEl meta) rs -> Rec (StkEl meta) (UnpairN n pair ++ rs)
forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec (StkEl meta) rs
r
  where
    go
      :: forall n pair. ConstraintUnpairN n pair
      => PeanoNatural n -> Value pair
      -> m (Rec (StkEl meta) (UnpairN n pair))
    go :: forall (n :: Peano) (pair :: T).
ConstraintUnpairN n pair =>
PeanoNatural n
-> Value pair -> m (Rec (StkEl meta) (UnpairN n pair))
go PeanoNatural n
n Value pair
pair =
      case (PeanoNatural n
n, Value pair
pair) of
        -- if n=2
        (Succ (Succ PeanoNatural m
Zero), VPair (Value' Instr l
a, Value' Instr r
b)) -> do
          StkEl meta l
el1 <- Value' Instr l -> m (StkEl meta l)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr l
a
          StkEl meta r
el2 <- Value' Instr r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr r
b
          pure $ StkEl meta l
el1 StkEl meta l -> Rec (StkEl meta) '[r] -> Rec (StkEl meta) '[l, r]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StkEl meta r
el2 StkEl meta r -> Rec (StkEl meta) '[] -> Rec (StkEl meta) '[r]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil
        -- if n>2
        (Succ n' :: PeanoNatural m
n'@(Succ (Succ PeanoNatural m
_)), VPair (Value' Instr l
a, b :: Value' Instr r
b@(VPair (Value' Instr l, Value' Instr r)
_))) ->
          (StkEl meta l
 -> Rec (StkEl meta) (UnpairN ('S ('S m)) ('TPair l r))
 -> Rec (StkEl meta) (l : UnpairN ('S ('S m)) ('TPair l r)))
-> m (StkEl meta l)
-> m (Rec (StkEl meta) (UnpairN ('S ('S m)) ('TPair l r)))
-> m (Rec (StkEl meta) (l : UnpairN ('S ('S m)) ('TPair l r)))
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 StkEl meta l
-> Rec (StkEl meta) (UnpairN ('S ('S m)) ('TPair l r))
-> Rec (StkEl meta) (l : UnpairN ('S ('S m)) ('TPair l r))
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&) (Value' Instr l -> m (StkEl meta l)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr l
a) (PeanoNatural m
-> Value' Instr r -> m (Rec (StkEl meta) (UnpairN m r))
forall (n :: Peano) (pair :: T).
ConstraintUnpairN n pair =>
PeanoNatural n
-> Value pair -> m (Rec (StkEl meta) (UnpairN n pair))
go PeanoNatural m
n' Value' Instr r
b)
runInstrImpl InstrRunner meta m
_ AnnCAR{} (StkEl (VPair (Value' Instr l
a, Value' Instr r
_b)) :& Rec (StkEl meta) rs
r) = Value' Instr l -> m (StkEl meta l)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr l
a m (StkEl meta l)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) (l : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnCDR{} (StkEl (VPair (Value' Instr l
_a, Value' Instr r
b)) :& Rec (StkEl meta) rs
r) = Value' Instr r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr r
b m (StkEl meta r)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) (r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnLEFT{} ((StkEl Value r
a) :& Rec (StkEl meta) rs
r) =
  Value r
-> (SingI r => m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) out)
forall (instr :: [T] -> [T] -> *) (t :: T) a.
Value' instr t -> (SingI t => a) -> a
withValueTypeSanity Value r
a ((SingI r => m (Rec (StkEl meta) out)) -> m (Rec (StkEl meta) out))
-> (SingI r => m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$
    Value ('TOr r b) -> m (StkEl meta ('TOr r b))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Either (Value r) (Value' Instr b) -> Value ('TOr r b)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(SingI l, SingI r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr (Either (Value r) (Value' Instr b) -> Value ('TOr r b))
-> Either (Value r) (Value' Instr b) -> Value ('TOr r b)
forall a b. (a -> b) -> a -> b
$ Value r -> Either (Value r) (Value' Instr b)
forall a b. a -> Either a b
Left Value r
a) m (StkEl meta ('TOr r b))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TOr r b : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnRIGHT{} ((StkEl Value r
b) :& Rec (StkEl meta) rs
r) =
  Value r
-> (SingI r => m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) out)
forall (instr :: [T] -> [T] -> *) (t :: T) a.
Value' instr t -> (SingI t => a) -> a
withValueTypeSanity Value r
b ((SingI r => m (Rec (StkEl meta) out)) -> m (Rec (StkEl meta) out))
-> (SingI r => m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$
    Value ('TOr a r) -> m (StkEl meta ('TOr a r))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Either (Value' Instr a) (Value r) -> Value ('TOr a r)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(SingI l, SingI r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr (Either (Value' Instr a) (Value r) -> Value ('TOr a r))
-> Either (Value' Instr a) (Value r) -> Value ('TOr a r)
forall a b. (a -> b) -> a -> b
$ Value r -> Either (Value' Instr a) (Value r)
forall a b. b -> Either a b
Right Value r
b) m (StkEl meta ('TOr a r))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TOr a r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (IF_LEFT Instr (a : s) out
bLeft Instr (b : s) out
_) (StkEl (VOr (Left Value' Instr l
a)) :& Rec (StkEl meta) rs
r) =
  Instr (a : s) out
-> Rec (StkEl meta) (a : s) -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr (a : s) out
bLeft (Rec (StkEl meta) (a : s) -> m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) (a : s)) -> m (Rec (StkEl meta) out)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value a -> m (StkEl meta a)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value a
Value' Instr l
a m (StkEl meta a)
-> Rec (StkEl meta) s -> m (Rec (StkEl meta) (a : s))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) s
Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (IF_LEFT Instr (a : s) out
_ Instr (b : s) out
bRight) (StkEl (VOr (Right Value' Instr r
a)) :& Rec (StkEl meta) rs
r) =
  Instr (b : s) out
-> Rec (StkEl meta) (b : s) -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr (b : s) out
bRight (Rec (StkEl meta) (b : s) -> m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) (b : s)) -> m (Rec (StkEl meta) out)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value b -> m (StkEl meta b)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value b
Value' Instr r
a m (StkEl meta b)
-> Rec (StkEl meta) s -> m (Rec (StkEl meta) (b : s))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) s
Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnNIL{} Rec (StkEl meta) inp
r = Value ('TList p) -> m (StkEl meta ('TList p))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl ([Value' Instr p] -> Value ('TList p)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
[Value' instr t1] -> Value' instr ('TList t1)
VList []) m (StkEl meta ('TList p))
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TList p : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnCONS{} (StkEl meta r
a :& StkEl (VList [Value' Instr t1]
l) :& Rec (StkEl meta) rs
r) = Value ('TList r) -> m (StkEl meta ('TList r))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl ([Value' Instr r] -> Value ('TList r)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
[Value' instr t1] -> Value' instr ('TList t1)
VList (StkEl meta r -> Value' Instr r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
a Value' Instr r -> [Value' Instr r] -> [Value' Instr r]
forall a. a -> [a] -> [a]
: [Value' Instr r]
[Value' Instr t1]
l)) m (StkEl meta ('TList r))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TList r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (IF_CONS Instr (a : 'TList a : s) out
_ Instr s out
bNil) (StkEl (VList []) :& Rec (StkEl meta) rs
r) = Instr s out -> Rec (StkEl meta) s -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr s out
bNil Rec (StkEl meta) s
Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (IF_CONS Instr (a : 'TList a : s) out
bCons Instr s out
_) (StkEl (VList (Value' Instr t1
lh : [Value' Instr t1]
lr)) :& Rec (StkEl meta) rs
r) = do
  StkEl meta t1
el1 <- Value' Instr t1 -> m (StkEl meta t1)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr t1
lh
  StkEl meta ('TList t1)
el2 <- Value ('TList t1) -> m (StkEl meta ('TList t1))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl ([Value' Instr t1] -> Value ('TList t1)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
[Value' instr t1] -> Value' instr ('TList t1)
VList [Value' Instr t1]
lr)
  Instr (a : 'TList a : s) out
-> Rec (StkEl meta) (a : 'TList a : s) -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr (a : 'TList a : s) out
bCons (Rec (StkEl meta) (a : 'TList a : s) -> m (Rec (StkEl meta) out))
-> Rec (StkEl meta) (a : 'TList a : s) -> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$ StkEl meta a
StkEl meta t1
el1 StkEl meta a
-> Rec (StkEl meta) ('TList a : s)
-> Rec (StkEl meta) (a : 'TList a : s)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StkEl meta ('TList a)
StkEl meta ('TList t1)
el2 StkEl meta ('TList a)
-> Rec (StkEl meta) s -> Rec (StkEl meta) ('TList a : s)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) s
Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnSIZE{} (StkEl meta r
a :& Rec (StkEl meta) rs
r) =
   Value 'TNat -> m (StkEl meta 'TNat)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Natural -> Value 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Natural -> Value 'TNat) -> Natural -> Value 'TNat
forall a b. (a -> b) -> a -> b
$ forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Natural (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ Value' Instr r -> Int
forall (c :: T) (instr :: [T] -> [T] -> *).
SizeOp c =>
Value' instr c -> Int
forall (instr :: [T] -> [T] -> *). Value' instr r -> Int
evalSize (Value' Instr r -> Int) -> Value' Instr r -> Int
forall a b. (a -> b) -> a -> b
$ StkEl meta r -> Value' Instr r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
a) m (StkEl meta 'TNat)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TNat : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnEMPTY_SET{} Rec (StkEl meta) inp
r = Value ('TSet e) -> m (StkEl meta ('TSet e))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Set (Value' Instr e) -> Value ('TSet e)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
Comparable t1 =>
Set (Value' instr t1) -> Value' instr ('TSet t1)
VSet Set (Value' Instr e)
forall a. Set a
Set.empty) m (StkEl meta ('TSet e))
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TSet e : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnEMPTY_MAP{} Rec (StkEl meta) inp
r = Value ('TMap a b) -> m (StkEl meta ('TMap a b))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Map (Value' Instr a) (Value' Instr b) -> Value ('TMap a b)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI v, Comparable k) =>
Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
VMap Map (Value' Instr a) (Value' Instr b)
forall k a. Map k a
Map.empty) m (StkEl meta ('TMap a b))
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TMap a b : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnEMPTY_BIG_MAP{} Rec (StkEl meta) inp
r = do
  Value ('TBigMap a b)
bigMap <- Value ('TBigMap a b) -> m (Value ('TBigMap a b))
forall ext (m :: * -> *) (t :: T).
EvalM' ext m =>
Value t -> m (Value t)
assignBigMapIds' (Value ('TBigMap a b) -> m (Value ('TBigMap a b)))
-> Value ('TBigMap a b) -> m (Value ('TBigMap a b))
forall a b. (a -> b) -> a -> b
$ Maybe Natural
-> Map (Value' Instr a) (Value' Instr b) -> Value ('TBigMap a b)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI v, Comparable k, ForbidBigMap v) =>
Maybe Natural
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
VBigMap Maybe Natural
forall a. Maybe a
Nothing Map (Value' Instr a) (Value' Instr b)
forall k a. Map k a
Map.empty
  Value ('TBigMap a b) -> m (StkEl meta ('TBigMap a b))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value ('TBigMap a b)
bigMap m (StkEl meta ('TBigMap a b))
-> Rec (StkEl meta) inp
-> m (Rec (StkEl meta) ('TBigMap a b : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
runner (AnnMAP AnnVar
_ (Instr (MapOpInp c : s) (b : s)
code :: Instr (MapOpInp c ': s) (b ': s))) (StkEl Value r
a :& Rec (StkEl meta) rs
r) = do
  -- Evaluation must preserve all stack modifications that @MAP@'s does.
  (Rec (StkEl meta) rs
newStack, [Value' Instr b]
newList) <- ((Rec (StkEl meta) rs, [Value' Instr b])
 -> StkEl meta (MapOpInp c)
 -> m (Rec (StkEl meta) rs, [Value' Instr b]))
-> (Rec (StkEl meta) rs, [Value' Instr b])
-> [StkEl meta (MapOpInp c)]
-> m (Rec (StkEl meta) rs, [Value' Instr b])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (\(Rec (StkEl meta) rs
curStack, [Value' Instr b]
curList) (StkEl meta (MapOpInp c)
val :: StkEl meta (MapOpInp c)) -> do
    Rec (StkEl meta) (b : s)
res <- Instr (MapOpInp c : rs) (b : s)
-> Rec (StkEl meta) (MapOpInp c : rs)
-> m (Rec (StkEl meta) (b : s))
InstrRunner meta m
runner Instr (MapOpInp c : s) (b : s)
Instr (MapOpInp c : rs) (b : s)
code (StkEl meta (MapOpInp c)
val StkEl meta (MapOpInp c)
-> Rec (StkEl meta) rs -> Rec (StkEl meta) (MapOpInp c : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) rs
curStack)
    case Rec (StkEl meta) (b : s)
res of
      ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value' Instr b
nextVal :: Value b) :& Rec (StkEl meta) rs
nextStack) -> (Rec (StkEl meta) rs, [Value' Instr b])
-> m (Rec (StkEl meta) rs, [Value' Instr b])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rec (StkEl meta) rs
Rec (StkEl meta) rs
nextStack, Value' Instr b
nextVal Value' Instr b -> [Value' Instr b] -> [Value' Instr b]
forall a. a -> [a] -> [a]
: [Value' Instr b]
curList))
    (Rec (StkEl meta) rs
r, []) ([StkEl meta (MapOpInp c)]
 -> m (Rec (StkEl meta) rs, [Value' Instr b]))
-> m [StkEl meta (MapOpInp c)]
-> m (Rec (StkEl meta) rs, [Value' Instr b])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Value (MapOpInp c) -> m (StkEl meta (MapOpInp c)))
-> [Value (MapOpInp c)] -> m [StkEl meta (MapOpInp c)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value (MapOpInp c) -> m (StkEl meta (MapOpInp c))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (forall (c :: T) (instr :: [T] -> [T] -> *).
MapOp c =>
Value' instr c -> [Value' instr (MapOpInp c)]
mapOpToList @c Value' Instr c
Value r
a)
  Value (MapOpRes c b) -> m (StkEl meta (MapOpRes c b))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Value r -> [Value' Instr b] -> Value' Instr (MapOpRes r b)
forall (c :: T) (b :: T) (instr :: [T] -> [T] -> *).
(MapOp c, SingI b) =>
Value' instr c -> [Value' instr b] -> Value' instr (MapOpRes c b)
forall (b :: T) (instr :: [T] -> [T] -> *).
SingI b =>
Value' instr r -> [Value' instr b] -> Value' instr (MapOpRes r b)
mapOpFromList Value r
a ([Value' Instr b] -> [Value' Instr b]
forall a. [a] -> [a]
reverse [Value' Instr b]
newList)) m (StkEl meta (MapOpRes c b))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) (MapOpRes c b : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
newStack
runInstrImpl InstrRunner meta m
runner (ITER (Instr (IterOpEl c : out) out
code :: Instr (IterOpEl c ': s) s)) (StkEl Value r
a :& Rec (StkEl meta) rs
r) =
  case forall (c :: T) (instr :: [T] -> [T] -> *).
IterOp c =>
Value' instr c
-> (Maybe (Value' instr (IterOpEl c)), Value' instr c)
iterOpDetachOne @c Value' Instr c
Value r
a of
    (Just Value' Instr (IterOpEl c)
x, Value' Instr c
xs) -> do
      Rec (StkEl meta) out
res <- Instr (IterOpEl c : rs) out
-> Rec (StkEl meta) (IterOpEl c : rs) -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr (IterOpEl c : out) out
Instr (IterOpEl c : rs) out
code (Rec (StkEl meta) (IterOpEl c : rs) -> m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) (IterOpEl c : rs))
-> m (Rec (StkEl meta) out)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value' Instr (IterOpEl c) -> m (StkEl meta (IterOpEl c))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr (IterOpEl c)
x m (StkEl meta (IterOpEl c))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) (IterOpEl c : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
      InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
EvalM' ext m =>
InstrRunner meta m -> InstrRunner meta m
withMetaWrapper Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner (Instr (IterOpEl c : out) out -> Instr (c : out) out
forall (c :: T) (out :: [T]).
IterOp c =>
Instr (IterOpEl c : out) out -> Instr (c : out) out
ITER Instr (IterOpEl c : out) out
code) (Rec (StkEl meta) (c : out) -> m (Rec (StkEl meta) out))
-> m (Rec (StkEl meta) (c : out)) -> m (Rec (StkEl meta) out)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value' Instr c -> m (StkEl meta c)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr c
xs m (StkEl meta c)
-> Rec (StkEl meta) out -> m (Rec (StkEl meta) (c : out))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) out
res
    (Maybe (Value' Instr (IterOpEl c))
Nothing, Value' Instr c
_) -> Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec (StkEl meta) out
Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnMEM{} (StkEl meta r
a :& StkEl meta r
b :& Rec (StkEl meta) rs
r) = Value 'TBool -> m (StkEl meta 'TBool)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Bool -> Value 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
VBool (Value' Instr (MemOpKey r) -> Value' Instr r -> Bool
forall (c :: T) (instr :: [T] -> [T] -> *).
MemOp c =>
Value' instr (MemOpKey c) -> Value' instr c -> Bool
forall (instr :: [T] -> [T] -> *).
Value' instr (MemOpKey r) -> Value' instr r -> Bool
evalMem (StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
a) (StkEl meta r -> Value' Instr r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
b))) m (StkEl meta 'TBool)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TBool : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnGET{} (StkEl meta r
a :& StkEl meta r
b :& Rec (StkEl meta) rs
r) = Value ('TOption (GetOpVal c))
-> m (StkEl meta ('TOption (GetOpVal c)))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Maybe (Value' Instr (GetOpVal c)) -> Value ('TOption (GetOpVal c))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Value' Instr (GetOpKey r)
-> Value' Instr r -> Maybe (Value' Instr (GetOpVal r))
forall (c :: T) (instr :: [T] -> [T] -> *).
GetOp c =>
Value' instr (GetOpKey c)
-> Value' instr c -> Maybe (Value' instr (GetOpVal c))
forall (instr :: [T] -> [T] -> *).
Value' instr (GetOpKey r)
-> Value' instr r -> Maybe (Value' instr (GetOpVal r))
evalGet (StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
a) (StkEl meta r -> Value' Instr r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
b))) m (StkEl meta ('TOption (GetOpVal c)))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) ('TOption (GetOpVal c) : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ (AnnGETN AnnVar
_ PeanoNatural ix
s) (StkEl Value r
pair :& Rec (StkEl meta) rs
r) = do
  Value (GetN ix pair) -> m (StkEl meta (GetN ix pair))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (PeanoNatural ix -> Value r -> Value (GetN ix r)
forall (ix :: Peano) (a :: T).
ConstraintGetN ix a =>
PeanoNatural ix -> Value a -> Value (GetN ix a)
go PeanoNatural ix
s Value r
pair) m (StkEl meta (GetN ix pair))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) (GetN ix pair : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
  where
    go
      :: forall ix a. ConstraintGetN ix a
      => PeanoNatural ix -> Value a
      -> Value (GetN ix a)
    go :: forall (ix :: Peano) (a :: T).
ConstraintGetN ix a =>
PeanoNatural ix -> Value a -> Value (GetN ix a)
go PeanoNatural ix
Zero            Value a
a                   = Value a
Value' Instr (GetN ix a)
a
    go (Succ PeanoNatural m
Zero)      (VPair (Value' Instr l
left, Value' Instr r
_))  = Value' Instr l
Value' Instr (GetN ix a)
left
    go (Succ (Succ PeanoNatural m
n')) (VPair (Value' Instr l
_, Value' Instr r
right)) = PeanoNatural m -> Value' Instr r -> Value (GetN m r)
forall (ix :: Peano) (a :: T).
ConstraintGetN ix a =>
PeanoNatural ix -> Value a -> Value (GetN ix a)
go PeanoNatural m
n' Value' Instr r
right
runInstrImpl InstrRunner meta m
_ AnnUPDATE{} (StkEl meta r
a :& StkEl meta r
b :& StkEl Value r
c :& Rec (StkEl meta) rs
r) =
  Value r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Value' Instr (UpdOpKey r)
-> Value' Instr (UpdOpParams r) -> Value r -> Value r
forall (c :: T) (instr :: [T] -> [T] -> *).
UpdOp c =>
Value' instr (UpdOpKey c)
-> Value' instr (UpdOpParams c) -> Value' instr c -> Value' instr c
forall (instr :: [T] -> [T] -> *).
Value' instr (UpdOpKey r)
-> Value' instr (UpdOpParams r) -> Value' instr r -> Value' instr r
evalUpd (StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
a) (StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
b) Value r
c) m (StkEl meta r)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) (r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ (AnnUPDATEN AnnVar
_ PeanoNatural ix
s) (StkEl (Value r
val :: Value val) :& StkEl Value r
pair :& Rec (StkEl meta) rs
r) = do
  Value (UpdateN ix val pair) -> m (StkEl meta (UpdateN ix val pair))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (PeanoNatural ix -> Value r -> Value (UpdateN ix r r)
forall (ix :: Peano) (pair :: T).
ConstraintUpdateN ix pair =>
PeanoNatural ix -> Value pair -> Value (UpdateN ix r pair)
go PeanoNatural ix
s Value r
pair) m (StkEl meta (UpdateN ix val pair))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (UpdateN ix val pair : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
  where
    go
      :: forall ix pair. ConstraintUpdateN ix pair
      => PeanoNatural ix -> Value pair -> Value (UpdateN ix val pair)
    go :: forall (ix :: Peano) (pair :: T).
ConstraintUpdateN ix pair =>
PeanoNatural ix -> Value pair -> Value (UpdateN ix r pair)
go PeanoNatural ix
Zero             Value pair
_                      = Value r
Value' Instr (UpdateN ix r pair)
val
    go (Succ PeanoNatural m
Zero)      (VPair (Value' Instr l
_, Value' Instr r
right))     = (Value r, Value' Instr r) -> Value' Instr ('TPair r r)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value r
val, Value' Instr r
right)
    go (Succ (Succ PeanoNatural m
n')) (VPair (Value' Instr l
left, Value' Instr r
right))  = (Value' Instr l, Value' Instr (UpdateN m val r))
-> Value' Instr ('TPair l (UpdateN m val r))
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value' Instr l
left, PeanoNatural m -> Value' Instr r -> Value (UpdateN m r r)
forall (ix :: Peano) (pair :: T).
ConstraintUpdateN ix pair =>
PeanoNatural ix -> Value pair -> Value (UpdateN ix r pair)
go PeanoNatural m
n' Value' Instr r
right)
runInstrImpl InstrRunner meta m
_ AnnGET_AND_UPDATE{} (StkEl Value r
key :& StkEl Value r
valMb :& StkEl Value r
collection :& Rec (StkEl meta) rs
r) = do
  StkEl meta ('TOption (GetOpVal c))
el1 <- Value ('TOption (GetOpVal c))
-> m (StkEl meta ('TOption (GetOpVal c)))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Maybe (Value' Instr (GetOpVal c)) -> Value ('TOption (GetOpVal c))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Value' Instr (GetOpKey r)
-> Value r -> Maybe (Value' Instr (GetOpVal r))
forall (c :: T) (instr :: [T] -> [T] -> *).
GetOp c =>
Value' instr (GetOpKey c)
-> Value' instr c -> Maybe (Value' instr (GetOpVal c))
forall (instr :: [T] -> [T] -> *).
Value' instr (GetOpKey r)
-> Value' instr r -> Maybe (Value' instr (GetOpVal r))
evalGet Value r
Value' Instr (GetOpKey r)
key Value r
collection))
  StkEl meta r
el2 <- Value r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Value' Instr (UpdOpKey r)
-> Value' Instr (UpdOpParams r) -> Value r -> Value r
forall (c :: T) (instr :: [T] -> [T] -> *).
UpdOp c =>
Value' instr (UpdOpKey c)
-> Value' instr (UpdOpParams c) -> Value' instr c -> Value' instr c
forall (instr :: [T] -> [T] -> *).
Value' instr (UpdOpKey r)
-> Value' instr (UpdOpParams r) -> Value' instr r -> Value' instr r
evalUpd Value r
Value' Instr (UpdOpKey r)
key Value r
Value' Instr (UpdOpParams r)
valMb Value r
collection)
  pure $ StkEl meta ('TOption (GetOpVal c))
el1 StkEl meta ('TOption (GetOpVal c))
-> Rec (StkEl meta) (r : rs)
-> Rec (StkEl meta) ('TOption (GetOpVal c) : r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StkEl meta r
el2 StkEl meta r -> Rec (StkEl meta) rs -> Rec (StkEl meta) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (IF Instr s out
bTrue Instr s out
_) (StkEl (VBool Bool
True) :& Rec (StkEl meta) rs
r) = Instr s out -> Rec (StkEl meta) s -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr s out
bTrue Rec (StkEl meta) s
Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (IF Instr s out
_ Instr s out
bFalse) (StkEl (VBool Bool
False) :& Rec (StkEl meta) rs
r) = Instr s out -> Rec (StkEl meta) s -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr s out
bFalse Rec (StkEl meta) s
Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ (LOOP Instr out ('TBool : out)
_) (StkEl (VBool Bool
False) :& Rec (StkEl meta) rs
r) = Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec (StkEl meta) out
Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (LOOP Instr out ('TBool : out)
ops) (StkEl (VBool Bool
True) :& Rec (StkEl meta) rs
r) = do
  Rec (StkEl meta) ('TBool : out)
res <- Instr out ('TBool : out)
-> Rec (StkEl meta) out -> m (Rec (StkEl meta) ('TBool : out))
InstrRunner meta m
runner Instr out ('TBool : out)
ops Rec (StkEl meta) out
Rec (StkEl meta) rs
r
  InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
EvalM' ext m =>
InstrRunner meta m -> InstrRunner meta m
withMetaWrapper Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner (Instr out ('TBool : out) -> Instr ('TBool : out) out
forall (out :: [T]).
Instr out ('TBool : out) -> Instr ('TBool : out) out
LOOP Instr out ('TBool : out)
ops) Rec (StkEl meta) ('TBool : out)
res
runInstrImpl InstrRunner meta m
_ (LOOP_LEFT Instr (a : s) ('TOr a b : s)
_) (StkEl (VOr (Right Value' Instr r
a)) :& Rec (StkEl meta) rs
r) = Value' Instr r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr r
a m (StkEl meta r)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) (r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (LOOP_LEFT Instr (a : s) ('TOr a b : s)
ops) (StkEl (VOr (Left Value' Instr l
a)) :& Rec (StkEl meta) rs
r) = do
  Rec (StkEl meta) ('TOr a b : s)
res <- Instr (a : s) ('TOr a b : s)
-> Rec (StkEl meta) (a : s) -> m (Rec (StkEl meta) ('TOr a b : s))
InstrRunner meta m
runner Instr (a : s) ('TOr a b : s)
ops (Rec (StkEl meta) (a : s) -> m (Rec (StkEl meta) ('TOr a b : s)))
-> m (Rec (StkEl meta) (a : s))
-> m (Rec (StkEl meta) ('TOr a b : s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value a -> m (StkEl meta a)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value a
Value' Instr l
a m (StkEl meta a)
-> Rec (StkEl meta) s -> m (Rec (StkEl meta) (a : s))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) s
Rec (StkEl meta) rs
r
  InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
EvalM' ext m =>
InstrRunner meta m -> InstrRunner meta m
withMetaWrapper Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner (Instr (a : s) ('TOr a b : s) -> Instr ('TOr a b : s) (b : s)
forall (a :: T) (s :: [T]) (b :: T).
Instr (a : s) ('TOr a b : s) -> Instr ('TOr a b : s) (b : s)
LOOP_LEFT Instr (a : s) ('TOr a b : s)
ops) Rec (StkEl meta) ('TOr a b : s)
res
runInstrImpl InstrRunner meta m
_ (AnnLAMBDA Anns '[VarAnn, Notes i, Notes o]
_ RemFail Instr '[i] '[o]
lam) Rec (StkEl meta) inp
r = Value ('TLambda i o) -> m (StkEl meta ('TLambda i o))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl ((IsNotInView => RemFail Instr '[i] '[o]) -> Value ('TLambda i o)
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(SingI inp, SingI 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)) =>
(IsNotInView => RemFail instr '[inp] '[out])
-> Value' instr ('TLambda inp out)
mkVLam RemFail Instr '[i] '[o]
IsNotInView => RemFail Instr '[i] '[o]
lam) m (StkEl meta ('TLambda i o))
-> Rec (StkEl meta) inp
-> m (Rec (StkEl meta) ('TLambda i o : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ (AnnLAMBDA_REC Anns '[VarAnn, Notes i, Notes o]
_ RemFail Instr '[i, 'TLambda i o] '[o]
lam) Rec (StkEl meta) inp
r = Value ('TLambda i o) -> m (StkEl meta ('TLambda i o))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl ((IsNotInView => RemFail Instr '[i, 'TLambda i o] '[o])
-> Value ('TLambda i o)
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(SingI inp, SingI 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)) =>
(IsNotInView => RemFail instr '[inp, 'TLambda inp out] '[out])
-> Value' instr ('TLambda inp out)
mkVLamRec RemFail Instr '[i, 'TLambda i o] '[o]
IsNotInView => RemFail Instr '[i, 'TLambda i o] '[o]
lam) m (StkEl meta ('TLambda i o))
-> Rec (StkEl meta) inp
-> m (Rec (StkEl meta) ('TLambda i o : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
runner AnnEXEC{} (StkEl meta r
a :& self :: StkEl meta r
self@(StkEl (VLam LambdaCode' Instr inp out
code)) :& Rec (StkEl meta) rs
r) =
  case LambdaCode' Instr inp out
code of
    LambdaCode (RemFail Instr '[inp] '[out] -> Instr '[inp] '[out]
forall {k} (instr :: k -> k -> *) (i :: k) (o :: k).
RemFail instr i o -> instr i o
rfAnyInstr -> Instr '[inp] '[out]
lBody) -> do
      Rec (StkEl meta) '[out]
res <- Instr '[inp] '[out]
-> Rec (StkEl meta) '[inp] -> m (Rec (StkEl meta) '[out])
InstrRunner meta m
runner Instr '[inp] '[out]
lBody (StkEl meta r
StkEl meta inp
a StkEl meta inp -> Rec (StkEl meta) '[] -> Rec (StkEl meta) '[inp]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil)
      pure $ Rec (StkEl meta) '[out]
res Rec (StkEl meta) '[out]
-> Rec (StkEl meta) rs -> Rec (StkEl meta) ('[out] ++ rs)
forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec (StkEl meta) rs
r
    LambdaCodeRec (RemFail Instr '[inp, 'TLambda inp out] '[out]
-> Instr '[inp, 'TLambda inp out] '[out]
forall {k} (instr :: k -> k -> *) (i :: k) (o :: k).
RemFail instr i o -> instr i o
rfAnyInstr -> Instr '[inp, 'TLambda inp out] '[out]
lBody) -> do
      Rec (StkEl meta) '[out]
res <- Instr '[inp, 'TLambda inp out] '[out]
-> Rec (StkEl meta) '[inp, 'TLambda inp out]
-> m (Rec (StkEl meta) '[out])
InstrRunner meta m
runner Instr '[inp, 'TLambda inp out] '[out]
lBody (StkEl meta r
StkEl meta inp
a StkEl meta inp
-> Rec (StkEl meta) '[ 'TLambda inp out]
-> Rec (StkEl meta) '[inp, 'TLambda inp out]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StkEl meta r
StkEl meta ('TLambda inp out)
self StkEl meta ('TLambda inp out)
-> Rec (StkEl meta) '[] -> Rec (StkEl meta) '[ 'TLambda inp out]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil)
      pure $ Rec (StkEl meta) '[out]
res Rec (StkEl meta) '[out]
-> Rec (StkEl meta) rs -> Rec (StkEl meta) ('[out] ++ rs)
forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ i :: Instr inp out
i@AnnAPPLY{} (StkEl (Value r
a :: Value a) :& StkEl (VLam LambdaCode' Instr inp out
code) :& Rec (StkEl meta) rs
r)
  | Instr (r : 'TLambda ('TPair r b) out : s) ('TLambda b out : s)
_ :: Instr (a : 'TLambda ('TPair a b) c : s) ('TLambda b c : s) <- Instr inp out
i
  , LambdaCode' Instr ('TPair r b) out
_ :: LambdaCode' Instr ('TPair a b) c <- LambdaCode' Instr inp out
code
  = case LambdaCode' Instr inp out
code of
      LambdaCode RemFail Instr '[inp] '[out]
lBody -> Value ('TLambda b out) -> m (StkEl meta ('TLambda b out))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (LambdaCode' Instr b out -> Value ('TLambda b out)
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(SingI inp, SingI out) =>
LambdaCode' instr inp out -> Value' instr ('TLambda inp out)
VLam (LambdaCode' Instr b out -> Value ('TLambda b out))
-> LambdaCode' Instr b out -> Value ('TLambda b out)
forall a b. (a -> b) -> a -> b
$ RemFail Instr '[b] '[out] -> LambdaCode' Instr b out
forall (instr :: [T] -> [T] -> *) (inp :: T) (out :: T).
(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] -> LambdaCode' instr inp out
LambdaCode ((forall (o' :: [T]). Instr '[inp] o' -> Instr '[b] o')
-> RemFail Instr '[inp] '[out] -> RemFail Instr '[b] '[out]
forall {k} (instr :: k -> k -> *) (i1 :: k) (i2 :: k) (o :: k).
(forall (o' :: k). instr i1 o' -> instr i2 o')
-> RemFail instr i1 o -> RemFail instr i2 o
rfMapAnyInstr Instr '[inp] o' -> Instr '[b] o'
Instr '[ 'TPair r b] o' -> Instr '[b] o'
forall (o' :: [T]). Instr '[inp] o' -> Instr '[b] o'
forall (i :: T) (s :: [T]) (o :: [T]).
Instr ('TPair r i : s) o -> Instr (i : s) o
doApply RemFail Instr '[inp] '[out]
lBody)) m (StkEl meta ('TLambda b out))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) ('TLambda b out : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
      LambdaCodeRec RemFail Instr '[inp, 'TLambda inp out] '[out]
lBody ->
        let res :: RemFail Instr '[b] '[c]
res = Instr '[b] '[c] -> RemFail Instr '[b] '[c]
forall {k} (instr :: k -> k -> *) (i :: k) (o :: k).
instr i o -> RemFail instr i o
RfNormal (Instr '[b] '[c] -> RemFail Instr '[b] '[c])
-> Instr '[b] '[c] -> RemFail Instr '[b] '[c]
forall a b. (a -> b) -> a -> b
$ Value r -> Instr '[b] '[a, b]
forall {inp :: [T]} {out :: [T]} (t :: T) (s :: [T]).
(inp ~ s, out ~ (t : s), ConstantScope t) =>
Value' Instr t -> Instr inp out
PUSH Value r
a Instr '[b] '[a, b] -> Instr '[a, b] '[c] -> Instr '[b] '[c]
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr '[a, b] '[ 'TPair a b]
forall {inp :: [T]} {out :: [T]} (a :: T) (b :: T) (s :: [T]).
(inp ~ (a : b : s), out ~ ('TPair a b : s)) =>
Instr inp out
PAIR Instr '[a, b] '[ 'TPair a b]
-> Instr '[ 'TPair a b] '[c] -> Instr '[a, b] '[c]
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` (IsNotInView =>
 RemFail Instr '[ 'TPair a b, 'TLambda ('TPair a b) c] '[c])
-> Instr '[ 'TPair a b] '[ 'TLambda ('TPair a b) c, 'TPair a b]
forall (s :: [T]) (r :: [T]) (i :: T) (o :: T).
(SingI i, SingI o, r ~ ('TLambda i o : s)) =>
(IsNotInView => RemFail Instr '[i, 'TLambda i o] '[o]) -> Instr s r
LAMBDA_REC RemFail Instr '[inp, 'TLambda inp out] '[out]
RemFail Instr '[ 'TPair a b, 'TLambda ('TPair a b) c] '[c]
IsNotInView =>
RemFail Instr '[ 'TPair a b, 'TLambda ('TPair a b) c] '[c]
lBody Instr '[ 'TPair a b] '[ 'TLambda ('TPair a b) c, 'TPair a b]
-> Instr '[ 'TLambda ('TPair a b) c, 'TPair a b] '[c]
-> Instr '[ 'TPair a b] '[c]
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr
  '[ 'TLambda ('TPair a b) c, 'TPair a b]
  '[ 'TPair a b, 'TLambda ('TPair a b) c]
forall (a :: T) (b :: T) (s :: [T]). Instr (a : b : s) (b : a : s)
SWAP Instr
  '[ 'TLambda ('TPair a b) c, 'TPair a b]
  '[ 'TPair a b, 'TLambda ('TPair a b) c]
-> Instr '[ 'TPair a b, 'TLambda ('TPair a b) c] '[c]
-> Instr '[ 'TLambda ('TPair a b) c, 'TPair a b] '[c]
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr '[ 'TPair a b, 'TLambda ('TPair a b) c] '[c]
forall {inp :: [T]} {out :: [T]} (t1 :: T) (t2 :: T) (s :: [T]).
(inp ~ (t1 : 'TLambda t1 t2 : s), out ~ (t2 : s)) =>
Instr inp out
EXEC
        in Value ('TLambda b c) -> m (StkEl meta ('TLambda b c))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (LambdaCode' Instr b c -> Value ('TLambda b c)
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(SingI inp, SingI out) =>
LambdaCode' instr inp out -> Value' instr ('TLambda inp out)
VLam (LambdaCode' Instr b c -> Value ('TLambda b c))
-> LambdaCode' Instr b c -> Value ('TLambda b c)
forall a b. (a -> b) -> a -> b
$ RemFail Instr '[b] '[c] -> LambdaCode' Instr b c
forall (instr :: [T] -> [T] -> *) (inp :: T) (out :: T).
(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] -> LambdaCode' instr inp out
LambdaCode RemFail Instr '[b] '[c]
res) m (StkEl meta ('TLambda b c))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TLambda b c : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
  where
    doApply :: Instr ('TPair a i ': s) o -> Instr (i ': s) o
    doApply :: forall (i :: T) (s :: [T]) (o :: [T]).
Instr ('TPair r i : s) o -> Instr (i : s) o
doApply Instr ('TPair r i : s) o
b = Value r -> Instr (i : s) (a : i : s)
forall {inp :: [T]} {out :: [T]} (t :: T) (s :: [T]).
(inp ~ s, out ~ (t : s), ConstantScope t) =>
Value' Instr t -> Instr inp out
PUSH Value r
a Instr (i : s) (a : i : s) -> Instr (a : i : s) o -> Instr (i : s) o
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr (a : i : s) ('TPair r i : s)
forall {inp :: [T]} {out :: [T]} (a :: T) (b :: T) (s :: [T]).
(inp ~ (a : b : s), out ~ ('TPair a b : s)) =>
Instr inp out
PAIR Instr (a : i : s) ('TPair r i : s)
-> Instr ('TPair r i : s) o -> Instr (a : i : s) o
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr ('TPair r i : s) o -> Instr ('TPair r i : s) o
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
Nested Instr ('TPair r i : s) o
b
runInstrImpl InstrRunner meta m
runner (DIP Instr a c
i) (StkEl meta r
a :& Rec (StkEl meta) rs
r) = do
  Rec (StkEl meta) c
res <- Instr a c -> Rec (StkEl meta) a -> m (Rec (StkEl meta) c)
InstrRunner meta m
runner Instr a c
i Rec (StkEl meta) a
Rec (StkEl meta) rs
r
  pure $ StkEl meta r
a StkEl meta r -> Rec (StkEl meta) c -> Rec (StkEl meta) (r : c)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) c
res
runInstrImpl InstrRunner meta m
runner (DIPN PeanoNatural n
s Instr s s'
i) Rec (StkEl meta) inp
stack =
  case PeanoNatural n
s of
    PeanoNatural n
Zero -> Instr s out -> Rec (StkEl meta) s -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr s out
Instr s s'
i Rec (StkEl meta) inp
Rec (StkEl meta) s
stack
    Succ PeanoNatural m
s' -> case Rec (StkEl meta) inp
stack of
      (StkEl meta r
a :& Rec (StkEl meta) rs
r) -> (StkEl meta r
a StkEl meta r
-> Rec (StkEl meta) (LazyTake m (LazyTake m (Tail inp) ++ s) ++ s')
-> Rec
     (StkEl meta) (r : (LazyTake m (LazyTake m (Tail inp) ++ s) ++ s'))
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:&) (Rec (StkEl meta) (LazyTake m (LazyTake m (Tail inp) ++ s) ++ s')
 -> Rec (StkEl meta) out)
-> m (Rec
        (StkEl meta) (LazyTake m (LazyTake m (Tail inp) ++ s) ++ s'))
-> m (Rec (StkEl meta) out)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner (PeanoNatural m
-> Instr s s'
-> Instr rs (LazyTake m (LazyTake m (Tail inp) ++ s) ++ s')
forall (n :: Peano) (inp :: [T]) (out :: [T]) (s :: [T])
       (s' :: [T]).
ConstraintDIPN n inp out s s' =>
PeanoNatural n -> Instr s s' -> Instr inp out
DIPN PeanoNatural m
s' Instr s s'
i) Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ Instr inp out
FAILWITH (StkEl meta r
a :& Rec (StkEl meta) rs
_) = MichelsonFailed ext -> m (Rec (StkEl meta) out)
forall ext (m :: * -> *) a.
EvalM' ext m =>
MichelsonFailed ext -> m a
throwMichelson (MichelsonFailed ext -> m (Rec (StkEl meta) out))
-> MichelsonFailed ext -> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$ Value r -> MichelsonFailed ext
forall (n :: T) ext.
(SingI n, ConstantScope n) =>
Value n -> MichelsonFailed ext
MichelsonFailedWith (StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
a)
runInstrImpl InstrRunner meta m
_ AnnCAST{} Rec (StkEl meta) inp
s = Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec (StkEl meta) inp
Rec (StkEl meta) out
s
runInstrImpl InstrRunner meta m
_ AnnRENAME{} Rec (StkEl meta) inp
s = Rec (StkEl meta) out -> m (Rec (StkEl meta) out)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec (StkEl meta) inp
Rec (StkEl meta) out
s
runInstrImpl InstrRunner meta m
_ AnnPACK{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
r) = Value 'TBytes -> m (StkEl meta 'TBytes)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (ByteString -> Value 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString -> Value 'TBytes) -> ByteString -> Value 'TBytes
forall a b. (a -> b) -> a -> b
$ Value r -> ByteString
forall (t :: T). PackedValScope t => Value t -> ByteString
packValue' Value r
a) m (StkEl meta 'TBytes)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TBytes : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnUNPACK{} (StkEl (VBytes ByteString
a) :& Rec (StkEl meta) rs
r) =
  Value ('TOption a) -> m (StkEl meta ('TOption a))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Maybe (Value' Instr a) -> Value ('TOption a)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' Instr a) -> Value ('TOption a))
-> (Either UnpackError (Value' Instr a) -> Maybe (Value' Instr a))
-> Either UnpackError (Value' Instr a)
-> Value ('TOption a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either UnpackError (Value' Instr a) -> Maybe (Value' Instr a)
forall l r. Either l r -> Maybe r
rightToMaybe (Either UnpackError (Value' Instr a) -> Value ('TOption a))
-> Either UnpackError (Value' Instr a) -> Value ('TOption a)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnpackError (Value' Instr a)
forall (t :: T).
UnpackedValScope t =>
ByteString -> Either UnpackError (Value t)
runUnpack ByteString
a) m (StkEl meta ('TOption a))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TOption a : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnCONCAT{} (StkEl meta r
a :& StkEl meta r
b :& Rec (StkEl meta) rs
r) = Value r -> m (StkEl meta r)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Value r -> Value r -> Value r
forall (c :: T) (instr :: [T] -> [T] -> *).
ConcatOp c =>
Value' instr c -> Value' instr c -> Value' instr c
forall (instr :: [T] -> [T] -> *).
Value' instr r -> Value' instr r -> Value' instr r
evalConcat (StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
a) (StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta r
StkEl meta r
b)) m (StkEl meta r)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) (r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnCONCAT'{} (StkEl (VList [Value' Instr t1]
a) :& Rec (StkEl meta) rs
r) = Value' Instr t1 -> m (StkEl meta t1)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl ([Value' Instr t1] -> Value' Instr t1
forall (c :: T) (instr :: [T] -> [T] -> *).
ConcatOp c =>
[Value' instr c] -> Value' instr c
forall (instr :: [T] -> [T] -> *).
[Value' instr t1] -> Value' instr t1
evalConcat' [Value' Instr t1]
a) m (StkEl meta t1)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) (t1 : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnSLICE{} (StkEl (VNat Natural
o) :& StkEl (VNat Natural
l) :& StkEl Value r
s :& Rec (StkEl meta) rs
r) =
  Value ('TOption r) -> m (StkEl meta ('TOption r))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Maybe (Value r) -> Value ('TOption r)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Natural -> Natural -> Value r -> Maybe (Value r)
forall (c :: T) (instr :: [T] -> [T] -> *).
SliceOp c =>
Natural -> Natural -> Value' instr c -> Maybe (Value' instr c)
forall (instr :: [T] -> [T] -> *).
Natural -> Natural -> Value' instr r -> Maybe (Value' instr r)
evalSlice Natural
o Natural
l Value r
s)) m (StkEl meta ('TOption r))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TOption r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnISNAT{} (StkEl (VInt Integer
i) :& Rec (StkEl meta) rs
r) =
  if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
  then Value ('TOption 'TNat) -> m (StkEl meta ('TOption 'TNat))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Maybe (Value 'TNat) -> Value ('TOption 'TNat)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption Maybe (Value 'TNat)
forall a. Maybe a
Nothing) m (StkEl meta ('TOption 'TNat))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) ('TOption 'TNat : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
  else Value ('TOption 'TNat) -> m (StkEl meta ('TOption 'TNat))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Maybe (Value 'TNat) -> Value ('TOption 'TNat)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Value 'TNat -> Maybe (Value 'TNat)
forall a. a -> Maybe a
Just (Natural -> Value 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Natural -> Value 'TNat) -> Natural -> Value 'TNat
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. (HasCallStack, Integral a) => Integer -> a
fromInteger Integer
i))) m (StkEl meta ('TOption 'TNat))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) ('TOption 'TNat : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnADD{} (StkEl meta r
l :& StkEl meta r
r :& Rec (StkEl meta) rs
rest) = Proxy Add
-> StkEl meta r
-> StkEl meta r
-> m (StkEl meta (ArithRes Add r r))
forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Add) StkEl meta r
l StkEl meta r
r m (StkEl meta (ArithRes Add n m))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (ArithRes Add n m : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnSUB{} (StkEl meta r
l :& StkEl meta r
r :& Rec (StkEl meta) rs
rest) = Proxy Sub
-> StkEl meta r
-> StkEl meta r
-> m (StkEl meta (ArithRes Sub r r))
forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Sub) StkEl meta r
l StkEl meta r
r m (StkEl meta (ArithRes Sub n m))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (ArithRes Sub n m : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnSUB_MUTEZ{} (StkEl meta r
l :& StkEl meta r
r :& Rec (StkEl meta) rs
rest) = Proxy SubMutez
-> StkEl meta r
-> StkEl meta r
-> m (StkEl meta (ArithRes SubMutez r r))
forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SubMutez) StkEl meta r
l StkEl meta r
r m (StkEl meta ('TOption 'TMutez))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) ('TOption 'TMutez : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnMUL{} (StkEl meta r
l :& StkEl meta r
r :& Rec (StkEl meta) rs
rest) = Proxy Mul
-> StkEl meta r
-> StkEl meta r
-> m (StkEl meta (ArithRes Mul r r))
forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Mul) StkEl meta r
l StkEl meta r
r m (StkEl meta (ArithRes Mul n m))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (ArithRes Mul n m : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnEDIV{} (StkEl meta r
l :& StkEl meta r
r :& Rec (StkEl meta) rs
rest) = Proxy EDiv
-> StkEl meta r
-> StkEl meta r
-> m (StkEl meta (ArithRes EDiv r r))
forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @EDiv) StkEl meta r
l StkEl meta r
r m (StkEl meta (ArithRes EDiv n m))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (ArithRes EDiv n m : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnABS{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
rest) =
  Value (UnaryArithRes Abs n) -> m (StkEl meta (UnaryArithRes Abs n))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Proxy Abs -> Value r -> Value' Instr (UnaryArithRes Abs r)
forall {k} (aop :: k) (n :: T) (proxy :: k -> *)
       (instr :: [T] -> [T] -> *).
UnaryArithOp aop n =>
proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n)
forall (proxy :: * -> *) (instr :: [T] -> [T] -> *).
proxy Abs -> Value' instr r -> Value' instr (UnaryArithRes Abs r)
evalUnaryArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Abs) Value r
a) m (StkEl meta (UnaryArithRes Abs n))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (UnaryArithRes Abs n : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnNEG{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
rest) =
  Value (UnaryArithRes Neg n) -> m (StkEl meta (UnaryArithRes Neg n))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Proxy Neg -> Value r -> Value' Instr (UnaryArithRes Neg r)
forall {k} (aop :: k) (n :: T) (proxy :: k -> *)
       (instr :: [T] -> [T] -> *).
UnaryArithOp aop n =>
proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n)
forall (proxy :: * -> *) (instr :: [T] -> [T] -> *).
proxy Neg -> Value' instr r -> Value' instr (UnaryArithRes Neg r)
evalUnaryArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Neg) Value r
a) m (StkEl meta (UnaryArithRes Neg n))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (UnaryArithRes Neg n : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnLSL{} (StkEl meta r
x :& StkEl meta r
s :& Rec (StkEl meta) rs
rest) = Proxy Lsl
-> StkEl meta r
-> StkEl meta r
-> m (StkEl meta (ArithRes Lsl r r))
forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Lsl) StkEl meta r
x StkEl meta r
s m (StkEl meta (ArithRes Lsl n m))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (ArithRes Lsl n m : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnLSR{} (StkEl meta r
x :& StkEl meta r
s :& Rec (StkEl meta) rs
rest) = Proxy Lsr
-> StkEl meta r
-> StkEl meta r
-> m (StkEl meta (ArithRes Lsr r r))
forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Lsr) StkEl meta r
x StkEl meta r
s m (StkEl meta (ArithRes Lsr n m))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (ArithRes Lsr n m : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnOR{} (StkEl meta r
l :& StkEl meta r
r :& Rec (StkEl meta) rs
rest) = Proxy Or
-> StkEl meta r -> StkEl meta r -> m (StkEl meta (ArithRes Or r r))
forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Or) StkEl meta r
l StkEl meta r
r m (StkEl meta (ArithRes Or n m))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (ArithRes Or n m : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnAND{} (StkEl meta r
l :& StkEl meta r
r :& Rec (StkEl meta) rs
rest) = Proxy And
-> StkEl meta r
-> StkEl meta r
-> m (StkEl meta (ArithRes And r r))
forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @And) StkEl meta r
l StkEl meta r
r m (StkEl meta (ArithRes And n m))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (ArithRes And n m : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnXOR{} (StkEl meta r
l :& StkEl meta r
r :& Rec (StkEl meta) rs
rest) = Proxy Xor
-> StkEl meta r
-> StkEl meta r
-> m (StkEl meta (ArithRes Xor r r))
forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Xor) StkEl meta r
l StkEl meta r
r m (StkEl meta (ArithRes Xor n m))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (ArithRes Xor n m : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnNOT{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
rest) =
  Value (UnaryArithRes Not n) -> m (StkEl meta (UnaryArithRes Not n))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Proxy Not -> Value r -> Value' Instr (UnaryArithRes Not r)
forall {k} (aop :: k) (n :: T) (proxy :: k -> *)
       (instr :: [T] -> [T] -> *).
UnaryArithOp aop n =>
proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n)
forall (proxy :: * -> *) (instr :: [T] -> [T] -> *).
proxy Not -> Value' instr r -> Value' instr (UnaryArithRes Not r)
evalUnaryArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Not) Value r
a) m (StkEl meta (UnaryArithRes Not n))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (UnaryArithRes Not n : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnCOMPARE{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
l) :& (StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
r) :& Rec (StkEl meta) rs
rest) =
  Value 'TInt -> m (StkEl meta 'TInt)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Integer -> Value 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt (Value r -> Value r -> Integer
forall (t :: T) (i :: [T] -> [T] -> *).
Comparable t =>
Value' i t -> Value' i t -> Integer
compareOp Value r
l Value r
Value r
r)) m (StkEl meta 'TInt)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TInt : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnEQ{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
rest) =
  Value (UnaryArithRes Eq' n) -> m (StkEl meta (UnaryArithRes Eq' n))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Proxy Eq' -> Value r -> Value' Instr (UnaryArithRes Eq' r)
forall {k} (aop :: k) (n :: T) (proxy :: k -> *)
       (instr :: [T] -> [T] -> *).
UnaryArithOp aop n =>
proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n)
forall (proxy :: * -> *) (instr :: [T] -> [T] -> *).
proxy Eq' -> Value' instr r -> Value' instr (UnaryArithRes Eq' r)
evalUnaryArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Eq') Value r
a) m (StkEl meta (UnaryArithRes Eq' n))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (UnaryArithRes Eq' n : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnNEQ{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
rest) =
  Value (UnaryArithRes Neq n) -> m (StkEl meta (UnaryArithRes Neq n))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Proxy Neq -> Value r -> Value' Instr (UnaryArithRes Neq r)
forall {k} (aop :: k) (n :: T) (proxy :: k -> *)
       (instr :: [T] -> [T] -> *).
UnaryArithOp aop n =>
proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n)
forall (proxy :: * -> *) (instr :: [T] -> [T] -> *).
proxy Neq -> Value' instr r -> Value' instr (UnaryArithRes Neq r)
evalUnaryArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Neq) Value r
a) m (StkEl meta (UnaryArithRes Neq n))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (UnaryArithRes Neq n : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnLT{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
rest) =
  Value (UnaryArithRes Lt n) -> m (StkEl meta (UnaryArithRes Lt n))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Proxy Lt -> Value r -> Value' Instr (UnaryArithRes Lt r)
forall {k} (aop :: k) (n :: T) (proxy :: k -> *)
       (instr :: [T] -> [T] -> *).
UnaryArithOp aop n =>
proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n)
forall (proxy :: * -> *) (instr :: [T] -> [T] -> *).
proxy Lt -> Value' instr r -> Value' instr (UnaryArithRes Lt r)
evalUnaryArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Lt) Value r
a) m (StkEl meta (UnaryArithRes Lt n))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (UnaryArithRes Lt n : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnGT{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
rest) =
  Value (UnaryArithRes Gt n) -> m (StkEl meta (UnaryArithRes Gt n))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Proxy Gt -> Value r -> Value' Instr (UnaryArithRes Gt r)
forall {k} (aop :: k) (n :: T) (proxy :: k -> *)
       (instr :: [T] -> [T] -> *).
UnaryArithOp aop n =>
proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n)
forall (proxy :: * -> *) (instr :: [T] -> [T] -> *).
proxy Gt -> Value' instr r -> Value' instr (UnaryArithRes Gt r)
evalUnaryArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Gt) Value r
a) m (StkEl meta (UnaryArithRes Gt n))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (UnaryArithRes Gt n : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnLE{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
rest) =
  Value (UnaryArithRes Le n) -> m (StkEl meta (UnaryArithRes Le n))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Proxy Le -> Value r -> Value' Instr (UnaryArithRes Le r)
forall {k} (aop :: k) (n :: T) (proxy :: k -> *)
       (instr :: [T] -> [T] -> *).
UnaryArithOp aop n =>
proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n)
forall (proxy :: * -> *) (instr :: [T] -> [T] -> *).
proxy Le -> Value' instr r -> Value' instr (UnaryArithRes Le r)
evalUnaryArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Le) Value r
a) m (StkEl meta (UnaryArithRes Le n))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (UnaryArithRes Le n : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnGE{} ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r
a) :& Rec (StkEl meta) rs
rest) =
  Value (UnaryArithRes Ge n) -> m (StkEl meta (UnaryArithRes Ge n))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Proxy Ge -> Value r -> Value' Instr (UnaryArithRes Ge r)
forall {k} (aop :: k) (n :: T) (proxy :: k -> *)
       (instr :: [T] -> [T] -> *).
UnaryArithOp aop n =>
proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n)
forall (proxy :: * -> *) (instr :: [T] -> [T] -> *).
proxy Ge -> Value' instr r -> Value' instr (UnaryArithRes Ge r)
evalUnaryArithOp (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Ge) Value r
a) m (StkEl meta (UnaryArithRes Ge n))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) (UnaryArithRes Ge n : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
rest
runInstrImpl InstrRunner meta m
_ AnnINT{} (StkEl Value r
a :& Rec (StkEl meta) rs
r) =
  Value 'TInt -> m (StkEl meta 'TInt)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Value r -> Value 'TInt
forall (n :: T) (instr :: [T] -> [T] -> *).
ToIntArithOp n =>
Value' instr n -> Value' instr 'TInt
forall (instr :: [T] -> [T] -> *).
Value' instr r -> Value' instr 'TInt
evalToIntOp Value r
a) m (StkEl meta 'TInt)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TInt : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnNAT{} (StkEl Value r
a :& Rec (StkEl meta) rs
r) =
  Value 'TNat -> m (StkEl meta 'TNat)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Value 'TBytes -> Value 'TNat
forall (instr :: [T] -> [T] -> *).
Value' instr 'TBytes -> Value' instr 'TNat
evalToNatOp Value r
Value 'TBytes
a) m (StkEl meta 'TNat)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TNat : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnBYTES{} (StkEl Value r
a :& Rec (StkEl meta) rs
r) =
  Value 'TBytes -> m (StkEl meta 'TBytes)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Value r -> Value 'TBytes
forall (n :: T) (instr :: [T] -> [T] -> *).
ToBytesArithOp n =>
Value' instr n -> Value' instr 'TBytes
forall (instr :: [T] -> [T] -> *).
Value' instr r -> Value' instr 'TBytes
evalToBytesOp Value r
a) m (StkEl meta 'TBytes)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TBytes : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
runner (AnnVIEW (Anns2' VarAnn
_ (Notes ret
_ :: Notes ret)) ViewName
name)
                    (StkEl (Value r
viewArg :: Value arg) :& StkEl (VAddress EpAddress
epAddr) :& Rec (StkEl meta) rs
r) = do
  Value ('TOption ret)
res :: Value ('TOption ret) <- Maybe (Value' Instr ret) -> Value ('TOption ret)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' Instr ret) -> Value ('TOption ret))
-> m (Maybe (Value' Instr ret)) -> m (Value ('TOption ret))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT m (Value' Instr ret) -> m (Maybe (Value' Instr ret))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    EpAddress addr :: KindedAddress kind
addr@ContractAddress{} EpName
_ <- EpAddress -> MaybeT m EpAddress
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpAddress
epAddr
    ContractState
      { csContract :: ()
csContract = Contract cp st
viewedContract
      , csStorage :: ()
csStorage = Value st
viewedContractStorage
      , csBalance :: ContractState -> Mutez
csBalance = Mutez
viewedContractBalance
      } <- m (Maybe ContractState) -> MaybeT m ContractState
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe ContractState) -> MaybeT m ContractState)
-> m (Maybe ContractState) -> MaybeT m ContractState
forall a b. (a -> b) -> a -> b
$ (ContractEnv' m -> ContractAddress -> m (Maybe ContractState))
-> m (ContractAddress -> m (Maybe ContractState))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceContracts m (ContractAddress -> m (Maybe ContractState))
-> ((ContractAddress -> m (Maybe ContractState))
    -> m (Maybe ContractState))
-> m (Maybe ContractState)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((KindedAddress kind -> m (Maybe ContractState))
-> KindedAddress kind -> m (Maybe ContractState)
forall a b. (a -> b) -> a -> b
$ KindedAddress kind
addr)
    View r st ret
view' <- Maybe (View r st ret) -> MaybeT m (View r st ret)
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe (View r st ret) -> MaybeT m (View r st ret))
-> Maybe (View r st ret) -> MaybeT m (View r st ret)
forall a b. (a -> b) -> a -> b
$ Either ViewLookupError (View r st ret) -> Maybe (View r st ret)
forall l r. Either l r -> Maybe r
rightToMaybe (Either ViewLookupError (View r st ret) -> Maybe (View r st ret))
-> Either ViewLookupError (View r st ret) -> Maybe (View r st ret)
forall a b. (a -> b) -> a -> b
$ Contract cp st
-> ViewName -> Either ViewLookupError (View r st ret)
forall (arg :: T) (ret :: T) (cp :: T) (st :: T).
(SingI arg, SingI ret) =>
Contract cp st
-> ViewName -> Either ViewLookupError (View arg st ret)
getViewByNameAndType Contract cp st
viewedContract ViewName
name
    let viewEnv :: ContractEnv' m -> ContractEnv' m
viewEnv ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} = ContractEnv
          { ceAmount :: Mutez
ceAmount = Mutez
zeroMutez
          , ceSelf :: ContractAddress
ceSelf = KindedAddress kind
ContractAddress
addr
          , ceSender :: L1Address
ceSender = ContractAddress -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ContractAddress
ceSelf
          , ceBalance :: Mutez
ceBalance = Mutez
viewedContractBalance
          , Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
Instr i o -> Instr i o
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSource :: L1Address
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSource :: L1Address
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..
          }
    m (Value' Instr ret) -> MaybeT m (Value' Instr ret)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Value' Instr ret) -> MaybeT m (Value' Instr ret))
-> m (Value' Instr ret) -> MaybeT m (Value' Instr ret)
forall a b. (a -> b) -> a -> b
$ InstrRunner meta m
-> (ContractEnv' m -> ContractEnv' m)
-> View r st ret
-> Value st
-> Value r
-> m (Value' Instr ret)
forall (ret :: T) (st :: T) (m :: * -> *) (arg :: T) ext
       (meta :: T -> *).
(StkElMeta meta m, EvalM' ext m) =>
(forall (inp :: [T]) (out :: [T]).
 Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out))
-> (ContractEnv' m -> ContractEnv' m)
-> View arg st ret
-> Value st
-> Value arg
-> m (Value ret)
interpretView' Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner ContractEnv' m -> ContractEnv' m
viewEnv View r st ret
view' Value st
viewedContractStorage Value r
viewArg
  Value ('TOption ret) -> m (StkEl meta ('TOption ret))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value ('TOption ret)
res m (StkEl meta ('TOption ret))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TOption ret : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r

runInstrImpl InstrRunner meta m
_ (AnnSELF AnnVar
_ SomeEntrypointCallT arg
sepc :: Instr inp out) Rec (StkEl meta) inp
r = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  case forall (t :: [T]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @out of
    (Proxy ('TContract arg : inp)
_ :: Proxy ('TContract cp ': s)) -> do
      Value ('TContract arg) -> m (StkEl meta ('TContract arg))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Address -> SomeEntrypointCallT arg -> Value ('TContract arg)
forall (arg :: T) (instr :: [T] -> [T] -> *).
(SingI arg, ForbidOp arg) =>
Address -> SomeEntrypointCallT arg -> Value' instr ('TContract arg)
VContract (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
ceSelf) SomeEntrypointCallT arg
sepc) m (StkEl meta ('TContract arg))
-> Rec (StkEl meta) inp
-> m (Rec (StkEl meta) ('TContract arg : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ (AnnCONTRACT (Anns2' VarAnn
_ (Notes p
_ :: Notes a)) EpName
instrEpName) (StkEl (VAddress EpAddress
epAddr) :& Rec (StkEl meta) rs
r) = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  case EpAddress
epAddr of
    EpAddress' (Constrained KindedAddress a
addr) EpName
addrEpName -> do
      let mepName :: Maybe EpName
mepName =
            case (EpName
instrEpName, EpName
addrEpName) of
              (EpName
DefEpName, EpName
DefEpName) -> EpName -> Maybe EpName
forall a. a -> Maybe a
Just EpName
DefEpName
              (EpName
DefEpName, EpName
en) -> EpName -> Maybe EpName
forall a. a -> Maybe a
Just EpName
en
              (EpName
en, EpName
DefEpName) -> EpName -> Maybe EpName
forall a. a -> Maybe a
Just EpName
en
              (EpName, EpName)
_ -> Maybe EpName
forall a. Maybe a
Nothing

      let withNotes :: Value ('TOption ('TContract p))
-> m (Rec (StkEl meta) ('TOption ('TContract p) : rs))
withNotes Value ('TOption ('TContract p))
v = Value ('TOption ('TContract p))
-> m (StkEl meta ('TOption ('TContract p)))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value ('TOption ('TContract p))
v m (StkEl meta ('TOption ('TContract p)))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) ('TOption ('TContract p) : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
      Value ('TOption ('TContract p)) -> m (Rec (StkEl meta) out)
Value ('TOption ('TContract p))
-> m (Rec (StkEl meta) ('TOption ('TContract p) : rs))
withNotes (Value ('TOption ('TContract p)) -> m (Rec (StkEl meta) out))
-> (Maybe (Value' Instr ('TContract p))
    -> Value ('TOption ('TContract p)))
-> Maybe (Value' Instr ('TContract p))
-> m (Rec (StkEl meta) out)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Value' Instr ('TContract p))
-> Value ('TOption ('TContract p))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' Instr ('TContract p)) -> m (Rec (StkEl meta) out))
-> m (Maybe (Value' Instr ('TContract p)))
-> m (Rec (StkEl meta) out)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case Maybe EpName
mepName of
        Maybe EpName
Nothing -> Maybe (Value' Instr ('TContract p))
-> m (Maybe (Value' Instr ('TContract p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Value' Instr ('TContract p))
forall a. Maybe a
Nothing
        Just EpName
epName -> case KindedAddress a
addr of
          ImplicitAddress{} -> Maybe (Value' Instr ('TContract p))
-> m (Maybe (Value' Instr ('TContract p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Value' Instr ('TContract p))
 -> m (Maybe (Value' Instr ('TContract p))))
-> Maybe (Value' Instr ('TContract p))
-> m (Maybe (Value' Instr ('TContract p)))
forall a b. (a -> b) -> a -> b
$ case forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
sing @a of
            STTicket{} -> KindedAddress a
-> EpName -> ParamNotes p -> Maybe (Value' Instr ('TContract p))
forall (p :: T) (kind :: AddressKind).
ParameterScope p =>
KindedAddress kind
-> EpName -> ParamNotes p -> Maybe (Value' Instr ('TContract p))
castContract KindedAddress a
addr EpName
epName (ParamNotes p -> Maybe (Value' Instr ('TContract p)))
-> ParamNotes p -> Maybe (Value' Instr ('TContract p))
forall a b. (a -> b) -> a -> b
$ forall (t :: T). SingI t => ParamNotes t
starParamNotes @a
            Sing p
SingT p
STUnit -> KindedAddress a
-> EpName -> ParamNotes p -> Maybe (Value' Instr ('TContract p))
forall (p :: T) (kind :: AddressKind).
ParameterScope p =>
KindedAddress kind
-> EpName -> ParamNotes p -> Maybe (Value' Instr ('TContract p))
castContract KindedAddress a
addr EpName
epName (ParamNotes p -> Maybe (Value' Instr ('TContract p)))
-> ParamNotes p -> Maybe (Value' Instr ('TContract p))
forall a b. (a -> b) -> a -> b
$ forall (t :: T). SingI t => ParamNotes t
starParamNotes @a
            Sing p
_ -> Maybe (Value' Instr ('TContract p))
forall a. Maybe a
Nothing
          ContractAddress{} -> MaybeT m (Value' Instr ('TContract p))
-> m (Maybe (Value' Instr ('TContract p)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
            ContractState{Contract cp st
csContract :: ()
csContract :: Contract cp st
csContract} <- m (Maybe ContractState) -> MaybeT m ContractState
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe ContractState) -> MaybeT m ContractState)
-> m (Maybe ContractState) -> MaybeT m ContractState
forall a b. (a -> b) -> a -> b
$ ContractAddress -> m (Maybe ContractState)
ceContracts KindedAddress a
ContractAddress
addr
            Maybe (Value' Instr ('TContract p))
-> MaybeT m (Value' Instr ('TContract p))
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe (Value' Instr ('TContract p))
 -> MaybeT m (Value' Instr ('TContract p)))
-> Maybe (Value' Instr ('TContract p))
-> MaybeT m (Value' Instr ('TContract p))
forall a b. (a -> b) -> a -> b
$ KindedAddress a
-> EpName -> ParamNotes cp -> Maybe (Value' Instr ('TContract p))
forall (p :: T) (kind :: AddressKind).
ParameterScope p =>
KindedAddress kind
-> EpName -> ParamNotes p -> Maybe (Value' Instr ('TContract p))
castContract KindedAddress a
addr EpName
epName (Contract cp st -> ParamNotes cp
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ParamNotes cp
cParamNotes Contract cp st
csContract)
          SmartRollupAddress{} ->
            MichelsonFailed ext -> m (Maybe (Value' Instr ('TContract p)))
forall ext (m :: * -> *) a.
EvalM' ext m =>
MichelsonFailed ext -> m a
throwMichelson (MichelsonFailed ext -> m (Maybe (Value' Instr ('TContract p))))
-> MichelsonFailed ext -> m (Maybe (Value' Instr ('TContract p)))
forall a b. (a -> b) -> a -> b
$ Text -> MichelsonFailed ext
forall ext. Text -> MichelsonFailed ext
MichelsonUnsupported Text
"sr1 addresses with CONTRACT"
  where
    castContract
      :: forall p kind. (ParameterScope p)
      => KindedAddress kind -> EpName -> ParamNotes p -> Maybe (Value ('TContract a))
    castContract :: forall (p :: T) (kind :: AddressKind).
ParameterScope p =>
KindedAddress kind
-> EpName -> ParamNotes p -> Maybe (Value' Instr ('TContract p))
castContract KindedAddress kind
addr EpName
epName ParamNotes p
param = do
      -- As we are within Maybe monad, pattern-match failure results in Nothing
      MkEntrypointCallRes (Notes arg
_ :: Notes a') EntrypointCallT p arg
epc <- EpName -> ParamNotes p -> Maybe (MkEntrypointCallRes p)
forall (param :: T).
ParameterScope param =>
EpName -> ParamNotes param -> Maybe (MkEntrypointCallRes param)
mkEntrypointCall EpName
epName ParamNotes p
param
      Right p :~: arg
Refl <- Either TcTypeError (p :~: arg)
-> Maybe (Either TcTypeError (p :~: arg))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TcTypeError (p :~: arg)
 -> Maybe (Either TcTypeError (p :~: arg)))
-> Either TcTypeError (p :~: arg)
-> Maybe (Either TcTypeError (p :~: arg))
forall a b. (a -> b) -> a -> b
$ forall (a :: T) (b :: T).
Each '[SingI] '[a, b] =>
Either TcTypeError (a :~: b)
eqType @a @a'
      Value' Instr ('TContract p) -> Maybe (Value' Instr ('TContract p))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' Instr ('TContract p)
 -> Maybe (Value' Instr ('TContract p)))
-> Value' Instr ('TContract p)
-> Maybe (Value' Instr ('TContract p))
forall a b. (a -> b) -> a -> b
$ Address -> SomeEntrypointCallT p -> Value' Instr ('TContract p)
forall (arg :: T) (instr :: [T] -> [T] -> *).
(SingI arg, ForbidOp arg) =>
Address -> SomeEntrypointCallT arg -> Value' instr ('TContract arg)
VContract (KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress KindedAddress kind
addr) (EntrypointCallT p p -> SomeEntrypointCallT p
forall (arg :: T) (param :: T).
ParameterScope param =>
EntrypointCallT param arg -> SomeEntrypointCallT arg
SomeEpc EntrypointCallT p p
EntrypointCallT p arg
epc)

runInstrImpl InstrRunner meta m
_ AnnTRANSFER_TOKENS{}
  (StkEl Value r
p :& StkEl (VMutez Mutez
mutez) :& StkEl Value r
contract :& Rec (StkEl meta) rs
r) = do
    m ()
forall (m :: * -> *). InterpreterStateMonad m => m ()
incrementCounter
    GlobalCounter
globalCounter <- InterpreterState -> GlobalCounter
isGlobalCounter (InterpreterState -> GlobalCounter)
-> m InterpreterState -> m GlobalCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InterpreterState
forall (m :: * -> *). InterpreterStateMonad m => m InterpreterState
getInterpreterState
    Value 'TOperation -> m (StkEl meta 'TOperation)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Operation -> Value 'TOperation
forall (instr :: [T] -> [T] -> *).
Operation' instr -> Value' instr 'TOperation
VOp (TransferTokens Instr r -> Operation
forall (p :: T) (instr :: [T] -> [T] -> *).
ParameterScope p =>
TransferTokens instr p -> Operation' instr
OpTransferTokens (TransferTokens Instr r -> Operation)
-> TransferTokens Instr r -> Operation
forall a b. (a -> b) -> a -> b
$ Value r
-> Mutez
-> Value' Instr ('TContract r)
-> GlobalCounter
-> TransferTokens Instr r
forall (instr :: [T] -> [T] -> *) (p :: T).
Value' instr p
-> Mutez
-> Value' instr ('TContract p)
-> GlobalCounter
-> TransferTokens instr p
TransferTokens Value r
p Mutez
mutez Value r
Value' Instr ('TContract r)
contract GlobalCounter
globalCounter)) m (StkEl meta 'TOperation)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TOperation : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnSET_DELEGATE{} (StkEl (VOption Maybe (Value' Instr t1)
mbKeyHash) :& Rec (StkEl meta) rs
r) = do
  m ()
forall (m :: * -> *). InterpreterStateMonad m => m ()
incrementCounter
  GlobalCounter
globalCounter <- InterpreterState -> GlobalCounter
isGlobalCounter (InterpreterState -> GlobalCounter)
-> m InterpreterState -> m GlobalCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InterpreterState
forall (m :: * -> *). InterpreterStateMonad m => m InterpreterState
getInterpreterState
  case Maybe (Value' Instr t1)
mbKeyHash of
    Just (VKeyHash KeyHash
k) -> Value 'TOperation -> m (StkEl meta 'TOperation)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Operation -> Value 'TOperation
forall (instr :: [T] -> [T] -> *).
Operation' instr -> Value' instr 'TOperation
VOp (SetDelegate -> Operation
forall (instr :: [T] -> [T] -> *). SetDelegate -> Operation' instr
OpSetDelegate (SetDelegate -> Operation) -> SetDelegate -> Operation
forall a b. (a -> b) -> a -> b
$ Maybe KeyHash -> GlobalCounter -> SetDelegate
SetDelegate (KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
Just KeyHash
k) GlobalCounter
globalCounter)) m (StkEl meta 'TOperation)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TOperation : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
    Maybe (Value' Instr t1)
Nothing -> Value 'TOperation -> m (StkEl meta 'TOperation)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Operation -> Value 'TOperation
forall (instr :: [T] -> [T] -> *).
Operation' instr -> Value' instr 'TOperation
VOp (SetDelegate -> Operation
forall (instr :: [T] -> [T] -> *). SetDelegate -> Operation' instr
OpSetDelegate (SetDelegate -> Operation) -> SetDelegate -> Operation
forall a b. (a -> b) -> a -> b
$ Maybe KeyHash -> GlobalCounter -> SetDelegate
SetDelegate Maybe KeyHash
forall a. Maybe a
Nothing GlobalCounter
globalCounter)) m (StkEl meta 'TOperation)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TOperation : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ (AnnCREATE_CONTRACT Anns '[VarAnn, VarAnn]
_ Contract' Instr p g
contract)
  (StkEl (VOption Maybe (Value' Instr t1)
mbKeyHash) :& StkEl (VMutez Mutez
m) :& StkEl Value r
g :& Rec (StkEl meta) rs
r) = do
  ContractAddress
originator <- ContractEnv' m -> ContractAddress
forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSelf (ContractEnv' m -> ContractAddress)
-> m (ContractEnv' m) -> m ContractAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Maybe OperationHash
opHash <- ContractEnv' m -> Maybe OperationHash
forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceOperationHash (ContractEnv' m -> Maybe OperationHash)
-> m (ContractEnv' m) -> m (Maybe OperationHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  m ()
forall (m :: * -> *). InterpreterStateMonad m => m ()
incrementCounter
  GlobalCounter
globalCounter <- InterpreterState -> GlobalCounter
isGlobalCounter (InterpreterState -> GlobalCounter)
-> m InterpreterState -> m GlobalCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InterpreterState
forall (m :: * -> *). InterpreterStateMonad m => m InterpreterState
getInterpreterState
  let resAddr :: ContractAddress
resAddr =
        case Maybe OperationHash
opHash of
          Just OperationHash
hash -> OperationHash -> GlobalCounter -> ContractAddress
mkContractAddress OperationHash
hash GlobalCounter
globalCounter
          Maybe OperationHash
Nothing ->
            OperationHash -> GlobalCounter -> ContractAddress
mkContractAddress
              (OriginationOperation -> OperationHash
mkOriginationOperationHash (OriginationOperation -> OperationHash)
-> OriginationOperation -> OperationHash
forall a b. (a -> b) -> a -> b
$
                  ContractAddress
-> Maybe ContractAlias
-> Maybe (Value 'TKeyHash)
-> Mutez
-> Contract' Instr p g
-> Value' Instr g
-> GlobalCounter
-> OriginationOperation
forall (param :: T) (store :: T) (kind :: AddressKind).
(ParameterScope param, StorageScope store, L1AddressKind kind) =>
KindedAddress kind
-> Maybe ContractAlias
-> Maybe (Value 'TKeyHash)
-> Mutez
-> Contract param store
-> Value' Instr store
-> GlobalCounter
-> OriginationOperation
createOrigOp ContractAddress
originator Maybe ContractAlias
forall a. Maybe a
Nothing Maybe (Value' Instr t1)
Maybe (Value 'TKeyHash)
mbKeyHash Mutez
m Contract' Instr p g
contract Value' Instr g
Value r
g GlobalCounter
globalCounter
              )
              -- If opHash is Nothing it means that interpreter is running in some kind of test
              -- context, therefore we generate dummy contract address with its own origination
              -- operation.
              GlobalCounter
globalCounter
  let resEpAddr :: EpAddress
resEpAddr = ContractAddress -> EpName -> EpAddress
forall (kind :: AddressKind).
KindedAddress kind -> EpName -> EpAddress
EpAddress ContractAddress
resAddr EpName
DefEpName
  let resOp :: CreateContract Instr p r
resOp = L1Address
-> Maybe KeyHash
-> Mutez
-> Value r
-> Contract' Instr p r
-> GlobalCounter
-> CreateContract Instr p r
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(forall (i :: [T]) (o :: [T]). Show (instr i o),
 forall (i :: [T]) (o :: [T]). Eq (instr i o)) =>
L1Address
-> Maybe KeyHash
-> Mutez
-> Value' instr st
-> Contract' instr cp st
-> GlobalCounter
-> CreateContract instr cp st
CreateContract
        (ContractAddress -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained ContractAddress
originator) (Maybe (Value 'TKeyHash) -> Maybe KeyHash
unwrapMbKeyHash Maybe (Value' Instr t1)
Maybe (Value 'TKeyHash)
mbKeyHash) Mutez
m Value r
g Contract' Instr p g
Contract' Instr p r
contract GlobalCounter
globalCounter
  StkEl meta 'TOperation
el1 <- Value 'TOperation -> m (StkEl meta 'TOperation)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Operation -> Value 'TOperation
forall (instr :: [T] -> [T] -> *).
Operation' instr -> Value' instr 'TOperation
VOp (CreateContract Instr p r -> Operation
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(forall (i :: [T]) (o :: [T]). Show (instr i o),
 forall (i :: [T]) (o :: [T]). NFData (instr i o), Typeable instr,
 ParameterScope cp, StorageScope st) =>
CreateContract instr cp st -> Operation' instr
OpCreateContract CreateContract Instr p r
resOp))
  StkEl meta 'TAddress
el2 <- Value 'TAddress -> m (StkEl meta 'TAddress)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (EpAddress -> Value 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress EpAddress
resEpAddr)
  pure $ StkEl meta 'TOperation
el1 StkEl meta 'TOperation
-> Rec (StkEl meta) ('TAddress : rs)
-> Rec (StkEl meta) ('TOperation : 'TAddress : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StkEl meta 'TAddress
el2 StkEl meta 'TAddress
-> Rec (StkEl meta) rs -> Rec (StkEl meta) ('TAddress : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnIMPLICIT_ACCOUNT{} (StkEl (VKeyHash KeyHash
k) :& Rec (StkEl meta) rs
r) =
  Value ('TContract 'TUnit) -> m (StkEl meta ('TContract 'TUnit))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Address -> SomeEntrypointCallT 'TUnit -> Value ('TContract 'TUnit)
forall (arg :: T) (instr :: [T] -> [T] -> *).
(SingI arg, ForbidOp arg) =>
Address -> SomeEntrypointCallT arg -> Value' instr ('TContract arg)
VContract (KindedAddress 'AddressKindImplicit -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress (KindedAddress 'AddressKindImplicit -> Address)
-> KindedAddress 'AddressKindImplicit -> Address
forall a b. (a -> b) -> a -> b
$ KeyHash -> KindedAddress 'AddressKindImplicit
ImplicitAddress KeyHash
k) SomeEntrypointCallT 'TUnit
forall (t :: T).
(ParameterScope t, ForbidOr t) =>
SomeEntrypointCallT t
sepcPrimitive) m (StkEl meta ('TContract 'TUnit))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) ('TContract 'TUnit : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnNOW{} Rec (StkEl meta) inp
r = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TTimestamp -> m (StkEl meta 'TTimestamp)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Timestamp -> Value 'TTimestamp
forall (instr :: [T] -> [T] -> *).
Timestamp -> Value' instr 'TTimestamp
VTimestamp Timestamp
ceNow) m (StkEl meta 'TTimestamp)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TTimestamp : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnAMOUNT{} Rec (StkEl meta) inp
r = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TMutez -> m (StkEl meta 'TMutez)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Mutez -> Value 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez Mutez
ceAmount) m (StkEl meta 'TMutez)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TMutez : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnBALANCE{} Rec (StkEl meta) inp
r = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TMutez -> m (StkEl meta 'TMutez)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Mutez -> Value 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez Mutez
ceBalance) m (StkEl meta 'TMutez)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TMutez : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnVOTING_POWER{} (StkEl (VKeyHash KeyHash
k) :& Rec (StkEl meta) rs
r) = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TNat -> m (StkEl meta 'TNat)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Natural -> Value 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Natural -> Value 'TNat) -> Natural -> Value 'TNat
forall a b. (a -> b) -> a -> b
$ KeyHash -> VotingPowers -> Natural
vpPick KeyHash
k VotingPowers
ceVotingPowers) m (StkEl meta 'TNat)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TNat : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnTOTAL_VOTING_POWER{} Rec (StkEl meta) inp
r = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TNat -> m (StkEl meta 'TNat)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Natural -> Value 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Natural -> Value 'TNat) -> Natural -> Value 'TNat
forall a b. (a -> b) -> a -> b
$ VotingPowers -> Natural
vpTotal VotingPowers
ceVotingPowers) m (StkEl meta 'TNat)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TNat : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnCHECK_SIGNATURE{}
  (StkEl (VKey PublicKey
k) :& StkEl (VSignature Signature
v) :& StkEl (VBytes ByteString
b) :& Rec (StkEl meta) rs
r) =
  Value 'TBool -> m (StkEl meta 'TBool)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Bool -> Value 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
VBool (Bool -> Value 'TBool) -> Bool -> Value 'TBool
forall a b. (a -> b) -> a -> b
$ PublicKey -> Signature -> ByteString -> Bool
checkSignature PublicKey
k Signature
v ByteString
b) m (StkEl meta 'TBool)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TBool : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnSHA256{} (StkEl (VBytes ByteString
b) :& Rec (StkEl meta) rs
r) =
  Value 'TBytes -> m (StkEl meta 'TBytes)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (ByteString -> Value 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString -> Value 'TBytes) -> ByteString -> Value 'TBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
sha256 ByteString
b) m (StkEl meta 'TBytes)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TBytes : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnSHA512{} (StkEl (VBytes ByteString
b) :& Rec (StkEl meta) rs
r) =
  Value 'TBytes -> m (StkEl meta 'TBytes)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (ByteString -> Value 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString -> Value 'TBytes) -> ByteString -> Value 'TBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
sha512 ByteString
b) m (StkEl meta 'TBytes)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TBytes : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnBLAKE2B{} (StkEl (VBytes ByteString
b) :& Rec (StkEl meta) rs
r) =
  Value 'TBytes -> m (StkEl meta 'TBytes)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (ByteString -> Value 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString -> Value 'TBytes) -> ByteString -> Value 'TBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
blake2b ByteString
b) m (StkEl meta 'TBytes)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TBytes : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnSHA3{} (StkEl (VBytes ByteString
b) :& Rec (StkEl meta) rs
r) =
  Value 'TBytes -> m (StkEl meta 'TBytes)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (ByteString -> Value 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString -> Value 'TBytes) -> ByteString -> Value 'TBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
sha3 ByteString
b) m (StkEl meta 'TBytes)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TBytes : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnKECCAK{} (StkEl (VBytes ByteString
b) :& Rec (StkEl meta) rs
r) =
  Value 'TBytes -> m (StkEl meta 'TBytes)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (ByteString -> Value 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString -> Value 'TBytes) -> ByteString -> Value 'TBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
keccak ByteString
b) m (StkEl meta 'TBytes)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TBytes : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnHASH_KEY{} (StkEl (VKey PublicKey
k) :& Rec (StkEl meta) rs
r) =
  Value 'TKeyHash -> m (StkEl meta 'TKeyHash)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (KeyHash -> Value 'TKeyHash
forall (instr :: [T] -> [T] -> *).
KeyHash -> Value' instr 'TKeyHash
VKeyHash (KeyHash -> Value 'TKeyHash) -> KeyHash -> Value 'TKeyHash
forall a b. (a -> b) -> a -> b
$ PublicKey -> KeyHash
hashKey PublicKey
k) m (StkEl meta 'TKeyHash)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TKeyHash : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnPAIRING_CHECK{} (StkEl (VList [Value' Instr t1]
pairs) :& Rec (StkEl meta) rs
r) = do
  let pairs' :: [(Bls12381G1, Bls12381G2)]
pairs' = [ (Bls12381G1
g1, Bls12381G2
g2) | VPair (VBls12381G1 Bls12381G1
g1, VBls12381G2 Bls12381G2
g2) <- [Value' Instr t1]
pairs ]
  Value 'TBool -> m (StkEl meta 'TBool)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Bool -> Value 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
VBool (Bool -> Value 'TBool) -> Bool -> Value 'TBool
forall a b. (a -> b) -> a -> b
$ [(Bls12381G1, Bls12381G2)] -> Bool
checkPairing [(Bls12381G1, Bls12381G2)]
pairs') m (StkEl meta 'TBool)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TBool : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnSOURCE{} Rec (StkEl meta) inp
r = do
  ContractEnv{ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSource=Constrained KindedAddress a
ceSource} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TAddress -> m (StkEl meta 'TAddress)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (EpAddress -> Value 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress (EpAddress -> Value 'TAddress) -> EpAddress -> Value 'TAddress
forall a b. (a -> b) -> a -> b
$ KindedAddress a -> EpName -> EpAddress
forall (kind :: AddressKind).
KindedAddress kind -> EpName -> EpAddress
EpAddress KindedAddress a
ceSource EpName
DefEpName) m (StkEl meta 'TAddress)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TAddress : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnSENDER{} Rec (StkEl meta) inp
r = do
  ContractEnv{ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender=Constrained KindedAddress a
ceSender} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TAddress -> m (StkEl meta 'TAddress)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (EpAddress -> Value 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress (EpAddress -> Value 'TAddress) -> EpAddress -> Value 'TAddress
forall a b. (a -> b) -> a -> b
$ KindedAddress a -> EpName -> EpAddress
forall (kind :: AddressKind).
KindedAddress kind -> EpName -> EpAddress
EpAddress KindedAddress a
ceSender EpName
DefEpName) m (StkEl meta 'TAddress)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TAddress : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnADDRESS{} (StkEl (VContract Address
a SomeEntrypointCallT arg
sepc) :& Rec (StkEl meta) rs
r) =
  Value 'TAddress -> m (StkEl meta 'TAddress)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (EpAddress -> Value 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress (EpAddress -> Value 'TAddress) -> EpAddress -> Value 'TAddress
forall a b. (a -> b) -> a -> b
$ Address -> EpName -> EpAddress
EpAddress' Address
a (SomeEntrypointCallT arg -> EpName
forall (arg :: T). SomeEntrypointCallT arg -> EpName
sepcName SomeEntrypointCallT arg
sepc)) m (StkEl meta 'TAddress)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TAddress : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnCHAIN_ID{} Rec (StkEl meta) inp
r = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TChainId -> m (StkEl meta 'TChainId)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (ChainId -> Value 'TChainId
forall (instr :: [T] -> [T] -> *).
ChainId -> Value' instr 'TChainId
VChainId ChainId
ceChainId) m (StkEl meta 'TChainId)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TChainId : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnLEVEL{} Rec (StkEl meta) inp
r = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TNat -> m (StkEl meta 'TNat)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Natural -> Value 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat Natural
ceLevel) m (StkEl meta 'TNat)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TNat : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnSELF_ADDRESS{} Rec (StkEl meta) inp
r = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TAddress -> m (StkEl meta 'TAddress)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (EpAddress -> Value 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress (EpAddress -> Value 'TAddress) -> EpAddress -> Value 'TAddress
forall a b. (a -> b) -> a -> b
$ ContractAddress -> EpName -> EpAddress
forall (kind :: AddressKind).
KindedAddress kind -> EpName -> EpAddress
EpAddress ContractAddress
ceSelf EpName
DefEpName) m (StkEl meta 'TAddress)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TAddress : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ AnnTICKET{} (StkEl Value r
dat :& StkEl (VNat Natural
am) :& Rec (StkEl meta) rs
r) = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  let result :: Value' Instr ('TOption ('TTicket r))
result = Maybe (Value' Instr ('TTicket r))
-> Value' Instr ('TOption ('TTicket r))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Natural
am Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Natural
0)
        pure $ Address -> Value r -> Natural -> Value' Instr ('TTicket r)
forall (arg :: T) (instr :: [T] -> [T] -> *).
Comparable arg =>
Address
-> Value' instr arg -> Natural -> Value' instr ('TTicket arg)
VTicket (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
ceSelf) Value r
dat Natural
am
  Value' Instr ('TOption ('TTicket r))
-> m (StkEl meta ('TOption ('TTicket r)))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr ('TOption ('TTicket r))
result m (StkEl meta ('TOption ('TTicket r)))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) ('TOption ('TTicket r) : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnTICKET_DEPRECATED{} (StkEl Value r
dat :& StkEl (VNat Natural
am) :& Rec (StkEl meta) rs
r) = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value ('TTicket r) -> m (StkEl meta ('TTicket r))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Address -> Value r -> Natural -> Value ('TTicket r)
forall (arg :: T) (instr :: [T] -> [T] -> *).
Comparable arg =>
Address
-> Value' instr arg -> Natural -> Value' instr ('TTicket arg)
VTicket (ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress ContractAddress
ceSelf) Value r
dat Natural
am) m (StkEl meta ('TTicket r))
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TTicket r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnREAD_TICKET{} (te :: StkEl meta r
te@(StkEl (VTicket Address
addr Value' Instr arg
dat Natural
am)) :& Rec (StkEl meta) rs
r) = do
  Value ('TPair 'TAddress ('TPair arg 'TNat))
-> m (StkEl meta ('TPair 'TAddress ('TPair arg 'TNat)))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl
      ((Value 'TAddress, Value' Instr ('TPair arg 'TNat))
-> Value ('TPair 'TAddress ('TPair arg 'TNat))
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (EpAddress -> Value 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress (Address -> EpName -> EpAddress
EpAddress' Address
addr EpName
DefEpName), ((Value' Instr arg, Value 'TNat) -> Value' Instr ('TPair arg 'TNat)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value' Instr arg
dat, Natural -> Value 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat Natural
am))))
    m (StkEl meta ('TPair 'TAddress ('TPair arg 'TNat)))
-> Rec (StkEl meta) (r : rs)
-> m (Rec
        (StkEl meta) ('TPair 'TAddress ('TPair arg 'TNat) : r : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> StkEl meta r
te StkEl meta r -> Rec (StkEl meta) rs -> Rec (StkEl meta) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnSPLIT_TICKET{}
    (StkEl tv :: Value r
tv@(VTicket Address
addr Value' Instr arg
dat Natural
am) :&
     StkEl (VPair (VNat Natural
am1, VNat Natural
am2)) :& Rec (StkEl meta) rs
r) = do
  let result :: Value ('TOption ('TPair ('TTicket a) ('TTicket a)))
result = Value r
-> (SingI r => Value ('TOption ('TPair ('TTicket a) ('TTicket a))))
-> Value ('TOption ('TPair ('TTicket a) ('TTicket a)))
forall (instr :: [T] -> [T] -> *) (t :: T) a.
Value' instr t -> (SingI t => a) -> a
withValueTypeSanity Value r
tv ((SingI r => Value ('TOption ('TPair ('TTicket a) ('TTicket a))))
 -> Value ('TOption ('TPair ('TTicket a) ('TTicket a))))
-> (SingI r => Value ('TOption ('TPair ('TTicket a) ('TTicket a))))
-> Value ('TOption ('TPair ('TTicket a) ('TTicket a)))
forall a b. (a -> b) -> a -> b
$ Maybe (Value' Instr ('TPair ('TTicket arg) ('TTicket arg)))
-> Value' Instr ('TOption ('TPair ('TTicket arg) ('TTicket arg)))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Natural
am1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
am2 Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
am)
        return $ (Value' Instr ('TTicket arg), Value' Instr ('TTicket arg))
-> Value' Instr ('TPair ('TTicket arg) ('TTicket arg))
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Address
-> Value' Instr arg -> Natural -> Value' Instr ('TTicket arg)
forall (arg :: T) (instr :: [T] -> [T] -> *).
Comparable arg =>
Address
-> Value' instr arg -> Natural -> Value' instr ('TTicket arg)
VTicket Address
addr Value' Instr arg
dat Natural
am1, Address
-> Value' Instr arg -> Natural -> Value' Instr ('TTicket arg)
forall (arg :: T) (instr :: [T] -> [T] -> *).
Comparable arg =>
Address
-> Value' instr arg -> Natural -> Value' instr ('TTicket arg)
VTicket Address
addr Value' Instr arg
dat Natural
am2)
  Value ('TOption ('TPair ('TTicket a) ('TTicket a)))
-> m (StkEl meta ('TOption ('TPair ('TTicket a) ('TTicket a))))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value ('TOption ('TPair ('TTicket a) ('TTicket a)))
result m (StkEl meta ('TOption ('TPair ('TTicket a) ('TTicket a))))
-> Rec (StkEl meta) rs
-> m (Rec
        (StkEl meta) ('TOption ('TPair ('TTicket a) ('TTicket a)) : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnJOIN_TICKETS{}
  (StkEl (VPair (tv1 :: Value' Instr l
tv1@(VTicket Address
addr1 Value' Instr arg
dat1 Natural
am1), VTicket Address
addr2 Value' Instr arg
dat2 Natural
am2)) :& Rec (StkEl meta) rs
r) = do
  let result :: Value ('TOption ('TTicket a))
result = Value' Instr l
-> (SingI l => Value ('TOption ('TTicket a)))
-> Value ('TOption ('TTicket a))
forall (instr :: [T] -> [T] -> *) (t :: T) a.
Value' instr t -> (SingI t => a) -> a
withValueTypeSanity Value' Instr l
tv1 ((SingI l => Value ('TOption ('TTicket a)))
 -> Value ('TOption ('TTicket a)))
-> (SingI l => Value ('TOption ('TTicket a)))
-> Value ('TOption ('TTicket a))
forall a b. (a -> b) -> a -> b
$ Maybe (Value' Instr ('TTicket arg))
-> Value' Instr ('TOption ('TTicket arg))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Address
addr1 Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
addr2)
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Value' Instr arg
dat1 Value' Instr arg -> Value' Instr arg -> Bool
forall a. Eq a => a -> a -> Bool
== Value' Instr arg
Value' Instr arg
dat2)
        return $ Address
-> Value' Instr arg -> Natural -> Value' Instr ('TTicket arg)
forall (arg :: T) (instr :: [T] -> [T] -> *).
Comparable arg =>
Address
-> Value' instr arg -> Natural -> Value' instr ('TTicket arg)
VTicket Address
addr1 Value' Instr arg
dat1 (Natural
am1 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
am2)
  Value ('TOption ('TTicket a))
-> m (StkEl meta ('TOption ('TTicket a)))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value ('TOption ('TTicket a))
result m (StkEl meta ('TOption ('TTicket a)))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) ('TOption ('TTicket a) : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnOPEN_CHEST{}
  (StkEl (VChestKey ChestKey
ck) :& StkEl (VChest Chest
c) :& StkEl (VNat Natural
nat) :& Rec (StkEl meta) rs
r) = do
  let result :: Value' Instr ('TOr 'TBytes 'TBool)
result = case Natural -> Either Text TLTime
forall i. Integral i => i -> Either Text TLTime
mkTLTime Natural
nat of
        Right TLTime
time -> case Chest -> ChestKey -> TLTime -> OpeningResult
openChest Chest
c ChestKey
ck TLTime
time of
          Correct ByteString
bytes -> Either (Value 'TBytes) (Value 'TBool)
-> Value' Instr ('TOr 'TBytes 'TBool)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(SingI l, SingI r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr (Value 'TBytes -> Either (Value 'TBytes) (Value 'TBool)
forall a b. a -> Either a b
Left (ByteString -> Value 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes ByteString
bytes))
          OpeningResult
BogusOpening  -> Either (Value 'TBytes) (Value 'TBool)
-> Value' Instr ('TOr 'TBytes 'TBool)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(SingI l, SingI r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr (Value 'TBool -> Either (Value 'TBytes) (Value 'TBool)
forall a b. b -> Either a b
Right (Bool -> Value 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
VBool Bool
True))
          OpeningResult
BogusCipher   -> Either (Value 'TBytes) (Value 'TBool)
-> Value' Instr ('TOr 'TBytes 'TBool)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(SingI l, SingI r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr (Value 'TBool -> Either (Value 'TBytes) (Value 'TBool)
forall a b. b -> Either a b
Right (Bool -> Value 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
VBool Bool
False))
        Left Text
_ -> Either (Value 'TBytes) (Value 'TBool)
-> Value' Instr ('TOr 'TBytes 'TBool)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(SingI l, SingI r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr (Value 'TBool -> Either (Value 'TBytes) (Value 'TBool)
forall a b. b -> Either a b
Right (Bool -> Value 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
VBool Bool
True))
  Value' Instr ('TOr 'TBytes 'TBool)
-> m (StkEl meta ('TOr 'TBytes 'TBool))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr ('TOr 'TBytes 'TBool)
result m (StkEl meta ('TOr 'TBytes 'TBool))
-> Rec (StkEl meta) rs
-> m (Rec (StkEl meta) ('TOr 'TBytes 'TBool : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r
runInstrImpl InstrRunner meta m
_ AnnSAPLING_EMPTY_STATE{} Rec (StkEl meta) inp
_ = MichelsonFailed ext -> m (Rec (StkEl meta) out)
forall ext (m :: * -> *) a.
EvalM' ext m =>
MichelsonFailed ext -> m a
throwMichelson (MichelsonFailed ext -> m (Rec (StkEl meta) out))
-> MichelsonFailed ext -> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$ Text -> MichelsonFailed ext
forall ext. Text -> MichelsonFailed ext
MichelsonUnsupported Text
"SAPLING_EMPTY_STATE"
runInstrImpl InstrRunner meta m
_ AnnSAPLING_VERIFY_UPDATE{} Rec (StkEl meta) inp
_ = MichelsonFailed ext -> m (Rec (StkEl meta) out)
forall ext (m :: * -> *) a.
EvalM' ext m =>
MichelsonFailed ext -> m a
throwMichelson (MichelsonFailed ext -> m (Rec (StkEl meta) out))
-> MichelsonFailed ext -> m (Rec (StkEl meta) out)
forall a b. (a -> b) -> a -> b
$ Text -> MichelsonFailed ext
forall ext. Text -> MichelsonFailed ext
MichelsonUnsupported Text
"SAPLING_VERIFY_UPDATE"
runInstrImpl InstrRunner meta m
_ AnnMIN_BLOCK_TIME{} Rec (StkEl meta) inp
r = do
  ContractEnv{Natural
Maybe OperationHash
ErrorSrcPos
L1Address
ChainId
Timestamp
Mutez
ContractAddress
VotingPowers
RemainingSteps
ContractAddress -> m (Maybe ContractState)
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: forall (m :: * -> *). ContractEnv' m -> Timestamp
ceMaxSteps :: forall (m :: * -> *). ContractEnv' m -> RemainingSteps
ceBalance :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceContracts :: forall (m :: * -> *).
ContractEnv' m -> ContractAddress -> m (Maybe ContractState)
ceSelf :: forall (m :: * -> *). ContractEnv' m -> ContractAddress
ceSource :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceSender :: forall (m :: * -> *). ContractEnv' m -> L1Address
ceAmount :: forall (m :: * -> *). ContractEnv' m -> Mutez
ceVotingPowers :: forall (m :: * -> *). ContractEnv' m -> VotingPowers
ceChainId :: forall (m :: * -> *). ContractEnv' m -> ChainId
ceOperationHash :: forall (m :: * -> *). ContractEnv' m -> Maybe OperationHash
ceLevel :: forall (m :: * -> *). ContractEnv' m -> Natural
ceErrorSrcPos :: forall (m :: * -> *). ContractEnv' m -> ErrorSrcPos
ceMinBlockTime :: forall (m :: * -> *). ContractEnv' m -> Natural
ceMetaWrapper :: forall (m :: * -> *).
ContractEnv' m
-> forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceNow :: Timestamp
ceMaxSteps :: RemainingSteps
ceBalance :: Mutez
ceContracts :: ContractAddress -> m (Maybe ContractState)
ceSelf :: ContractAddress
ceSource :: L1Address
ceSender :: L1Address
ceAmount :: Mutez
ceVotingPowers :: VotingPowers
ceChainId :: ChainId
ceOperationHash :: Maybe OperationHash
ceLevel :: Natural
ceErrorSrcPos :: ErrorSrcPos
ceMinBlockTime :: Natural
ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
..} <- m (ContractEnv' m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Value 'TNat -> m (StkEl meta 'TNat)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Natural -> Value 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat Natural
ceMinBlockTime) m (StkEl meta 'TNat)
-> Rec (StkEl meta) inp -> m (Rec (StkEl meta) ('TNat : inp))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) inp
r
runInstrImpl InstrRunner meta m
_ (AnnEMIT AnnVar
_ (FieldAnn -> Text
forall {k} (tag :: k). Annotation tag -> Text
unAnnotation -> Text
emTag) Maybe (Notes t)
mNotes) ((StkEl Value r
emValue) :& Rec (StkEl meta) rs
r) = do
  m ()
forall (m :: * -> *). InterpreterStateMonad m => m ()
incrementCounter
  GlobalCounter
emCounter <- InterpreterState -> GlobalCounter
isGlobalCounter (InterpreterState -> GlobalCounter)
-> m InterpreterState -> m GlobalCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InterpreterState
forall (m :: * -> *). InterpreterStateMonad m => m InterpreterState
getInterpreterState
  let emNotes :: Notes t
emNotes = Notes t -> Maybe (Notes t) -> Notes t
forall a. a -> Maybe a -> a
fromMaybe Notes t
forall (t :: T). SingI t => Notes t
starNotes Maybe (Notes t)
mNotes
  Value 'TOperation -> m (StkEl meta 'TOperation)
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl (Operation -> Value 'TOperation
forall (instr :: [T] -> [T] -> *).
Operation' instr -> Value' instr 'TOperation
VOp (Emit Instr t -> Operation
forall (t :: T) (instr :: [T] -> [T] -> *).
PackedValScope t =>
Emit instr t -> Operation' instr
OpEmit Emit{Text
GlobalCounter
Notes t
Value' Instr t
Value r
emTag :: Text
emValue :: Value r
emCounter :: GlobalCounter
emNotes :: Notes t
emTag :: Text
emNotes :: Notes t
emValue :: Value' Instr t
emCounter :: GlobalCounter
..})) m (StkEl meta 'TOperation)
-> Rec (StkEl meta) rs -> m (Rec (StkEl meta) ('TOperation : rs))
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) rs
r

-- | Evaluates an arithmetic operation and either fails or proceeds.
runArithOp
  :: (ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad)
  => proxy aop
  -> StkEl meta n
  -> StkEl meta m
  -> monad (StkEl meta (ArithRes aop n m))
runArithOp :: forall {k} (aop :: k) (n :: T) (m :: T) (meta :: T -> *)
       (monad :: * -> *) ext (proxy :: k -> *).
(ArithOp aop n m, StkElMeta meta monad, EvalM' ext monad) =>
proxy aop
-> StkEl meta n
-> StkEl meta m
-> monad (StkEl meta (ArithRes aop n m))
runArithOp proxy aop
op StkEl meta n
l StkEl meta m
r = case proxy aop
-> Value' Instr n
-> Value' Instr m
-> Either
     (ArithError (Value' Instr n) (Value' Instr m))
     (Value' Instr (ArithRes aop n m))
forall {k} (aop :: k) (n :: T) (m :: T) (proxy :: k -> *)
       (instr :: [T] -> [T] -> *).
ArithOp aop n m =>
proxy aop
-> Value' instr n
-> Value' instr m
-> Either
     (ArithError (Value' instr n) (Value' instr m))
     (Value' instr (ArithRes aop n m))
forall (proxy :: k -> *) (instr :: [T] -> [T] -> *).
proxy aop
-> Value' instr n
-> Value' instr m
-> Either
     (ArithError (Value' instr n) (Value' instr m))
     (Value' instr (ArithRes aop n m))
evalOp proxy aop
op (StkEl meta n -> Value' Instr n
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta n
l) (StkEl meta m -> Value' Instr m
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue StkEl meta m
r) of
  Left  ArithError (Value' Instr n) (Value' Instr m)
err -> MichelsonFailed ext -> monad (StkEl meta (ArithRes aop n m))
forall ext (m :: * -> *) a.
EvalM' ext m =>
MichelsonFailed ext -> m a
throwMichelson (MichelsonFailed ext -> monad (StkEl meta (ArithRes aop n m)))
-> MichelsonFailed ext -> monad (StkEl meta (ArithRes aop n m))
forall a b. (a -> b) -> a -> b
$ ArithError (Value' Instr n) (Value' Instr m) -> MichelsonFailed ext
forall (n :: T) (m :: T) ext.
(Typeable n, Typeable m) =>
ArithError (Value n) (Value m) -> MichelsonFailed ext
MichelsonArithError ArithError (Value' Instr n) (Value' Instr m)
err
  Right Value' Instr (ArithRes aop n m)
res -> Value' Instr (ArithRes aop n m)
-> monad (StkEl meta (ArithRes aop n m))
forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl Value' Instr (ArithRes aop n m)
res

-- | Unpacks given raw data into a typed value.
runUnpack
  :: forall t. (UnpackedValScope t)
  => ByteString
  -> Either UnpackError (Value t)
runUnpack :: forall (t :: T).
UnpackedValScope t =>
ByteString -> Either UnpackError (Value t)
runUnpack ByteString
bs =
  -- TODO [TM-80]: Gas consumption here should depend on unpacked data size
  -- and size of resulting expression, errors would also spend some (all equally).
  -- Fortunately, the inner decoding logic does not need to know anything about gas use.
  ByteString -> Either UnpackError (Value t)
forall (t :: T).
UnpackedValScope t =>
ByteString -> Either UnpackError (Value t)
unpackValue' ByteString
bs

data ViewLookupError
  = ViewNotFound ViewName
  | ViewArgMismatch (MismatchError T)
  | ViewRetMismatch (MismatchError T)
  deriving stock Int -> ViewLookupError -> ShowS
[ViewLookupError] -> ShowS
ViewLookupError -> String
(Int -> ViewLookupError -> ShowS)
-> (ViewLookupError -> String)
-> ([ViewLookupError] -> ShowS)
-> Show ViewLookupError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ViewLookupError -> ShowS
showsPrec :: Int -> ViewLookupError -> ShowS
$cshow :: ViewLookupError -> String
show :: ViewLookupError -> String
$cshowList :: [ViewLookupError] -> ShowS
showList :: [ViewLookupError] -> ShowS
Show

instance Buildable ViewLookupError where
  build :: ViewLookupError -> Doc
build = \case
    ViewNotFound ViewName
name -> Doc
"View '" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ViewName
name ViewName -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"' not found"
    ViewArgMismatch MismatchError T
err -> Doc -> MismatchError T -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"View argument type mismatch" MismatchError T
err
    ViewRetMismatch MismatchError T
err -> Doc -> MismatchError T -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"View return type mismatch" MismatchError T
err

-- | Interpret a contract's view for given t'ContractEnv' and initial
-- 'InterpreterState'. It is assumed t'ContractEnv' is suitable for the view
-- call, that is, the view is executed exactly in the env that's passed here.
interpretView
  :: View arg st ret
  -> Value st
  -> Value arg
  -> ContractEnv
  -> InterpreterState
  -> InterpretReturn ret
interpretView :: forall (arg :: T) (st :: T) (ret :: T).
View arg st ret
-> Value st
-> Value arg
-> ContractEnv
-> InterpreterState
-> InterpretReturn ret
interpretView View arg st ret
view' Value st
st Value arg
argument = EvalOp (Value ret)
-> ContractEnv -> InterpreterState -> RunEvalOpReturn (Value ret)
forall a.
EvalOp a -> ContractEnv -> InterpreterState -> RunEvalOpReturn a
runEvalOp (EvalOp (Value ret)
 -> ContractEnv -> InterpreterState -> RunEvalOpReturn (Value ret))
-> EvalOp (Value ret)
-> ContractEnv
-> InterpreterState
-> RunEvalOpReturn (Value ret)
forall a b. (a -> b) -> a -> b
$
  InstrRunner NoStkElMeta (EvalOpT Identity)
-> (ContractEnv -> ContractEnv)
-> View arg st ret
-> Value st
-> Value arg
-> EvalOp (Value ret)
forall (ret :: T) (st :: T) (m :: * -> *) (arg :: T) ext
       (meta :: T -> *).
(StkElMeta meta m, EvalM' ext m) =>
(forall (inp :: [T]) (out :: [T]).
 Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out))
-> (ContractEnv' m -> ContractEnv' m)
-> View arg st ret
-> Value st
-> Value arg
-> m (Value ret)
interpretView' (forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m
runInstr @_ @NoStkElMeta) ContractEnv -> ContractEnv
forall a. a -> a
id View arg st ret
view' Value st
st Value arg
argument

-- | Attempt to find a view with a given name and given type in a given
-- contract.
getViewByNameAndType
  :: forall arg ret cp st. (SingI arg, SingI ret)
  => Contract cp st -> ViewName -> Either ViewLookupError (View arg st ret)
getViewByNameAndType :: forall (arg :: T) (ret :: T) (cp :: T) (st :: T).
(SingI arg, SingI ret) =>
Contract cp st
-> ViewName -> Either ViewLookupError (View arg st ret)
getViewByNameAndType Contract cp st
contract ViewName
name = do
  SomeView (view' :: View arg st ret
view'@View{} :: View arg' st ret') <- Either ViewLookupError (SomeView' Instr st)
-> Either ViewLookupError (SomeView' Instr st)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ViewLookupError (SomeView' Instr st)
 -> Either ViewLookupError (SomeView' Instr st))
-> Either ViewLookupError (SomeView' Instr st)
-> Either ViewLookupError (SomeView' Instr st)
forall a b. (a -> b) -> a -> b
$ Contract cp st
-> ViewName -> Either ViewLookupError (SomeView' Instr st)
forall (cp :: T) (st :: T).
Contract cp st -> ViewName -> Either ViewLookupError (SomeView st)
getViewByName Contract cp st
contract ViewName
name
  let retMismatch :: ViewLookupError
retMismatch = MismatchError T -> ViewLookupError
ViewRetMismatch MkMismatchError
        { meActual :: T
meActual = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @ret', meExpected :: T
meExpected = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @ret }
      argMismatch :: ViewLookupError
argMismatch = MismatchError T -> ViewLookupError
ViewArgMismatch MkMismatchError
        { meActual :: T
meActual = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @arg', meExpected :: T
meExpected = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @arg }
  arg :~: arg
Refl <- Either ViewLookupError (arg :~: arg)
-> Either ViewLookupError (arg :~: arg)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ViewLookupError (arg :~: arg)
 -> Either ViewLookupError (arg :~: arg))
-> Either ViewLookupError (arg :~: arg)
-> Either ViewLookupError (arg :~: arg)
forall a b. (a -> b) -> a -> b
$ ViewLookupError
-> Maybe (arg :~: arg) -> Either ViewLookupError (arg :~: arg)
forall l r. l -> Maybe r -> Either l r
maybeToRight ViewLookupError
argMismatch (Maybe (arg :~: arg) -> Either ViewLookupError (arg :~: arg))
-> Maybe (arg :~: arg) -> Either ViewLookupError (arg :~: arg)
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
sing @arg Sing arg -> Sing arg -> Maybe (arg :~: arg)
forall k (a :: k) (b :: k).
SDecide k =>
Sing a -> Sing b -> Maybe (a :~: b)
`decideEquality` forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
sing @arg'
  ret :~: ret
Refl <- Either ViewLookupError (ret :~: ret)
-> Either ViewLookupError (ret :~: ret)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ViewLookupError (ret :~: ret)
 -> Either ViewLookupError (ret :~: ret))
-> Either ViewLookupError (ret :~: ret)
-> Either ViewLookupError (ret :~: ret)
forall a b. (a -> b) -> a -> b
$ ViewLookupError
-> Maybe (ret :~: ret) -> Either ViewLookupError (ret :~: ret)
forall l r. l -> Maybe r -> Either l r
maybeToRight ViewLookupError
retMismatch (Maybe (ret :~: ret) -> Either ViewLookupError (ret :~: ret))
-> Maybe (ret :~: ret) -> Either ViewLookupError (ret :~: ret)
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
sing @ret Sing ret -> Sing ret -> Maybe (ret :~: ret)
forall k (a :: k) (b :: k).
SDecide k =>
Sing a -> Sing b -> Maybe (a :~: b)
`decideEquality` forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
sing @ret'
  View arg st ret -> Either ViewLookupError (View arg st ret)
forall a. a -> Either ViewLookupError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure View arg st ret
View arg st ret
view'

-- | Attempt to find a view with a given name in a given contract.
getViewByName :: Contract cp st -> ViewName -> Either ViewLookupError (SomeView st)
getViewByName :: forall (cp :: T) (st :: T).
Contract cp st -> ViewName -> Either ViewLookupError (SomeView st)
getViewByName Contract cp st
contract ViewName
name =
  Either ViewLookupError (SomeView st)
-> Either ViewLookupError (SomeView st)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either ViewLookupError (SomeView st)
 -> Either ViewLookupError (SomeView st))
-> Either ViewLookupError (SomeView st)
-> Either ViewLookupError (SomeView st)
forall a b. (a -> b) -> a -> b
$ ViewLookupError
-> Maybe (SomeView st) -> Either ViewLookupError (SomeView st)
forall l r. l -> Maybe r -> Either l r
maybeToRight (ViewName -> ViewLookupError
ViewNotFound ViewName
name) (Maybe (SomeView st) -> Either ViewLookupError (SomeView st))
-> Maybe (SomeView st) -> Either ViewLookupError (SomeView st)
forall a b. (a -> b) -> a -> b
$ ViewName -> ViewsSet' Instr st -> Maybe (SomeView st)
forall (instr :: [T] -> [T] -> *) (st :: T).
ViewName -> ViewsSet' instr st -> Maybe (SomeView' instr st)
lookupView ViewName
name (Contract cp st -> ViewsSet' Instr st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ViewsSet' instr st
cViews Contract cp st
contract)

-- | 'EvalM' view interpretation helper.
interpretView'
  :: forall ret st m arg ext meta. (StkElMeta meta m, EvalM' ext m)
  => (forall inp out. Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out))
  -> (ContractEnv' m -> ContractEnv' m)
  -> View arg st ret
  -> Value st
  -> Value arg
  -> m (Value ret)
interpretView' :: forall (ret :: T) (st :: T) (m :: * -> *) (arg :: T) ext
       (meta :: T -> *).
(StkElMeta meta m, EvalM' ext m) =>
(forall (inp :: [T]) (out :: [T]).
 Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out))
-> (ContractEnv' m -> ContractEnv' m)
-> View arg st ret
-> Value st
-> Value arg
-> m (Value ret)
interpretView' forall (inp :: [T]) (out :: [T]).
Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
runner ContractEnv' m -> ContractEnv' m
env View{ViewCode' Instr arg st ret
vCode :: ViewCode' Instr arg st ret
vCode :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewCode' instr arg st ret
vCode} Value st
storage Value arg
argument = do
  Rec (StkEl meta) '[ret]
resSt <- (ContractEnv' m -> ContractEnv' m)
-> m (Rec (StkEl meta) '[ret]) -> m (Rec (StkEl meta) '[ret])
forall a. (ContractEnv' m -> ContractEnv' m) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ContractEnv' m -> ContractEnv' m
env (m (Rec (StkEl meta) '[ret]) -> m (Rec (StkEl meta) '[ret]))
-> m (Rec (StkEl meta) '[ret]) -> m (Rec (StkEl meta) '[ret])
forall a b. (a -> b) -> a -> b
$ (forall (inp :: [T]) (out :: [T]).
 Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out))
-> forall (inp :: [T]) (out :: [T]).
   Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
forall (inp :: [T]) (out :: [T]).
Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
runner ViewCode' Instr arg st ret
vCode (Rec (StkEl meta) '[ 'TPair arg st] -> m (Rec (StkEl meta) '[ret]))
-> m (Rec (StkEl meta) '[ 'TPair arg st])
-> m (Rec (StkEl meta) '[ret])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    forall (meta :: T -> *) (t :: T) (m :: * -> *).
(Applicative m, StkElMeta meta m) =>
Value t -> m (StkEl meta t)
mkStkEl @meta ((Value arg, Value st) -> Value ('TPair arg st)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value arg
argument, Value st
storage)) m (StkEl meta ('TPair arg st))
-> Rec (StkEl meta) '[] -> m (Rec (StkEl meta) '[ 'TPair arg st])
forall {a} (f :: * -> *) (a :: a -> *) (r :: a) (rs :: [a]).
Functor f =>
f (a r) -> Rec a rs -> f (Rec a (r : rs))
<:&> Rec (StkEl meta) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil
  let StkEl Value ret
Value r
res :& Rec (StkEl meta) rs
RNil = Rec (StkEl meta) '[ret]
resSt
  Value ret -> m (Value ret)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ret
res

createOrigOp
  :: (ParameterScope param, StorageScope store, L1AddressKind kind)
  => KindedAddress kind
  -> Maybe ContractAlias
  -> Maybe (Value 'TKeyHash)
  -> Mutez
  -> Contract param store
  -> Value' Instr store
  -> GlobalCounter
  -> OriginationOperation
createOrigOp :: forall (param :: T) (store :: T) (kind :: AddressKind).
(ParameterScope param, StorageScope store, L1AddressKind kind) =>
KindedAddress kind
-> Maybe ContractAlias
-> Maybe (Value 'TKeyHash)
-> Mutez
-> Contract param store
-> Value' Instr store
-> GlobalCounter
-> OriginationOperation
createOrigOp KindedAddress kind
originator Maybe ContractAlias
mbAlias Maybe (Value 'TKeyHash)
mbDelegate Mutez
bal Contract param store
contract Value' Instr store
storage GlobalCounter
counter =
  OriginationOperation
    { ooOriginator :: KindedAddress kind
ooOriginator = KindedAddress kind
originator
    , ooDelegate :: Maybe KeyHash
ooDelegate = Maybe (Value 'TKeyHash) -> Maybe KeyHash
unwrapMbKeyHash Maybe (Value 'TKeyHash)
mbDelegate
    , ooBalance :: Mutez
ooBalance = Mutez
bal
    , ooStorage :: Value' Instr store
ooStorage = Value' Instr store
storage
    , ooContract :: Contract param store
ooContract = Contract param store
contract
    , ooCounter :: GlobalCounter
ooCounter = GlobalCounter
counter
    , ooAlias :: Maybe ContractAlias
ooAlias = Maybe ContractAlias
mbAlias
    }

unwrapMbKeyHash :: Maybe (Value 'TKeyHash) -> Maybe KeyHash
unwrapMbKeyHash :: Maybe (Value 'TKeyHash) -> Maybe KeyHash
unwrapMbKeyHash Maybe (Value 'TKeyHash)
mbKeyHash = Maybe (Value 'TKeyHash)
mbKeyHash Maybe (Value 'TKeyHash)
-> (Value 'TKeyHash -> KeyHash) -> Maybe KeyHash
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(VKeyHash KeyHash
keyHash) -> KeyHash
keyHash

interpretExt
  :: forall ext meta m. (StkElMeta meta m, EvalM' ext m)
  => InstrRunner meta m -> SomeItStack meta -> m ()
interpretExt :: forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m -> SomeItStack meta -> m ()
interpretExt InstrRunner meta m
_ (SomeItStack (PRINT (PrintComment [Either Text (StackRef inp)]
pc)) Rec (StkEl meta) inp
st) = do
  let getEl :: Either Text (StackRef inp) -> Text
getEl (Left Text
l) = Text
l
      getEl (Right StackRef inp
str) = StackRef inp
-> Rec (StkEl meta) inp
-> (forall (t :: T). StkEl meta t -> Text)
-> Text
forall (st :: [T]) (meta :: T -> *) a.
StackRef st
-> Rec (StkEl meta) st -> (forall (t :: T). StkEl meta t -> a) -> a
withStackElem StackRef inp
str Rec (StkEl meta) inp
st (Value t -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty (Value t -> Text)
-> (StkEl meta t -> Value t) -> StkEl meta t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StkEl meta t -> Value t
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue)
  MorleyLogsBuilder -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (MorleyLogsBuilder -> m ())
-> (Text -> MorleyLogsBuilder) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MorleyLogsBuilder
OneItem MorleyLogsBuilder -> MorleyLogsBuilder
forall x. One x => OneItem x -> x
one (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ((Either Text (StackRef inp) -> Text)
-> [Either Text (StackRef inp)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Either Text (StackRef inp) -> Text
getEl [Either Text (StackRef inp)]
pc)

interpretExt InstrRunner meta m
runner (SomeItStack (TEST_ASSERT (TestAssert Text
nm PrintComment inp
pc Instr inp ('TBool : out)
instr)) Rec (StkEl meta) inp
st) = do
  Rec (StkEl meta) ('TBool : out)
ost <- InstrRunner meta m -> InstrRunner meta m
forall ext (meta :: T -> *) (m :: * -> *).
(EvalM' ext m, StkElMeta meta m) =>
InstrRunner meta m -> InstrRunner meta m
runInstrImpl Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner Instr inp ('TBool : out)
instr Rec (StkEl meta) inp
st
  let ((StkEl meta r -> Value r
forall (meta :: T -> *) (t :: T). StkEl meta t -> Value t
seValue -> Value r -> Bool
Value (ToT Bool) -> Bool
forall a. IsoValue a => Value (ToT a) -> a
fromVal -> Bool
succeeded) :& Rec (StkEl meta) rs
_) = Rec (StkEl meta) ('TBool : out)
ost
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
succeeded (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    InstrRunner meta m -> SomeItStack meta -> m ()
forall ext (meta :: T -> *) (m :: * -> *).
(StkElMeta meta m, EvalM' ext m) =>
InstrRunner meta m -> SomeItStack meta -> m ()
interpretExt Instr inp out -> Rec (StkEl meta) inp -> m (Rec (StkEl meta) out)
InstrRunner meta m
runner (ExtInstr inp -> Rec (StkEl meta) inp -> SomeItStack meta
forall (n :: [T]) (meta :: T -> *).
ExtInstr n -> Rec (StkEl meta) n -> SomeItStack meta
SomeItStack (PrintComment inp -> ExtInstr inp
forall (s :: [T]). PrintComment s -> ExtInstr s
PRINT PrintComment inp
pc) Rec (StkEl meta) inp
st)
    MichelsonFailed ext -> m ()
forall ext (m :: * -> *) a.
EvalM' ext m =>
MichelsonFailed ext -> m a
throwMichelson (MichelsonFailed ext -> m ()) -> MichelsonFailed ext -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> MichelsonFailed ext
forall ext. Text -> MichelsonFailed ext
MichelsonFailedTestAssert (Text -> MichelsonFailed ext) -> Text -> MichelsonFailed ext
forall a b. (a -> b) -> a -> b
$ Text
"TEST_ASSERT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed"

interpretExt InstrRunner meta m
_ (SomeItStack DOC_ITEM{} Rec (StkEl meta) inp
_) = m ()
forall (f :: * -> *). Applicative f => f ()
pass
interpretExt InstrRunner meta m
_ (SomeItStack COMMENT_ITEM{} Rec (StkEl meta) inp
_) = m ()
forall (f :: * -> *). Applicative f => f ()
pass
interpretExt InstrRunner meta m
_ (SomeItStack STACKTYPE{} Rec (StkEl meta) inp
_) = m ()
forall (f :: * -> *). Applicative f => f ()
pass

-- | Access given stack reference (in CPS style).
withStackElem
  :: forall st meta a.
     StackRef st
  -> Rec (StkEl meta) st
  -> (forall t. StkEl meta t -> a)
  -> a
withStackElem :: forall (st :: [T]) (meta :: T -> *) a.
StackRef st
-> Rec (StkEl meta) st -> (forall (t :: T). StkEl meta t -> a) -> a
withStackElem (StackRef PeanoNatural idx
sn) Rec (StkEl meta) st
vals forall (t :: T). StkEl meta t -> a
cont =
  (Rec (StkEl meta) st, PeanoNatural idx) -> a
forall (s :: [T]) (n :: Peano).
LongerThan s n =>
(Rec (StkEl meta) s, PeanoNatural n) -> a
loop (Rec (StkEl meta) st
vals, PeanoNatural idx
sn)
  where
    loop
      :: forall s (n :: Peano). (LongerThan s n)
      => (Rec (StkEl meta) s, PeanoNatural n) -> a
    loop :: forall (s :: [T]) (n :: Peano).
LongerThan s n =>
(Rec (StkEl meta) s, PeanoNatural n) -> a
loop = \case
      (StkEl meta r
e :& Rec (StkEl meta) rs
_, PeanoNatural n
Zero) -> StkEl meta r -> a
forall (t :: T). StkEl meta t -> a
cont StkEl meta r
e
      (StkEl meta r
_ :& Rec (StkEl meta) rs
es, Succ PeanoNatural m
n) -> (Rec (StkEl meta) rs, PeanoNatural m) -> a
forall (s :: [T]) (n :: Peano).
LongerThan s n =>
(Rec (StkEl meta) s, PeanoNatural n) -> a
loop (Rec (StkEl meta) rs
es, PeanoNatural m
n)

assignBigMapIds' :: forall ext m t. EvalM' ext m => Value t -> m (Value t)
assignBigMapIds' :: forall ext (m :: * -> *) (t :: T).
EvalM' ext m =>
Value t -> m (Value t)
assignBigMapIds' Value t
val = do
  BigMapCounter
bigMapCounter0 <- Getting BigMapCounter InterpreterState BigMapCounter
-> InterpreterState -> BigMapCounter
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BigMapCounter InterpreterState BigMapCounter
Lens' InterpreterState BigMapCounter
isBigMapCounterL (InterpreterState -> BigMapCounter)
-> m InterpreterState -> m BigMapCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InterpreterState
forall (m :: * -> *). InterpreterStateMonad m => m InterpreterState
getInterpreterState
  let (Value t
storageWithIds, BigMapCounter
bigMapCounter1) = State BigMapCounter (Value t)
-> BigMapCounter -> (Value t, BigMapCounter)
forall s a. State s a -> s -> (a, s)
runState (Bool -> Value t -> State BigMapCounter (Value t)
forall (m :: * -> *) (t :: T).
MonadState BigMapCounter m =>
Bool -> Value t -> m (Value t)
assignBigMapIds Bool
True Value t
val) BigMapCounter
bigMapCounter0
  (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
InterpreterStateMonad m =>
(InterpreterState -> InterpreterState) -> m ()
modifyInterpreterState (ASetter
  InterpreterState InterpreterState BigMapCounter BigMapCounter
-> BigMapCounter -> InterpreterState -> InterpreterState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  InterpreterState InterpreterState BigMapCounter BigMapCounter
Lens' InterpreterState BigMapCounter
isBigMapCounterL BigMapCounter
bigMapCounter1)
  pure Value t
storageWithIds

-- | All big_maps stored in a chain have a globally unique ID.
--
-- We use this function to assign a new ID whenever a big_map is created.
assignBigMapIds
  :: (MonadState BigMapCounter m)
  => Bool
  -- ^ If true, assign a new ID even if the bigmap already has one.
  -- Otherwise, assign IDs only to bigmaps that don't have one yet.
  -> Value t -> m (Value t)
assignBigMapIds :: forall (m :: * -> *) (t :: T).
MonadState BigMapCounter m =>
Bool -> Value t -> m (Value t)
assignBigMapIds Bool
overwriteExistingId =
  DfsSettings m -> Value t -> m (Value t)
forall (t :: T) (m :: * -> *).
Monad m =>
DfsSettings m -> Value t -> m (Value t)
dfsTraverseValue DfsSettings m
forall a. Default a => a
def{ dsValueStep :: forall (t' :: T). Value t' -> m (Value t')
dsValueStep = \case
      VBigMap Maybe Natural
existingId Map (Value' Instr k) (Value' Instr v)
vBigMap | Bool
overwriteExistingId Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Maybe Natural -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Natural
existingId -> do
        Natural
bigMapId <- (Natural -> (Natural, Natural))
-> BigMapCounter -> (Natural, BigMapCounter)
Iso' BigMapCounter Natural
bigMapCounter ((Natural -> (Natural, Natural))
 -> BigMapCounter -> (Natural, BigMapCounter))
-> Natural -> m Natural
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
LensLike' ((,) a) s a -> a -> m a
<<+= Natural
1
        pure $ Maybe Natural
-> Map (Value' Instr k) (Value' Instr v)
-> Value' Instr ('TBigMap k v)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI v, Comparable k, ForbidBigMap v) =>
Maybe Natural
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
VBigMap (Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
bigMapId) Map (Value' Instr k) (Value' Instr v)
vBigMap
      Value t'
v -> Value t' -> m (Value t')
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value t'
v
    }

incrementCounter :: (InterpreterStateMonad m) => m ()
incrementCounter :: forall (m :: * -> *). InterpreterStateMonad m => m ()
incrementCounter = (InterpreterState -> InterpreterState) -> m ()
forall (m :: * -> *).
InterpreterStateMonad m =>
(InterpreterState -> InterpreterState) -> m ()
modifyInterpreterState ((InterpreterState -> InterpreterState) -> m ())
-> (InterpreterState -> InterpreterState) -> m ()
forall a b. (a -> b) -> a -> b
$ \InterpreterState
iState ->
      InterpreterState
iState { isGlobalCounter :: GlobalCounter
isGlobalCounter = InterpreterState -> GlobalCounter
isGlobalCounter InterpreterState
iState GlobalCounter -> GlobalCounter -> GlobalCounter
forall a. Num a => a -> a -> a
+ GlobalCounter
1 }

instance NFData ext => NFData (MichelsonFailed ext) where
  rnf :: MichelsonFailed ext -> ()
rnf = \case
    MichelsonFailedWith Value t
x -> Value t -> ()
forall a. NFData a => a -> ()
rnf Value t
x
    MichelsonArithError ArithError (Value n) (Value m)
x -> ArithError (Value n) (Value m) -> ()
forall a. NFData a => a -> ()
rnf ArithError (Value n) (Value m)
x
    MichelsonFailed ext
MichelsonGasExhaustion -> ()
    MichelsonFailedTestAssert Text
x -> Text -> ()
forall a. NFData a => a -> ()
rnf Text
x
    MichelsonUnsupported Text
x -> Text -> ()
forall a. NFData a => a -> ()
rnf Text
x
    MichelsonExt ext
x -> ext -> ()
forall a. NFData a => a -> ()
rnf ext
x

instance NFData ext => NFData (MichelsonFailureWithStack ext)