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

-- | Module that provides type classes for converting to and from low-level
-- Micheline representation.
module Morley.Micheline.Class
  ( ToExpression (..)
  , FromExpError (..)
  , FromExpressionError
  , FromExp (..)
  , FromExpression
  , fromExpression
  ) where

import Control.Lens ((<>~))
import Data.Bits (Bits)
import Data.Singletons (SingI(..), demote, fromSing)
import Fmt (Buildable(..), fillSepF, indentF, nameF, pretty, punctuateF, unlinesF, (++|), (|++))

import Morley.Micheline.Expression
import Morley.Michelson.Text (mkMText, unMText)
import Morley.Michelson.TypeCheck (TcError, TypeCheckOptions(..), typeCheckingWith)
import Morley.Michelson.TypeCheck.Instr (typeCheckValue)
import Morley.Michelson.Typed
  (Contract, ForbidOp, Instr, LambdaCode'(..), Notes(..), T(..), Value, Value'(..), fromUType,
  mkUType, rfAnyInstr, toUType)
import Morley.Michelson.Typed.Convert
  (convertContractOptimized, instrToOpsOptimized, untypeValueOptimized)
import Morley.Michelson.Untyped qualified as Untyped
import Morley.Michelson.Untyped.Annotation
  (AnnotationSet(..), FieldAnn, FieldTag, RootAnn, TypeAnn, TypeTag, VarAnn, VarTag, annsCount,
  firstAnn, noAnn, secondAnn)
import Morley.Michelson.Untyped.Contract (ContractBlock(..), ContractBlockError, orderContractBlock)
import Morley.Michelson.Untyped.Instr (ExpandedInstr, ExpandedOp(..), InstrAbstract(..))
import Morley.Michelson.Untyped.Type (Ty(..))
import Morley.Michelson.Untyped.View
import Morley.Util.MismatchError

-- ToExpression
----------------------------------------------------------------------------

-- | Type class that provides an ability to convert
-- something to Micheline Expression.
class ToExpression a where
  toExpression :: a -> Expression

instance ForbidOp t => ToExpression (Value t) where
  toExpression :: Value t -> Expression
toExpression = Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Value -> Expression)
-> (Value t -> Value) -> Value t -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value t -> Value
forall (t :: T). ForbidOp t => Value' Instr t -> Value
untypeValueOptimized

instance ToExpression Untyped.Value where
  toExpression :: Value -> Expression
toExpression = \case
    Untyped.ValueInt Integer
v -> Integer -> Expression
expressionInt Integer
v
    Untyped.ValueString MText
s -> Text -> Expression
expressionString (Text -> Expression) -> Text -> Expression
forall a b. (a -> b) -> a -> b
$ MText -> Text
unMText MText
s
    Untyped.ValueBytes (Untyped.InternalByteString ByteString
bs) -> ByteString -> Expression
expressionBytes ByteString
bs
    Value
Untyped.ValueUnit -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_Unit [] []
    Value
Untyped.ValueTrue -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_True [] []
    Value
Untyped.ValueFalse -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_False [] []
    Untyped.ValuePair Value
l Value
r ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_Pair [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
l, Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
r] []
    Untyped.ValueLeft Value
v -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_Left [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
    Untyped.ValueRight Value
v -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_Right [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
    Untyped.ValueSome Value
v -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_Some [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
    Value
Untyped.ValueNone -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_None [] []
    Value
Untyped.ValueNil -> [Expression] -> Expression
expressionSeq []
    Untyped.ValueSeq NonEmpty $ Value
vs -> (NonEmpty $ Value) -> Expression
forall a. ToExpression a => a -> Expression
toExpression NonEmpty $ Value
vs
    Untyped.ValueMap NonEmpty $ Elt [] ExpandedOp
elts -> NonEmpty Expression -> Expression
forall a. ToExpression a => a -> Expression
toExpression (NonEmpty Expression -> Expression)
-> NonEmpty Expression -> Expression
forall a b. (a -> b) -> a -> b
$ Elt [] ExpandedOp -> Expression
eltToExpr (Elt [] ExpandedOp -> Expression)
-> (NonEmpty $ Elt [] ExpandedOp) -> NonEmpty Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty $ Elt [] ExpandedOp
elts
    Untyped.ValueLambda [ExpandedOp]
ops -> [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops
    Untyped.ValueLamRec [ExpandedOp]
ops -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_Lambda_rec [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    where
      eltToExpr :: Untyped.Elt [] ExpandedOp -> Expression
      eltToExpr :: Elt [] ExpandedOp -> Expression
eltToExpr (Untyped.Elt Value
l Value
r) = MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_Elt
        [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
l, Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
r] []


instance ToExpression (Instr inp out) where
  toExpression :: Instr inp out -> Expression
toExpression = [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression ([ExpandedOp] -> Expression)
-> (Instr inp out -> [ExpandedOp]) -> Instr inp out -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOpsOptimized

instance ToExpression T where
  toExpression :: T -> Expression
toExpression = Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Ty -> Expression) -> (T -> Ty) -> T -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Ty
toUType

instance ToExpression (Notes t) where
  toExpression :: Notes t -> Expression
toExpression = Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Ty -> Expression) -> (Notes t -> Ty) -> Notes t -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notes t -> Ty
forall (x :: T). Notes x -> Ty
mkUType

instance ToExpression Untyped.T where
  toExpression :: T -> Expression
toExpression = \case
    T
Untyped.TKey -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_key [] []
    T
Untyped.TUnit -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_unit [] []
    T
Untyped.TSignature -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_signature [] []
    T
Untyped.TChainId -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_chain_id [] []
    Untyped.TOption Ty
arg -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_option [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    Untyped.TList Ty
arg -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_list [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    Untyped.TSet Ty
arg -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_set [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    T
Untyped.TOperation -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_operation [] []
    Untyped.TContract Ty
arg -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_contract [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    Untyped.TTicket Ty
arg -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_ticket [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    t :: T
t@Untyped.TPair{} -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_pair (T -> [Expression]
rightCombedPairToList T
t) []
    Untyped.TOr FieldAnn
fa1 FieldAnn
fa2 Ty
l Ty
r ->
      let exprL :: Expression
exprL = Expression -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Expression
forall (x :: ExpExtensionDescriptorKind).
Exp x -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Exp x
addTrimmedAnns (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
l) [] [FieldAnn
fa1] []
          exprR :: Expression
exprR = Expression -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Expression
forall (x :: ExpExtensionDescriptorKind).
Exp x -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Exp x
addTrimmedAnns (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
r) [] [FieldAnn
fa2] []
      in MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_or [Expression
exprL, Expression
exprR] []
    Untyped.TLambda Ty
inp Ty
out ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_lambda [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
inp, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
out] []
    Untyped.TMap Ty
k Ty
v ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_map [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
k, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
v] []
    Untyped.TBigMap Ty
k Ty
v ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_big_map [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
k, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
v] []
    T
Untyped.TInt -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_int [] []
    T
Untyped.TNat -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_nat [] []
    T
Untyped.TString -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_string [] []
    T
Untyped.TBytes -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_bytes [] []
    T
Untyped.TMutez -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_mutez [] []
    T
Untyped.TBool -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_bool [] []
    T
Untyped.TKeyHash -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_key_hash [] []
    T
Untyped.TBls12381Fr -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_bls12_381_fr [] []
    T
Untyped.TBls12381G1 -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_bls12_381_g1 [] []
    T
Untyped.TBls12381G2 -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_bls12_381_g2 [] []
    T
Untyped.TTimestamp -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_timestamp [] []
    T
Untyped.TAddress -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_address [] []
    T
Untyped.TChest -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_chest [] []
    T
Untyped.TChestKey -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_chest_key [] []
    T
Untyped.TNever -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_never [] []
    Untyped.TSaplingState Natural
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_sapling_state [Natural -> Expression
forall i. Integral i => i -> Expression
integralToExpr Natural
n] []
    Untyped.TSaplingTransaction Natural
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_sapling_transaction [Natural -> Expression
forall i. Integral i => i -> Expression
integralToExpr Natural
n] []

    where
      addAnns :: Expression -> [Annotation] -> Expression
      addAnns :: Expression -> [Annotation] -> Expression
addAnns Expression
e [Annotation]
anns =
        Expression
e Expression -> (Expression -> Expression) -> Expression
forall a b. a -> (a -> b) -> b
& (MichelinePrimAp RegularExp
 -> Identity (MichelinePrimAp RegularExp))
-> Expression -> Identity Expression
Prism' Expression (MichelinePrimAp RegularExp)
_ExpressionPrim ((MichelinePrimAp RegularExp
  -> Identity (MichelinePrimAp RegularExp))
 -> Expression -> Identity Expression)
-> (([Annotation] -> Identity [Annotation])
    -> MichelinePrimAp RegularExp
    -> Identity (MichelinePrimAp RegularExp))
-> ([Annotation] -> Identity [Annotation])
-> Expression
-> Identity Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp RegularExp
-> Identity (MichelinePrimAp RegularExp)
forall (x :: ExpExtensionDescriptorKind) (f :: * -> *).
Functor f =>
([Annotation] -> f [Annotation])
-> MichelinePrimAp x -> f (MichelinePrimAp x)
mpaAnnotsL (([Annotation] -> Identity [Annotation])
 -> Expression -> Identity Expression)
-> [Annotation] -> Expression -> Expression
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Annotation]
anns

      rightCombedPairToList :: Untyped.T -> [Expression]
      rightCombedPairToList :: T -> [Expression]
rightCombedPairToList T
t =
        let go :: Ty -> (FieldAnn, VarAnn) -> [Expression]
go Ty
ty (FieldAnn
fa, VarAnn
va)
              | Ty (Untyped.TPair FieldAnn
faL FieldAnn
faR VarAnn
vaL VarAnn
vaR Ty
l Ty
r) TypeAnn
ta <- Ty
ty
              , TypeAnn
ta TypeAnn -> TypeAnn -> Bool
forall a. Eq a => a -> a -> Bool
== TypeAnn
forall {k} (a :: k). Annotation a
noAnn, FieldAnn
fa FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn
va VarAnn -> VarAnn -> Bool
forall a. Eq a => a -> a -> Bool
== VarAnn
forall {k} (a :: k). Annotation a
noAnn
              = Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
l Expression -> [Annotation] -> Expression
`addAnns` [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
faL] [VarAnn
vaL] Expression -> [Expression] -> [Expression]
forall a. a -> [a] -> [a]
: Ty -> (FieldAnn, VarAnn) -> [Expression]
go Ty
r (FieldAnn
faR, VarAnn
vaR)
              | Bool
otherwise
              = OneItem [Expression] -> [Expression]
forall x. One x => OneItem x -> x
one (OneItem [Expression] -> [Expression])
-> OneItem [Expression] -> [Expression]
forall a b. (a -> b) -> a -> b
$ Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty Expression -> [Annotation] -> Expression
`addAnns` [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
        in Ty -> (FieldAnn, VarAnn) -> [Expression]
go (T -> TypeAnn -> Ty
Ty T
t TypeAnn
forall {k} (a :: k). Annotation a
noAnn) (FieldAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn
forall {k} (a :: k). Annotation a
noAnn)

instance ToExpression Ty where
  toExpression :: Ty -> Expression
toExpression (Ty T
t TypeAnn
ta) = Expression -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Expression
forall (x :: ExpExtensionDescriptorKind).
Exp x -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Exp x
addTrimmedAnns (T -> Expression
forall a. ToExpression a => a -> Expression
toExpression T
t) [TypeAnn
ta] [] []

instance (ToExpression a) => ToExpression [a] where
  toExpression :: [a] -> Expression
toExpression [a]
xs = [Expression] -> Expression
expressionSeq ([Expression] -> Expression) -> [Expression] -> Expression
forall a b. (a -> b) -> a -> b
$ a -> Expression
forall a. ToExpression a => a -> Expression
toExpression (a -> Expression) -> [a] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs

instance (ToExpression a) => ToExpression (NonEmpty a) where
  toExpression :: NonEmpty a -> Expression
toExpression = [a] -> Expression
forall a. ToExpression a => a -> Expression
toExpression ([a] -> Expression)
-> (NonEmpty a -> [a]) -> NonEmpty a -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
NonEmpty a -> [Element (NonEmpty a)]
forall t. Container t => t -> [Element t]
toList

instance ToExpression Expression where
  toExpression :: Expression -> Expression
toExpression = Expression -> Expression
forall a. a -> a
id

instance ToExpression ExpandedOp where
  toExpression :: ExpandedOp -> Expression
toExpression = \case
    PrimEx ExpandedInstr
instr   -> ExpandedInstr -> Expression
forall a. ToExpression a => a -> Expression
toExpression ExpandedInstr
instr
    SeqEx [ExpandedOp]
s        -> [Expression] -> Expression
expressionSeq ([Expression] -> Expression) -> [Expression] -> Expression
forall a b. (a -> b) -> a -> b
$ ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression (ExpandedOp -> Expression) -> [ExpandedOp] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExpandedOp]
s
    WithSrcEx ErrorSrcPos
_ ExpandedOp
op -> ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression ExpandedOp
op

instance ToExpression ViewName where
  toExpression :: ViewName -> Expression
toExpression (ViewName Text
s) = Text -> Expression
expressionString Text
s

-- Note: On adding new expressions here, you must also add the symmetric (reading) case
-- to FromExp x (InstrAbstract [] op) as well.
instance ToExpression ExpandedInstr where
  toExpression :: ExpandedInstr -> Expression
toExpression = \case
    PUSH VarAnn
va Ty
ty Value
v -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_PUSH [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty, Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ExpandedInstr
DROP -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_DROP [] []
    DROPN Word
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_DROP [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
    DUP VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_DUP [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    DUPN VarAnn
va Word
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_DUP [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ExpandedInstr
SWAP -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SWAP [] []
    DIG Word
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_DIG [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
    DUG Word
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_DUG [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
    SOME TypeAnn
ta VarAnn
va ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SOME [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
    NONE TypeAnn
ta VarAnn
va Ty
ty -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_NONE [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
    UNIT TypeAnn
ta VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_UNIT [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
    IF_NONE [ExpandedOp]
ops1 [ExpandedOp]
ops2 ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_IF_NONE [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops1, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops2] []
    PAIR TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_PAIR [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va]
    UNPAIR VarAnn
va1 VarAnn
va2 FieldAnn
fa1 FieldAnn
fa2 -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_UNPAIR [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va1, VarAnn
va2]
    PAIRN VarAnn
va Word
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_PAIR [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    UNPAIRN Word
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_UNPAIR [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
    CAR VarAnn
va FieldAnn
fa -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_CAR [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
    CDR VarAnn
va FieldAnn
fa -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_CDR [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
    LEFT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
ty -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_LEFT [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va]
    RIGHT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
ty -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_RIGHT [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va]
    IF_LEFT [ExpandedOp]
ops1 [ExpandedOp]
ops2 ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_IF_LEFT [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops1, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops2] []
    NIL TypeAnn
ta VarAnn
va Ty
ty -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_NIL [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
    CONS VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_CONS [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    IF_CONS [ExpandedOp]
ops1 [ExpandedOp]
ops2 ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_IF_CONS [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops1, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops2] []
    SIZE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SIZE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    EMPTY_SET TypeAnn
ta VarAnn
va Ty
ty -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_EMPTY_SET [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
    EMPTY_MAP TypeAnn
ta VarAnn
va Ty
kty Ty
vty ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_EMPTY_MAP [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
kty, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
vty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
    EMPTY_BIG_MAP TypeAnn
ta VarAnn
va Ty
kty Ty
vty ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_EMPTY_BIG_MAP [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
kty, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
vty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
    MAP VarAnn
va [ExpandedOp]
ops -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_MAP [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ITER [ExpandedOp]
ops -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_ITER [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    MEM VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_MEM [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    GET VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_GET [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    GETN VarAnn
va Word
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_GET [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    UPDATE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_UPDATE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    UPDATEN VarAnn
va Word
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_UPDATE [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    GET_AND_UPDATE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_GET_AND_UPDATE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    IF [ExpandedOp]
ops1 [ExpandedOp]
ops2 ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_IF [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops1, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops2] []
    LOOP [ExpandedOp]
ops -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_LOOP [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    LOOP_LEFT [ExpandedOp]
ops -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_LOOP_LEFT [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    LAMBDA VarAnn
va Ty
tyin Ty
tyout [ExpandedOp]
ops ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_LAMBDA [ Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
tyin
                            , Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
tyout
                            , [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops
                            ] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    LAMBDA_REC VarAnn
va Ty
tyin Ty
tyout [ExpandedOp]
ops ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_LAMBDA_REC [ Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
tyin
                            , Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
tyout
                            , [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops
                            ] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    EXEC VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_EXEC [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    APPLY VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_APPLY [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    DIP [ExpandedOp]
ops -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_DIP [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    DIPN Word
n [ExpandedOp]
ops -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_DIP [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    ExpandedInstr
FAILWITH -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_FAILWITH [] []
    CAST VarAnn
va Ty
ty -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_CAST [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    RENAME VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_RENAME [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    PACK VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_PACK [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    UNPACK TypeAnn
ta VarAnn
va Ty
ty -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_UNPACK [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
    CONCAT VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_CONCAT [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SLICE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SLICE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ISNAT VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_ISNAT [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ADD VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_ADD [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SUB VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SUB [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SUB_MUTEZ VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SUB_MUTEZ [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    MUL VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_MUL [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    EDIV VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_EDIV [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ABS VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_ABS [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    NEG VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_NEG [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    LSL VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_LSL [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    LSR VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_LSR [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    OR VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_OR [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    AND VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_AND [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    XOR VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_XOR [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    NOT VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_NOT [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    COMPARE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_COMPARE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    Untyped.EQ VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_EQ [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    NEQ VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_NEQ [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    Untyped.LT VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_LT [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    Untyped.GT VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_GT [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    LE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_LE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    GE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_GE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    INT VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_INT [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    NAT VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_NAT [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    BYTES VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_BYTES [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    VIEW VarAnn
va ViewName
n Ty
t -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_VIEW [ViewName -> Expression
forall a. ToExpression a => a -> Expression
toExpression ViewName
n, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
t] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SELF VarAnn
va FieldAnn
fa -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SELF [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
    CONTRACT VarAnn
va FieldAnn
fa Ty
ty -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_CONTRACT [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
    TRANSFER_TOKENS VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_TRANSFER_TOKENS [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SET_DELEGATE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SET_DELEGATE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    CREATE_CONTRACT VarAnn
va1 VarAnn
va2 Contract' ExpandedOp
c ->
      MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_CREATE_CONTRACT [Contract' ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression Contract' ExpandedOp
c] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va1, VarAnn
va2]
    IMPLICIT_ACCOUNT VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_IMPLICIT_ACCOUNT [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    NOW VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_NOW [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    AMOUNT VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_AMOUNT [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    BALANCE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_BALANCE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    VOTING_POWER VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_VOTING_POWER [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    TOTAL_VOTING_POWER VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_TOTAL_VOTING_POWER [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    CHECK_SIGNATURE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_CHECK_SIGNATURE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SHA256 VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SHA256 [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SHA512 VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SHA512 [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    BLAKE2B VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_BLAKE2B [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SHA3 VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SHA3 [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    KECCAK VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_KECCAK [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    HASH_KEY VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_HASH_KEY [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    PAIRING_CHECK VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_PAIRING_CHECK [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SOURCE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SOURCE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SENDER VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SENDER [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ADDRESS VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_ADDRESS [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    CHAIN_ID VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_CHAIN_ID [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    LEVEL VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_LEVEL [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SELF_ADDRESS VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SELF_ADDRESS [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    TICKET VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_TICKET [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    TICKET_DEPRECATED VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_TICKET_DEPRECATED [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    READ_TICKET VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_READ_TICKET [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SPLIT_TICKET VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SPLIT_TICKET [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    JOIN_TICKETS VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_JOIN_TICKETS [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    OPEN_CHEST VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_OPEN_CHEST [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ExpandedInstr
NEVER -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_NEVER [] []
    EXT ExtInstrAbstract [] ExpandedOp
_ -> [Expression] -> Expression
expressionSeq []
    SAPLING_EMPTY_STATE VarAnn
va Natural
n -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SAPLING_EMPTY_STATE [Natural -> Expression
forall i. Integral i => i -> Expression
integralToExpr Natural
n] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SAPLING_VERIFY_UPDATE VarAnn
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_SAPLING_VERIFY_UPDATE [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    MIN_BLOCK_TIME [AnyAnn]
va -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_MIN_BLOCK_TIME [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [AnyAnn] -> [Annotation]
mkAnnsFromAny [AnyAnn]
va
    EMIT VarAnn
va FieldAnn
tag Maybe Ty
ty -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_EMIT (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Ty -> Expression) -> [Ty] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Ty -> [Ty]
forall a. Maybe a -> [a]
maybeToList Maybe Ty
ty) ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
tag] [VarAnn
va]

instance ToExpression Untyped.Contract where
  toExpression :: Contract' ExpandedOp -> Expression
toExpression Contract' ExpandedOp
contract
    = [Expression] -> Expression
expressionSeq ([Expression] -> Expression) -> [Expression] -> Expression
forall a b. (a -> b) -> a -> b
$ Contract' ExpandedOp
-> (ParameterType -> Expression)
-> (Ty -> Expression)
-> (ExpandedOp -> Expression)
-> (View' ExpandedOp -> Expression)
-> [Expression]
forall op a.
Contract' op
-> (ParameterType -> a)
-> (Ty -> a)
-> (op -> a)
-> (View' op -> a)
-> [a]
Untyped.mapEntriesOrdered Contract' ExpandedOp
contract
          (\(Untyped.ParameterType Ty
ty FieldAnn
rootAnn) -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_parameter
            [HasCallStack => Expression -> FieldAnn -> Expression
Expression -> FieldAnn -> Expression
insertRootAnn (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty) FieldAnn
rootAnn] [])
          (\Ty
storage -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_storage [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
storage] [])
          (\ExpandedOp
code -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_code [ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression ExpandedOp
code] [])
          (\Untyped.View{Ty
ViewName
ExpandedOp
viewName :: ViewName
viewArgument :: Ty
viewReturn :: Ty
viewCode :: ExpandedOp
viewName :: forall op. View' op -> ViewName
viewArgument :: forall op. View' op -> Ty
viewReturn :: forall op. View' op -> Ty
viewCode :: forall op. View' op -> op
..} -> MichelinePrimitive -> [Expression] -> [Annotation] -> Expression
expressionPrim' MichelinePrimitive
Prim_view
            [ViewName -> Expression
forall a. ToExpression a => a -> Expression
toExpression ViewName
viewName, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
viewArgument, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
viewReturn, ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression ExpandedOp
viewCode] []
          )

instance ToExpression (Contract cp st) where
  toExpression :: Contract cp st -> Expression
toExpression = Contract' ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Contract' ExpandedOp -> Expression)
-> (Contract cp st -> Contract' ExpandedOp)
-> Contract cp st
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract cp st -> Contract' ExpandedOp
forall (param :: T) (store :: T).
Contract param store -> Contract' ExpandedOp
convertContractOptimized

-- FromExpression
----------------------------------------------------------------------------

-- | Errors that can happen when we convert an 'Exp' to our
-- data type.
data FromExpError x = FromExpError (Exp x) FromExpErrorReason

deriving stock instance Show (Exp x) => Show (FromExpError x)
deriving stock instance Eq (Exp x) => Eq (FromExpError x)

data FromExpErrorReason
  = FEERMTextDecodingFailure Text
  | FEERTcError T TcError
  | FEERNotEnoughArguments Word Int
  | FEERUnexpectedPrim (Maybe MichelinePrimitive) MichelinePrimitive
  | FEERUnexpectedPrimClass MichelinePrimitiveTag MichelinePrimitiveTag
  | FEERArgumentCountMismatch (NonEmpty Word) Int
  | FEERUnexpectedAnnotations
  | FEERExpectedPrim (NonEmpty MichelinePrimitiveTag)
  | FEERExpectedSeq
  | FEERUnsupported
  | FEERDeprecated
  | FEERTooManyAnns (Maybe Int, Maybe Int, Maybe Int) (Int, Int, Int)
  | FEEROutOfBounds
  | FEERExpectedNumber
  | FEERExpectedString
  | FEERViewNameError BadViewNameError
  | FEERBadContractBlocks (NonEmpty ContractBlockError)
  deriving stock (Int -> FromExpErrorReason -> ShowS
[FromExpErrorReason] -> ShowS
FromExpErrorReason -> String
(Int -> FromExpErrorReason -> ShowS)
-> (FromExpErrorReason -> String)
-> ([FromExpErrorReason] -> ShowS)
-> Show FromExpErrorReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FromExpErrorReason -> ShowS
showsPrec :: Int -> FromExpErrorReason -> ShowS
$cshow :: FromExpErrorReason -> String
show :: FromExpErrorReason -> String
$cshowList :: [FromExpErrorReason] -> ShowS
showList :: [FromExpErrorReason] -> ShowS
Show, FromExpErrorReason -> FromExpErrorReason -> Bool
(FromExpErrorReason -> FromExpErrorReason -> Bool)
-> (FromExpErrorReason -> FromExpErrorReason -> Bool)
-> Eq FromExpErrorReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FromExpErrorReason -> FromExpErrorReason -> Bool
== :: FromExpErrorReason -> FromExpErrorReason -> Bool
$c/= :: FromExpErrorReason -> FromExpErrorReason -> Bool
/= :: FromExpErrorReason -> FromExpErrorReason -> Bool
Eq)

instance Buildable FromExpErrorReason where
  build :: FromExpErrorReason -> Doc
build = \case
    FEERMTextDecodingFailure Text
msg -> Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Text decoding failure" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
forall a. Buildable a => a -> Doc
build Text
msg
    FEERTcError T
ty TcError
err -> [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
      [ Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Failed to typecheck expression as a value of type" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ T -> Doc
forall a. Buildable a => a -> Doc
build T
ty
      , Doc
forall a. Monoid a => a
mempty
      , Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Typechecker error" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ TcError -> Doc
forall a. Buildable a => a -> Doc
build TcError
err
      ]
    FEERNotEnoughArguments Word
minArgs Int
numArgs ->
      Text
"Expected at least" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Word
minArgs Word -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Text
"arguments, but got" Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| Int
numArgs Int -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
""
    FEERUnexpectedPrim Maybe MichelinePrimitive
expected MichelinePrimitive
got ->
      Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Unexpected primitive" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ case Maybe MichelinePrimitive
expected of
        Maybe MichelinePrimitive
Nothing -> MichelinePrimitive -> Doc
forall a. Buildable a => a -> Doc
build MichelinePrimitive
got
        Just MichelinePrimitive
e -> MismatchError MichelinePrimitive -> Doc
forall a. Buildable a => a -> Doc
build MkMismatchError { meExpected :: MichelinePrimitive
meExpected = MichelinePrimitive
e, meActual :: MichelinePrimitive
meActual = MichelinePrimitive
got }
    FEERUnexpectedPrimClass MichelinePrimitiveTag
expected MichelinePrimitiveTag
got ->
      Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Unexpected primitive class" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ MismatchError MichelinePrimitiveTag -> Doc
forall a. Buildable a => a -> Doc
build (MismatchError MichelinePrimitiveTag -> Doc)
-> MismatchError MichelinePrimitiveTag -> Doc
forall a b. (a -> b) -> a -> b
$ MkMismatchError
        { meExpected :: MichelinePrimitiveTag
meExpected = MichelinePrimitiveTag
expected, meActual :: MichelinePrimitiveTag
meActual = MichelinePrimitiveTag
got }
    FEERArgumentCountMismatch NonEmpty Word
expected Int
got ->
      [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
fillSepF
        ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"Expected exactly"
        Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> Doc -> NonEmpty Word -> [Doc]
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Doc -> Doc -> t a -> [Doc]
punctuateF Doc
"," Doc
" or" NonEmpty Word
expected [Doc] -> [Doc] -> [Doc]
forall a. Semigroup a => a -> a -> a
<>
        [ Doc
"arguments, but got"
        , Int -> Doc
forall a. Buildable a => a -> Doc
build Int
got
        ]
    FromExpErrorReason
FEERUnexpectedAnnotations -> Doc
"Unexpected annotations"
    FEERExpectedPrim NonEmpty MichelinePrimitiveTag
prims -> [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
fillSepF
      ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"Expected primitive"
      Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> Doc -> NonEmpty MichelinePrimitiveTag -> [Doc]
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Doc -> Doc -> t a -> [Doc]
punctuateF Doc
"," Doc
" or" NonEmpty MichelinePrimitiveTag
prims
    FromExpErrorReason
FEERExpectedSeq -> Doc
"Expected sequence"
    FEERTooManyAnns (Maybe Int
maxTas, Maybe Int
maxFas, Maybe Int
maxVas) (Int
tasCnt, Int
fasCnt, Int
vasCnt) -> [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
      [ Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Expected at most" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes
          [ (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" type annotations")    (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
forall a. Buildable a => a -> Doc
build (Int -> Doc) -> Maybe Int -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxTas
          , (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" field annotations")   (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
forall a. Buildable a => a -> Doc
build (Int -> Doc) -> Maybe Int -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxFas
          , (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" variable annotations") (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
forall a. Buildable a => a -> Doc
build (Int -> Doc) -> Maybe Int -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxVas
          ]
      , Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"but found" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes
          [ (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" type annotations")     (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
forall a. Buildable a => a -> Doc
build (Int -> Doc) -> Maybe Int -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Int
maxTas Maybe Int -> Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
tasCnt)
          , (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" field annotations")    (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
forall a. Buildable a => a -> Doc
build (Int -> Doc) -> Maybe Int -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Int
maxFas Maybe Int -> Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
fasCnt)
          , (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" variable annotations") (Doc -> Doc) -> (Int -> Doc) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
forall a. Buildable a => a -> Doc
build (Int -> Doc) -> Maybe Int -> Maybe Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Int
maxVas Maybe Int -> Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
vasCnt)
          ]
      ]
    FromExpErrorReason
FEEROutOfBounds -> Doc
"Value is out of bounds"
    FEERBadContractBlocks NonEmpty ContractBlockError
cbes -> NonEmpty Doc -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ContractBlockError -> Doc
forall a. Buildable a => a -> Doc
build (ContractBlockError -> Doc)
-> NonEmpty ContractBlockError -> NonEmpty Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ContractBlockError
cbes
    FromExpErrorReason
FEERUnsupported -> Doc
"Unsupported"
    FromExpErrorReason
FEERDeprecated -> Doc
"Deprecated primitive"
    FromExpErrorReason
FEERExpectedNumber -> Doc
"Expected number"
    FromExpErrorReason
FEERExpectedString -> Doc
"Expected string"
    FEERViewNameError BadViewNameError
err -> Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"View name error" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ BadViewNameError -> Doc
forall a. Buildable a => a -> Doc
build BadViewNameError
err

-- | Error in case of vanilla expression.
type FromExpressionError = FromExpError RegularExp

instance Buildable FromExpressionError where
  build :: FromExpressionError -> Doc
build (FromExpError Expression
expr FromExpErrorReason
err) =
    [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
      [ Doc
"Failed to convert expression:"
      , Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Expression -> Doc
forall a. Buildable a => a -> Doc
build Expression
expr
      , Doc
""
      , Doc
"Error:"
      , Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ FromExpErrorReason -> Doc
forall a. Buildable a => a -> Doc
build FromExpErrorReason
err
      ]

instance Exception FromExpressionError where
  displayException :: FromExpressionError -> String
displayException = FromExpressionError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty

-- | Type class that provides the ability to convert
-- something from a Micheline Expression.
class FromExp x a where
  fromExp :: Exp x -> Either (FromExpError x) a

type FromExpression = FromExp RegularExp

-- | Parse vanilla expression to something.
fromExpression
  :: FromExp RegularExp a
  => Expression -> Either FromExpressionError a
fromExpression :: forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression = Expression -> Either FromExpressionError a
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp

instance (FromExp x Untyped.Value, SingI t) => FromExp x (Value t) where
  fromExp :: Exp x -> Either (FromExpError x) (Value t)
fromExp Exp x
expr =
    case forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @_ @Untyped.Value Exp x
expr of
    Right Value
uv -> case Value -> Either TcError (Value t)
forall {t :: T}. SingI t => Value -> Either TcError (Value t)
typeCheck Value
uv of
      Left TcError
tcErr -> FromExpError x -> Either (FromExpError x) (Value t)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Value t))
-> FromExpError x -> Either (FromExpError x) (Value t)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
expr (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ T -> TcError -> FromExpErrorReason
FEERTcError (forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @t) TcError
tcErr
      Right Value t
tv -> Value t -> Either (FromExpError x) (Value t)
forall a b. b -> Either a b
Right Value t
tv
    Left FromExpError x
e -> FromExpError x -> Either (FromExpError x) (Value t)
forall a b. a -> Either a b
Left FromExpError x
e
    where
      typeCheck :: Value -> Either TcError (Value t)
typeCheck Value
uv = TypeCheckOptions
-> TypeCheckResult ExpandedOp (Value t) -> Either TcError (Value t)
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith (Bool -> Bool -> TypeCheckOptions
TypeCheckOptions Bool
False Bool
False) (TypeCheckResult ExpandedOp (Value t) -> Either TcError (Value t))
-> TypeCheckResult ExpandedOp (Value t) -> Either TcError (Value t)
forall a b. (a -> b) -> a -> b
$
        Value -> TypeCheckResult ExpandedOp (Value t)
forall (t :: T).
SingI t =>
Value -> TypeCheckResult ExpandedOp (Value t)
typeCheckValue Value
uv

instance FromExp x op => FromExp x (Untyped.Value' [] op) where
  fromExp :: Exp x -> Either (FromExpError x) (Value' [] op)
fromExp Exp x
e = case Exp x
e of
    ExpInt XExpInt x
_ Integer
v -> Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' [] op -> Either (FromExpError x) (Value' [] op))
-> Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ Integer -> Value' [] op
forall {k} (f :: k -> *) (op :: k). Integer -> Value' f op
Untyped.ValueInt Integer
v
    ExpString XExpString x
_ Text
s ->
      (Text -> FromExpError x)
-> Either Text (Value' [] op)
-> Either (FromExpError x) (Value' [] op)
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 (Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> (Text -> FromExpErrorReason) -> Text -> FromExpError x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FromExpErrorReason
FEERMTextDecodingFailure)
        (MText -> Value' [] op
forall {k} (f :: k -> *) (op :: k). MText -> Value' f op
Untyped.ValueString (MText -> Value' [] op)
-> Either Text MText -> Either Text (Value' [] op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text MText
mkMText Text
s)
    ExpBytes XExpBytes x
_ ByteString
bs -> Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' [] op -> Either (FromExpError x) (Value' [] op))
-> Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ InternalByteString -> Value' [] op
forall {k} (f :: k -> *) (op :: k).
InternalByteString -> Value' f op
Untyped.ValueBytes (InternalByteString -> Value' [] op)
-> InternalByteString -> Value' [] op
forall a b. (a -> b) -> a -> b
$ ByteString -> InternalByteString
Untyped.InternalByteString ByteString
bs
    ExpPrim XExpPrim x
_ (MichelinePrimAp MichelinePrimitive
prim [Exp x]
args [Annotation]
_) -> MichelinePrimitive
-> (forall (tag :: MichelinePrimitiveTag).
    Sing tag
    -> ClassifiedMichelinePrimitive tag
    -> Either (FromExpError x) (Value' [] op))
-> Either (FromExpError x) (Value' [] op)
forall r.
MichelinePrimitive
-> (forall (tag :: MichelinePrimitiveTag).
    Sing tag -> ClassifiedMichelinePrimitive tag -> r)
-> r
withClassifiedPrim MichelinePrimitive
prim \case
      Sing tag
SingMichelinePrimitiveTag tag
SMPTValue -> \case
        ClassifiedMichelinePrimitive tag
C_Prim_Unit -> Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a r. WithArgsRec x a r => a -> Either (FromExpError x) r
withArgs Value' [] op
forall {k} (f :: k -> *) (op :: k). Value' f op
Untyped.ValueUnit
        ClassifiedMichelinePrimitive tag
C_Prim_True -> Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a r. WithArgsRec x a r => a -> Either (FromExpError x) r
withArgs Value' [] op
forall {k} (f :: k -> *) (op :: k). Value' f op
Untyped.ValueTrue
        ClassifiedMichelinePrimitive tag
C_Prim_False -> Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a r. WithArgsRec x a r => a -> Either (FromExpError x) r
withArgs Value' [] op
forall {k} (f :: k -> *) (op :: k). Value' f op
Untyped.ValueFalse
        ClassifiedMichelinePrimitive tag
C_Prim_Pair ->
          case [Exp x] -> Maybe (NonEmpty (Exp x))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Exp x]
args Maybe (NonEmpty (Exp x))
-> (NonEmpty (Exp x) -> Maybe (NonEmpty (Exp x)))
-> Maybe (NonEmpty (Exp x))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NonEmpty (Exp x) -> Maybe (NonEmpty (Exp x))
forall a. NonEmpty a -> Maybe (NonEmpty a)
forbidSingletonList of
            Maybe (NonEmpty (Exp x))
Nothing -> FromExpError x -> Either (FromExpError x) (Value' [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Value' [] op))
-> FromExpError x -> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ Word -> Int -> FromExpErrorReason
FEERNotEnoughArguments Word
2 ([Exp x] -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length [Exp x]
args)
            Just NonEmpty (Exp x)
args' -> do
              NonEmpty (Value' [] op)
tys <- (Exp x -> Either (FromExpError x) (Value' [] op))
-> NonEmpty (Exp x)
-> Either (FromExpError x) (NonEmpty (Value' [] op))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM Exp x -> Either (FromExpError x) (Value' [] op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp NonEmpty (Exp x)
args'
              return $ (Value' [] op -> Value' [] op -> Value' [] op)
-> NonEmpty (Value' [] op) -> Value' [] op
forall a. (a -> a -> a) -> NonEmpty a -> a
foldr1 Value' [] op -> Value' [] op -> Value' [] op
forall {k} (f :: k -> *) (op :: k).
Value' f op -> Value' f op -> Value' f op
Untyped.ValuePair NonEmpty (Value' [] op)
tys
        ClassifiedMichelinePrimitive tag
C_Prim_Left -> (Value' [] op -> Value' [] op)
-> Either (FromExpError x) (Value' [] op)
forall a r. WithArgsRec x a r => a -> Either (FromExpError x) r
withArgs Value' [] op -> Value' [] op
forall {k} (f :: k -> *) (op :: k). Value' f op -> Value' f op
Untyped.ValueLeft
        ClassifiedMichelinePrimitive tag
C_Prim_Right -> (Value' [] op -> Value' [] op)
-> Either (FromExpError x) (Value' [] op)
forall a r. WithArgsRec x a r => a -> Either (FromExpError x) r
withArgs Value' [] op -> Value' [] op
forall {k} (f :: k -> *) (op :: k). Value' f op -> Value' f op
Untyped.ValueRight
        ClassifiedMichelinePrimitive tag
C_Prim_Some -> (Value' [] op -> Value' [] op)
-> Either (FromExpError x) (Value' [] op)
forall a r. WithArgsRec x a r => a -> Either (FromExpError x) r
withArgs Value' [] op -> Value' [] op
forall {k} (f :: k -> *) (op :: k). Value' f op -> Value' f op
Untyped.ValueSome
        ClassifiedMichelinePrimitive tag
C_Prim_None -> Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a r. WithArgsRec x a r => a -> Either (FromExpError x) r
withArgs Value' [] op
forall {k} (f :: k -> *) (op :: k). Value' f op
Untyped.ValueNone
        ClassifiedMichelinePrimitive tag
C_Prim_Lambda_rec -> ([op] -> Value' [] op) -> Either (FromExpError x) (Value' [] op)
forall a r. WithArgsRec x a r => a -> Either (FromExpError x) r
withArgs [op] -> Value' [] op
forall {k} (f :: k -> *) (op :: k). f op -> Value' f op
Untyped.ValueLamRec
        ClassifiedMichelinePrimitive tag
C_Prim_Elt -> FromExpError x -> Either (FromExpError x) (Value' [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Value' [] op))
-> FromExpError x -> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ Maybe MichelinePrimitive
-> MichelinePrimitive -> FromExpErrorReason
FEERUnexpectedPrim Maybe MichelinePrimitive
forall a. Maybe a
Nothing MichelinePrimitive
Prim_Elt
      Sing tag
s -> Either (FromExpError x) (Value' [] op)
-> ClassifiedMichelinePrimitive tag
-> Either (FromExpError x) (Value' [] op)
forall a b. a -> b -> a
const (Either (FromExpError x) (Value' [] op)
 -> ClassifiedMichelinePrimitive tag
 -> Either (FromExpError x) (Value' [] op))
-> Either (FromExpError x) (Value' [] op)
-> ClassifiedMichelinePrimitive tag
-> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ FromExpError x -> Either (FromExpError x) (Value' [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Value' [] op))
-> FromExpError x -> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ MichelinePrimitiveTag
-> MichelinePrimitiveTag -> FromExpErrorReason
FEERUnexpectedPrimClass MichelinePrimitiveTag
MPTValue (Sing tag -> Demote MichelinePrimitiveTag
forall k (a :: k). SingKind k => Sing a -> Demote k
forall (a :: MichelinePrimitiveTag).
Sing a -> Demote MichelinePrimitiveTag
fromSing Sing tag
s)
      where
        withArgs :: WithArgsRec x a r => a -> Either (FromExpError x) r
        withArgs :: forall a r. WithArgsRec x a r => a -> Either (FromExpError x) r
withArgs = Exp x -> [Exp x] -> a -> Either (FromExpError x) r
forall (x :: ExpExtensionDescriptorKind) a r.
WithArgsRec x a r =>
Exp x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec Exp x
e [Exp x]
args
    ExpSeq XExpSeq x
_ [] -> Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' [] op
forall {k} (f :: k -> *) (op :: k). Value' f op
Untyped.ValueNil
    ExpSeq XExpSeq x
_ (Exp x
h : [Exp x]
t) ->
      case forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @op Exp x
h of
      Right op
op -> do
        [op]
ops <- (Exp x -> Either (FromExpError x) op)
-> [Exp x] -> Either (FromExpError x) [op]
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 (forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @op) [Exp x]
t
        Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' [] op -> Either (FromExpError x) (Value' [] op))
-> ([op] -> Value' [] op)
-> [op]
-> Either (FromExpError x) (Value' [] op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [op] -> Value' [] op
forall {k} (f :: k -> *) (op :: k). f op -> Value' f op
Untyped.ValueLambda ([op] -> Either (FromExpError x) (Value' [] op))
-> [op] -> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ op
op op -> [op] -> [op]
forall a. a -> [a] -> [a]
: [op]
ops
      Left FromExpError x
_ -> case Exp x -> Either (FromExpError x) (Elt [] op)
exprToElt Exp x
h of
        Right Elt [] op
elt -> do
          [Elt [] op]
elts <- (Exp x -> Either (FromExpError x) (Elt [] op))
-> [Exp x] -> Either (FromExpError x) [Elt [] op]
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 Exp x -> Either (FromExpError x) (Elt [] op)
exprToElt [Exp x]
t
          Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' [] op -> Either (FromExpError x) (Value' [] op))
-> ((NonEmpty $ Elt [] op) -> Value' [] op)
-> (NonEmpty $ Elt [] op)
-> Either (FromExpError x) (Value' [] op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty $ Elt [] op) -> Value' [] op
forall {k} (f :: k -> *) (op :: k).
(NonEmpty $ Elt f op) -> Value' f op
Untyped.ValueMap ((NonEmpty $ Elt [] op) -> Either (FromExpError x) (Value' [] op))
-> (NonEmpty $ Elt [] op) -> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ Elt [] op
elt Elt [] op -> [Elt [] op] -> NonEmpty $ Elt [] op
forall a. a -> [a] -> NonEmpty a
:| [Elt [] op]
elts
        Left FromExpError x
_ -> case Exp x -> Either (FromExpError x) (Value' [] op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
h of
          Left (FromExpError Exp x
err FromExpErrorReason
_) -> FromExpError x -> Either (FromExpError x) (Value' [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Value' [] op))
-> FromExpError x -> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
err (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$
            NonEmpty MichelinePrimitiveTag -> FromExpErrorReason
FEERExpectedPrim (MichelinePrimitiveTag
MPTValue MichelinePrimitiveTag
-> [MichelinePrimitiveTag] -> NonEmpty MichelinePrimitiveTag
forall a. a -> [a] -> NonEmpty a
:| [MichelinePrimitiveTag
MPTInstr])
          Right Value' [] op
h' -> do
            [Value' [] op]
t' <- (Exp x -> Either (FromExpError x) (Value' [] op))
-> [Exp x] -> Either (FromExpError x) [Value' [] op]
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 Exp x -> Either (FromExpError x) (Value' [] op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp [Exp x]
t
            Value' [] op -> Either (FromExpError x) (Value' [] op)
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' [] op -> Either (FromExpError x) (Value' [] op))
-> (NonEmpty (Value' [] op) -> Value' [] op)
-> NonEmpty (Value' [] op)
-> Either (FromExpError x) (Value' [] op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Value' [] op) -> Value' [] op
forall {k} (f :: k -> *) (op :: k).
(NonEmpty $ Value' f op) -> Value' f op
Untyped.ValueSeq (NonEmpty (Value' [] op) -> Either (FromExpError x) (Value' [] op))
-> NonEmpty (Value' [] op)
-> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ Value' [] op
h' Value' [] op -> [Value' [] op] -> NonEmpty (Value' [] op)
forall a. a -> [a] -> NonEmpty a
:| [Value' [] op]
t'
    ExpX XExp x
_ -> FromExpError x -> Either (FromExpError x) (Value' [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Value' [] op))
-> FromExpError x -> Either (FromExpError x) (Value' [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ NonEmpty MichelinePrimitiveTag -> FromExpErrorReason
FEERExpectedPrim (OneItem (NonEmpty MichelinePrimitiveTag)
-> NonEmpty MichelinePrimitiveTag
forall x. One x => OneItem x -> x
one OneItem (NonEmpty MichelinePrimitiveTag)
MichelinePrimitiveTag
MPTValue)
    where
      exprToElt :: Exp x -> Either (FromExpError x) (Untyped.Elt [] op)
      exprToElt :: Exp x -> Either (FromExpError x) (Elt [] op)
exprToElt Exp x
ex = case Exp x
ex of
        ExpPrim' XExpPrim x
_ MichelinePrimitive
Prim_Elt [Exp x
l, Exp x
r] [] -> do
          Value' [] op
l' <- Exp x -> Either (FromExpError x) (Value' [] op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
l
          Value' [] op
r' <- Exp x -> Either (FromExpError x) (Value' [] op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
r
          pure $ Value' [] op -> Value' [] op -> Elt [] op
forall {k} (f :: k -> *) (op :: k).
Value' f op -> Value' f op -> Elt f op
Untyped.Elt Value' [] op
l' Value' [] op
r'
        ExpPrim' XExpPrim x
_ MichelinePrimitive
Prim_Elt [Exp x]
args' [] -> FromExpError x -> Either (FromExpError x) (Elt [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Elt [] op))
-> FromExpError x -> Either (FromExpError x) (Elt [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
ex (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$
          NonEmpty Word -> Int -> FromExpErrorReason
FEERArgumentCountMismatch (OneItem (NonEmpty Word) -> NonEmpty Word
forall x. One x => OneItem x -> x
one Word
OneItem (NonEmpty Word)
2) ([Exp x] -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length [Exp x]
args')
        ExpPrim' XExpPrim x
_ MichelinePrimitive
Prim_Elt [Exp x]
_ [Annotation]
_ -> FromExpError x -> Either (FromExpError x) (Elt [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Elt [] op))
-> FromExpError x -> Either (FromExpError x) (Elt [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
ex FromExpErrorReason
FEERUnexpectedAnnotations
        ExpPrim' XExpPrim x
_ MichelinePrimitive
prim [Exp x]
_ [Annotation]
_ -> FromExpError x -> Either (FromExpError x) (Elt [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Elt [] op))
-> FromExpError x -> Either (FromExpError x) (Elt [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
ex (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ Maybe MichelinePrimitive
-> MichelinePrimitive -> FromExpErrorReason
FEERUnexpectedPrim (MichelinePrimitive -> Maybe MichelinePrimitive
forall a. a -> Maybe a
Just MichelinePrimitive
Prim_Elt) MichelinePrimitive
prim
        Exp x
_ -> FromExpError x -> Either (FromExpError x) (Elt [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Elt [] op))
-> FromExpError x -> Either (FromExpError x) (Elt [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
ex (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ NonEmpty MichelinePrimitiveTag -> FromExpErrorReason
FEERExpectedPrim (NonEmpty MichelinePrimitiveTag -> FromExpErrorReason)
-> NonEmpty MichelinePrimitiveTag -> FromExpErrorReason
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty MichelinePrimitiveTag)
-> NonEmpty MichelinePrimitiveTag
forall x. One x => OneItem x -> x
one OneItem (NonEmpty MichelinePrimitiveTag)
MichelinePrimitiveTag
MPTValue

instance FromExp x a => FromExp x [a] where
  fromExp :: Exp x -> Either (FromExpError x) [a]
fromExp = \case
    ExpSeq XExpSeq x
_ [Exp x]
exprs -> (Exp x -> Either (FromExpError x) a)
-> [Exp x] -> Either (FromExpError x) [a]
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 Exp x -> Either (FromExpError x) a
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp [Exp x]
exprs
    Exp x
e -> FromExpError x -> Either (FromExpError x) [a]
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) [a])
-> FromExpError x -> Either (FromExpError x) [a]
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e FromExpErrorReason
FEERExpectedSeq

instance FromExp RegularExp ExpandedOp where
  fromExp :: Expression -> Either FromExpressionError ExpandedOp
fromExp = \case
    ExpSeq XExpSeq RegularExp
_ [Expression]
s -> [ExpandedOp] -> ExpandedOp
SeqEx ([ExpandedOp] -> ExpandedOp)
-> Either FromExpressionError [ExpandedOp]
-> Either FromExpressionError ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expression -> Either FromExpressionError ExpandedOp)
-> [Expression] -> Either FromExpressionError [ExpandedOp]
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 Expression -> Either FromExpressionError ExpandedOp
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp [Expression]
s
    Expression
e          -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp)
-> Either FromExpressionError ExpandedInstr
-> Either FromExpressionError ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> Either FromExpressionError ExpandedInstr
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Expression
e

instance FromExp x Word where
  fromExp :: Exp x -> Either (FromExpError x) Word
fromExp = Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr

instance FromExp x Natural where
  fromExp :: Exp x -> Either (FromExpError x) Natural
fromExp = Exp x -> Either (FromExpError x) Natural
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr

-- | Used to improve type inference with 'WithArgsRec'.
type family EndResult a where
  EndResult (_ -> b) = EndResult b
  EndResult b = b

-- | Recursive typeclass that unpacks a list of constructor arguments and
-- applies a function to them.
class (EndResult a ~ r, CountArgs a r) => WithArgsRec x a r where
  -- | Given the 'Exp' itself (used for error reporting), its arguments, and a
  -- function constructing the result form the arguments, produce the result or
  -- an error if the argument count is mismatched.
  withArgsRec' :: FromExpError x -> [Exp x] -> a -> Either (FromExpError x) r

instance (FromExp x a, WithArgsRec x b r) => WithArgsRec x (a -> b) r where
  withArgsRec' :: FromExpError x -> [Exp x] -> (a -> b) -> Either (FromExpError x) r
withArgsRec' FromExpError x
ee (Exp x
e:[Exp x]
es) a -> b
f = forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x Exp x
e Either (FromExpError x) a
-> (a -> Either (FromExpError x) r) -> Either (FromExpError x) r
forall a b.
Either (FromExpError x) a
-> (a -> Either (FromExpError x) b) -> Either (FromExpError x) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FromExpError x -> [Exp x] -> b -> Either (FromExpError x) r
forall (x :: ExpExtensionDescriptorKind) a r.
WithArgsRec x a r =>
FromExpError x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec' FromExpError x
ee [Exp x]
es (b -> Either (FromExpError x) r)
-> (a -> b) -> a -> Either (FromExpError x) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  withArgsRec' FromExpError x
ee [] a -> b
_ = FromExpError x -> Either (FromExpError x) r
forall a b. a -> Either a b
Left FromExpError x
ee

instance (EndResult r ~ r) => WithArgsRec x r r where
  withArgsRec' :: FromExpError x -> [Exp x] -> r -> Either (FromExpError x) r
withArgsRec' FromExpError x
_ [] r
x = r -> Either (FromExpError x) r
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
x
  withArgsRec' FromExpError x
ee [Exp x]
_ r
_ = FromExpError x -> Either (FromExpError x) r
forall a b. a -> Either a b
Left FromExpError x
ee

class CountArgs a r where countArgs :: Word
instance CountArgs r r where countArgs :: Word
countArgs = Word
0
instance CountArgs b r => CountArgs (a -> b) r where countArgs :: Word
countArgs = Word -> Word
forall a. Enum a => a -> a
succ (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$ forall a (r :: k). CountArgs a r => Word
forall {k} {k} (a :: k) (r :: k). CountArgs a r => Word
countArgs @b @r

withArgsRec
  :: forall x a r. WithArgsRec x a r
  => Exp x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec :: forall (x :: ExpExtensionDescriptorKind) a r.
WithArgsRec x a r =>
Exp x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec Exp x
e [Exp x]
args = FromExpError x -> [Exp x] -> a -> Either (FromExpError x) r
forall (x :: ExpExtensionDescriptorKind) a r.
WithArgsRec x a r =>
FromExpError x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec'
  (Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ NonEmpty Word -> Int -> FromExpErrorReason
FEERArgumentCountMismatch (OneItem (NonEmpty Word) -> NonEmpty Word
forall x. One x => OneItem x -> x
one (OneItem (NonEmpty Word) -> NonEmpty Word)
-> OneItem (NonEmpty Word) -> NonEmpty Word
forall a b. (a -> b) -> a -> b
$ forall a r. CountArgs a r => Word
forall {k} {k} (a :: k) (r :: k). CountArgs a r => Word
countArgs @a @r) ([Exp x] -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length [Exp x]
args))
  [Exp x]
args

-- Note: On adding new expressions here, you must also add the symmetric (writing) case
-- to ToExpression as well.
instance FromExp x op =>
         FromExp x (InstrAbstract [] op) where
  fromExp :: Exp x -> Either (FromExpError x) (InstrAbstract [] op)
fromExp e :: Exp x
e@(ExpPrim' XExpPrim x
_ MichelinePrimitive
prim [Exp x]
args [Annotation]
anns) = MichelinePrimitive
-> (forall (tag :: MichelinePrimitiveTag).
    Sing tag
    -> ClassifiedMichelinePrimitive tag
    -> Either (FromExpError x) (InstrAbstract [] op))
-> Either (FromExpError x) (InstrAbstract [] op)
forall r.
MichelinePrimitive
-> (forall (tag :: MichelinePrimitiveTag).
    Sing tag -> ClassifiedMichelinePrimitive tag -> r)
-> r
withClassifiedPrim MichelinePrimitive
prim \case
    Sing tag
SingMichelinePrimitiveTag tag
SMPTInstr -> \case
      ClassifiedMichelinePrimitive tag
C_Prim_DROP -> Either (FromExpError x) ()
nilAnns Either (FromExpError x) ()
-> Either (FromExpError x) (InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b.
Either (FromExpError x) a
-> Either (FromExpError x) b -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> case [Exp x]
args of
        [] -> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstrAbstract [] op
forall (f :: * -> *) op. InstrAbstract f op
DROP
        [Exp x
n] -> Word -> InstrAbstract [] op
forall (f :: * -> *) op. Word -> InstrAbstract f op
DROPN (Word -> InstrAbstract [] op)
-> Either (FromExpError x) Word
-> Either (FromExpError x) (InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
        [Exp x]
_ -> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall b. NonEmpty Word -> Either (FromExpError x) b
invalidNumArgs (NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op))
-> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word
1]
      ClassifiedMichelinePrimitive tag
C_Prim_DUP -> (Int, Int, Int) -> Either (FromExpError x) ()
annsCnt (Int
0, Int
0, Int
1) Either (FromExpError x) ()
-> Either (FromExpError x) (InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b.
Either (FromExpError x) a
-> Either (FromExpError x) b -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> case [Exp x]
args of
        [Exp x
n] -> VarAnn -> Word -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> Word -> InstrAbstract f op
DUPN VarAnn
va (Word -> InstrAbstract [] op)
-> Either (FromExpError x) Word
-> Either (FromExpError x) (InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
        [] -> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstrAbstract [] op
 -> Either (FromExpError x) (InstrAbstract [] op))
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
DUP VarAnn
va
        [Exp x]
_ -> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall b. NonEmpty Word -> Either (FromExpError x) b
invalidNumArgs (NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op))
-> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word
1]
      ClassifiedMichelinePrimitive tag
C_Prim_SWAP -> (Int, Int, Int)
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil InstrAbstract [] op
forall (f :: * -> *) op. InstrAbstract f op
SWAP
      ClassifiedMichelinePrimitive tag
C_Prim_DIG -> (Int, Int, Int)
-> (Word -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil Word -> InstrAbstract [] op
forall (f :: * -> *) op. Word -> InstrAbstract f op
DIG
      ClassifiedMichelinePrimitive tag
C_Prim_DUG -> (Int, Int, Int)
-> (Word -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil Word -> InstrAbstract [] op
forall (f :: * -> *) op. Word -> InstrAbstract f op
DUG
      ClassifiedMichelinePrimitive tag
C_Prim_PUSH -> (Int, Int, Int)
-> (Ty -> Value' [] op -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
0, Int
1) ((Ty -> Value' [] op -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> Value' [] op -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> Ty -> Value' [] op -> InstrAbstract [] op
forall (f :: * -> *) op.
VarAnn -> Ty -> Value' f op -> InstrAbstract f op
PUSH VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_SOME -> (Int, Int, Int)
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
1, Int
0, Int
1) (InstrAbstract [] op
 -> Either (FromExpError x) (InstrAbstract [] op))
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. TypeAnn -> VarAnn -> InstrAbstract f op
SOME TypeAnn
ta VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_NONE -> (Int, Int, Int)
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
1, Int
0, Int
1) ((Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> Ty -> InstrAbstract f op
NONE TypeAnn
ta VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_UNIT -> (Int, Int, Int)
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
1, Int
0, Int
1) (InstrAbstract [] op
 -> Either (FromExpError x) (InstrAbstract [] op))
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. TypeAnn -> VarAnn -> InstrAbstract f op
UNIT TypeAnn
ta VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_IF_NONE -> (Int, Int, Int)
-> ([op] -> [op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil [op] -> [op] -> InstrAbstract [] op
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF_NONE
      ClassifiedMichelinePrimitive tag
C_Prim_PAIR -> case [Exp x]
args of
        [] -> (Int, Int, Int) -> Either (FromExpError x) ()
annsCnt (Int
1, Int
2, Int
1) Either (FromExpError x) ()
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract [] op
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
PAIR TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2
        [Exp x
n] -> (Int, Int, Int) -> Either (FromExpError x) ()
annsCnt (Int
0, Int
0, Int
1) Either (FromExpError x) ()
-> (Word -> InstrAbstract [] op)
-> Either (FromExpError x) (Word -> InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> Word -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> Word -> InstrAbstract f op
PAIRN VarAnn
va Either (FromExpError x) (Word -> InstrAbstract [] op)
-> Either (FromExpError x) Word
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b.
Either (FromExpError x) (a -> b)
-> Either (FromExpError x) a -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
        [Exp x]
_ -> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall b. NonEmpty Word -> Either (FromExpError x) b
invalidNumArgs (NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op))
-> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word
1]
      ClassifiedMichelinePrimitive tag
C_Prim_UNPAIR -> case [Exp x]
args of
        [] -> (Int, Int, Int) -> Either (FromExpError x) ()
annsCnt (Int
0, Int
2, Int
2) Either (FromExpError x) ()
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract [] op
forall (f :: * -> *) op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
UNPAIR VarAnn
va1 VarAnn
va2 FieldAnn
fa1 FieldAnn
fa2
        [Exp x
n] -> Either (FromExpError x) ()
nilAnns Either (FromExpError x) ()
-> (Word -> InstrAbstract [] op)
-> Either (FromExpError x) (Word -> InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Word -> InstrAbstract [] op
forall (f :: * -> *) op. Word -> InstrAbstract f op
UNPAIRN Either (FromExpError x) (Word -> InstrAbstract [] op)
-> Either (FromExpError x) Word
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b.
Either (FromExpError x) (a -> b)
-> Either (FromExpError x) a -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
        [Exp x]
_ -> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall b. NonEmpty Word -> Either (FromExpError x) b
invalidNumArgs (NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op))
-> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word
1]
      ClassifiedMichelinePrimitive tag
C_Prim_CAR -> (Int, Int, Int)
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
1, Int
1) (InstrAbstract [] op
 -> Either (FromExpError x) (InstrAbstract [] op))
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f op
CAR VarAnn
va FieldAnn
fa
      ClassifiedMichelinePrimitive tag
C_Prim_CDR -> (Int, Int, Int)
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
1, Int
1) (InstrAbstract [] op
 -> Either (FromExpError x) (InstrAbstract [] op))
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f op
CDR VarAnn
va FieldAnn
fa
      ClassifiedMichelinePrimitive tag
C_Prim_LEFT -> (Int, Int, Int)
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
1, Int
2, Int
1) ((Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract f op
LEFT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2
      ClassifiedMichelinePrimitive tag
C_Prim_RIGHT -> (Int, Int, Int)
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
1, Int
2, Int
1) ((Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract f op
RIGHT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2
      ClassifiedMichelinePrimitive tag
C_Prim_IF_LEFT -> (Int, Int, Int)
-> ([op] -> [op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil [op] -> [op] -> InstrAbstract [] op
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF_LEFT
      ClassifiedMichelinePrimitive tag
C_Prim_NIL -> (Int, Int, Int)
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
1, Int
0, Int
1) ((Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> Ty -> InstrAbstract f op
NIL TypeAnn
ta VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_CONS -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
CONS
      ClassifiedMichelinePrimitive tag
C_Prim_IF_CONS -> (Int, Int, Int)
-> ([op] -> [op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil [op] -> [op] -> InstrAbstract [] op
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF_CONS
      ClassifiedMichelinePrimitive tag
C_Prim_SIZE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SIZE
      ClassifiedMichelinePrimitive tag
C_Prim_EMPTY_SET -> (Int, Int, Int)
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
1, Int
0, Int
1) ((Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> Ty -> InstrAbstract f op
EMPTY_SET TypeAnn
ta VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_EMPTY_MAP -> (Int, Int, Int)
-> (Ty -> Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
1, Int
0, Int
1) ((Ty -> Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract f op
EMPTY_MAP TypeAnn
ta VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_EMPTY_BIG_MAP -> (Int, Int, Int)
-> (Ty -> Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
1, Int
0, Int
1) ((Ty -> Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract f op
EMPTY_BIG_MAP TypeAnn
ta VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_MAP -> (Int, Int, Int)
-> ([op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
0, Int
1) (([op] -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> ([op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> [op] -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> f op -> InstrAbstract f op
MAP VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_ITER -> (Int, Int, Int)
-> ([op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil [op] -> InstrAbstract [] op
forall (f :: * -> *) op. f op -> InstrAbstract f op
ITER
      ClassifiedMichelinePrimitive tag
C_Prim_MEM -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
MEM
      ClassifiedMichelinePrimitive tag
C_Prim_GET -> case [Exp x]
args of
        [] -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
GET
        [Exp x
n] -> (Int, Int, Int) -> Either (FromExpError x) ()
annsCnt (Int
0, Int
0, Int
1) Either (FromExpError x) ()
-> (Word -> InstrAbstract [] op)
-> Either (FromExpError x) (Word -> InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> Word -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> Word -> InstrAbstract f op
GETN VarAnn
va Either (FromExpError x) (Word -> InstrAbstract [] op)
-> Either (FromExpError x) Word
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b.
Either (FromExpError x) (a -> b)
-> Either (FromExpError x) a -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
        [Exp x]
_ -> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall b. NonEmpty Word -> Either (FromExpError x) b
invalidNumArgs (NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op))
-> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word
1]
      ClassifiedMichelinePrimitive tag
C_Prim_UPDATE -> case [Exp x]
args of
        [] -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
UPDATE
        [Exp x
n] -> (Int, Int, Int) -> Either (FromExpError x) ()
annsCnt (Int
0, Int
0, Int
1) Either (FromExpError x) ()
-> (Word -> InstrAbstract [] op)
-> Either (FromExpError x) (Word -> InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> Word -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> Word -> InstrAbstract f op
UPDATEN VarAnn
va Either (FromExpError x) (Word -> InstrAbstract [] op)
-> Either (FromExpError x) Word
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b.
Either (FromExpError x) (a -> b)
-> Either (FromExpError x) a -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
        [Exp x]
_ -> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall b. NonEmpty Word -> Either (FromExpError x) b
invalidNumArgs (NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op))
-> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word
1]
      ClassifiedMichelinePrimitive tag
C_Prim_GET_AND_UPDATE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
GET_AND_UPDATE
      ClassifiedMichelinePrimitive tag
C_Prim_IF -> (Int, Int, Int)
-> ([op] -> [op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil [op] -> [op] -> InstrAbstract [] op
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF
      ClassifiedMichelinePrimitive tag
C_Prim_LOOP -> (Int, Int, Int)
-> ([op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil [op] -> InstrAbstract [] op
forall (f :: * -> *) op. f op -> InstrAbstract f op
LOOP
      ClassifiedMichelinePrimitive tag
C_Prim_LOOP_LEFT -> (Int, Int, Int)
-> ([op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil [op] -> InstrAbstract [] op
forall (f :: * -> *) op. f op -> InstrAbstract f op
LOOP_LEFT
      ClassifiedMichelinePrimitive tag
C_Prim_LAMBDA -> (Int, Int, Int)
-> (Ty -> Ty -> [op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
0, Int
1) ((Ty -> Ty -> [op] -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> Ty -> [op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> Ty -> Ty -> [op] -> InstrAbstract [] op
forall (f :: * -> *) op.
VarAnn -> Ty -> Ty -> f op -> InstrAbstract f op
LAMBDA VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_LAMBDA_REC -> (Int, Int, Int)
-> (Ty -> Ty -> [op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
0, Int
1) ((Ty -> Ty -> [op] -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> Ty -> [op] -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> Ty -> Ty -> [op] -> InstrAbstract [] op
forall (f :: * -> *) op.
VarAnn -> Ty -> Ty -> f op -> InstrAbstract f op
LAMBDA_REC VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_EXEC -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
EXEC
      ClassifiedMichelinePrimitive tag
C_Prim_APPLY -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
APPLY
      ClassifiedMichelinePrimitive tag
C_Prim_DIP -> Either (FromExpError x) ()
nilAnns Either (FromExpError x) ()
-> Either (FromExpError x) (InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b.
Either (FromExpError x) a
-> Either (FromExpError x) b -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> case [Exp x]
args of
        [Exp x
ops] -> [op] -> InstrAbstract [] op
forall (f :: * -> *) op. f op -> InstrAbstract f op
DIP ([op] -> InstrAbstract [] op)
-> Either (FromExpError x) [op]
-> Either (FromExpError x) (InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp x -> Either (FromExpError x) [op]
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
ops
        [Exp x
n, Exp x
ops] -> Word -> [op] -> InstrAbstract [] op
forall (f :: * -> *) op. Word -> f op -> InstrAbstract f op
DIPN (Word -> [op] -> InstrAbstract [] op)
-> Either (FromExpError x) Word
-> Either (FromExpError x) ([op] -> InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp x -> Either (FromExpError x) Word
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
n Either (FromExpError x) ([op] -> InstrAbstract [] op)
-> Either (FromExpError x) [op]
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b.
Either (FromExpError x) (a -> b)
-> Either (FromExpError x) a -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp x -> Either (FromExpError x) [op]
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
ops
        [Exp x]
_ -> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall b. NonEmpty Word -> Either (FromExpError x) b
invalidNumArgs (NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op))
-> NonEmpty Word -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ Word
1 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word
2]
      ClassifiedMichelinePrimitive tag
C_Prim_FAILWITH -> (Int, Int, Int)
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil InstrAbstract [] op
forall (f :: * -> *) op. InstrAbstract f op
FAILWITH
      ClassifiedMichelinePrimitive tag
C_Prim_CAST -> (Int, Int, Int)
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
0, Int
1) ((Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> Ty -> InstrAbstract f op
CAST VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_RENAME -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
RENAME
      ClassifiedMichelinePrimitive tag
C_Prim_PACK -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
PACK
      ClassifiedMichelinePrimitive tag
C_Prim_UNPACK -> (Int, Int, Int)
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
1, Int
0, Int
1) ((Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> Ty -> InstrAbstract f op
UNPACK TypeAnn
ta VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_CONCAT -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
CONCAT
      ClassifiedMichelinePrimitive tag
C_Prim_SLICE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SLICE
      ClassifiedMichelinePrimitive tag
C_Prim_ISNAT -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
ISNAT
      ClassifiedMichelinePrimitive tag
C_Prim_ADD -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
ADD
      ClassifiedMichelinePrimitive tag
C_Prim_SUB -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SUB
      ClassifiedMichelinePrimitive tag
C_Prim_SUB_MUTEZ -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SUB_MUTEZ
      ClassifiedMichelinePrimitive tag
C_Prim_MUL -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
MUL
      ClassifiedMichelinePrimitive tag
C_Prim_EDIV -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
EDIV
      ClassifiedMichelinePrimitive tag
C_Prim_ABS -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
ABS
      ClassifiedMichelinePrimitive tag
C_Prim_NEG -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
NEG
      ClassifiedMichelinePrimitive tag
C_Prim_LSL -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
LSL
      ClassifiedMichelinePrimitive tag
C_Prim_LSR -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
LSR
      ClassifiedMichelinePrimitive tag
C_Prim_OR -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
OR
      ClassifiedMichelinePrimitive tag
C_Prim_AND -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
AND
      ClassifiedMichelinePrimitive tag
C_Prim_XOR -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
XOR
      ClassifiedMichelinePrimitive tag
C_Prim_NOT -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
NOT
      ClassifiedMichelinePrimitive tag
C_Prim_COMPARE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
COMPARE
      ClassifiedMichelinePrimitive tag
C_Prim_EQ -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
Untyped.EQ
      ClassifiedMichelinePrimitive tag
C_Prim_NEQ -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
NEQ
      ClassifiedMichelinePrimitive tag
C_Prim_LT -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
Untyped.LT
      ClassifiedMichelinePrimitive tag
C_Prim_GT -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
Untyped.GT
      ClassifiedMichelinePrimitive tag
C_Prim_LE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
LE
      ClassifiedMichelinePrimitive tag
C_Prim_GE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
GE
      ClassifiedMichelinePrimitive tag
C_Prim_INT -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
INT
      ClassifiedMichelinePrimitive tag
C_Prim_NAT -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
NAT
      ClassifiedMichelinePrimitive tag
C_Prim_BYTES -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
BYTES
      ClassifiedMichelinePrimitive tag
C_Prim_VIEW -> (Int, Int, Int)
-> (ViewName -> Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
0, Int
1) ((ViewName -> Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (ViewName -> Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> ViewName -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
VarAnn -> ViewName -> Ty -> InstrAbstract f op
VIEW VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_SELF -> (Int, Int, Int)
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
1, Int
1) (InstrAbstract [] op
 -> Either (FromExpError x) (InstrAbstract [] op))
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f op
SELF VarAnn
va FieldAnn
fa
      ClassifiedMichelinePrimitive tag
C_Prim_CONTRACT -> (Int, Int, Int)
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
1, Int
1) ((Ty -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
VarAnn -> FieldAnn -> Ty -> InstrAbstract f op
CONTRACT VarAnn
va FieldAnn
fa
      ClassifiedMichelinePrimitive tag
C_Prim_TRANSFER_TOKENS -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
TRANSFER_TOKENS
      ClassifiedMichelinePrimitive tag
C_Prim_SET_DELEGATE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SET_DELEGATE
      ClassifiedMichelinePrimitive tag
C_Prim_CREATE_CONTRACT -> (Int, Int, Int)
-> (Contract' op -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
0, Int
2) ((Contract' op -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Contract' op -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> VarAnn -> Contract' op -> InstrAbstract [] op
forall (f :: * -> *) op.
VarAnn -> VarAnn -> Contract' op -> InstrAbstract f op
CREATE_CONTRACT VarAnn
va1 VarAnn
va2
      ClassifiedMichelinePrimitive tag
C_Prim_IMPLICIT_ACCOUNT -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
IMPLICIT_ACCOUNT
      ClassifiedMichelinePrimitive tag
C_Prim_NOW -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
NOW
      ClassifiedMichelinePrimitive tag
C_Prim_AMOUNT -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
AMOUNT
      ClassifiedMichelinePrimitive tag
C_Prim_BALANCE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
BALANCE
      ClassifiedMichelinePrimitive tag
C_Prim_VOTING_POWER -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
VOTING_POWER
      ClassifiedMichelinePrimitive tag
C_Prim_TOTAL_VOTING_POWER -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
TOTAL_VOTING_POWER
      ClassifiedMichelinePrimitive tag
C_Prim_CHECK_SIGNATURE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
CHECK_SIGNATURE
      ClassifiedMichelinePrimitive tag
C_Prim_SHA256 -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SHA256
      ClassifiedMichelinePrimitive tag
C_Prim_SHA512 -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SHA512
      ClassifiedMichelinePrimitive tag
C_Prim_BLAKE2B -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
BLAKE2B
      ClassifiedMichelinePrimitive tag
C_Prim_SHA3 -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SHA3
      ClassifiedMichelinePrimitive tag
C_Prim_KECCAK -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
KECCAK
      ClassifiedMichelinePrimitive tag
C_Prim_HASH_KEY -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
HASH_KEY
      ClassifiedMichelinePrimitive tag
C_Prim_PAIRING_CHECK -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
PAIRING_CHECK
      ClassifiedMichelinePrimitive tag
C_Prim_SOURCE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SOURCE
      ClassifiedMichelinePrimitive tag
C_Prim_SENDER -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SENDER
      ClassifiedMichelinePrimitive tag
C_Prim_ADDRESS -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
ADDRESS
      ClassifiedMichelinePrimitive tag
C_Prim_CHAIN_ID -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
CHAIN_ID
      ClassifiedMichelinePrimitive tag
C_Prim_LEVEL -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
LEVEL
      ClassifiedMichelinePrimitive tag
C_Prim_SELF_ADDRESS -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SELF_ADDRESS
      ClassifiedMichelinePrimitive tag
C_Prim_NEVER -> (Int, Int, Int)
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
nil InstrAbstract [] op
forall (f :: * -> *) op. InstrAbstract f op
NEVER
      ClassifiedMichelinePrimitive tag
C_Prim_TICKET_DEPRECATED -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
TICKET_DEPRECATED
      ClassifiedMichelinePrimitive tag
C_Prim_TICKET -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
TICKET
      ClassifiedMichelinePrimitive tag
C_Prim_READ_TICKET -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
READ_TICKET
      ClassifiedMichelinePrimitive tag
C_Prim_SPLIT_TICKET -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SPLIT_TICKET
      ClassifiedMichelinePrimitive tag
C_Prim_JOIN_TICKETS -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
JOIN_TICKETS
      ClassifiedMichelinePrimitive tag
C_Prim_OPEN_CHEST -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
OPEN_CHEST
      ClassifiedMichelinePrimitive tag
C_Prim_SAPLING_EMPTY_STATE -> (Int, Int, Int)
-> (Natural -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
0, Int
1) ((Natural -> InstrAbstract [] op)
 -> Either (FromExpError x) (InstrAbstract [] op))
-> (Natural -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> Natural -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> Natural -> InstrAbstract f op
SAPLING_EMPTY_STATE VarAnn
va
      ClassifiedMichelinePrimitive tag
C_Prim_SAPLING_VERIFY_UPDATE -> (VarAnn -> InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> InstrAbstract [] op
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
SAPLING_VERIFY_UPDATE
      ClassifiedMichelinePrimitive tag
C_Prim_MIN_BLOCK_TIME -> Exp x
-> [Exp x]
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall (x :: ExpExtensionDescriptorKind) a r.
WithArgsRec x a r =>
Exp x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec Exp x
e [Exp x]
args (InstrAbstract [] op
 -> Either (FromExpError x) (InstrAbstract [] op))
-> InstrAbstract [] op
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ ([AnyAnn] -> InstrAbstract [] op) -> InstrAbstract [] op
forall t. ([AnyAnn] -> t) -> t
mkInstrWithAnyAnns [AnyAnn] -> InstrAbstract [] op
forall (f :: * -> *) op. [AnyAnn] -> InstrAbstract f op
MIN_BLOCK_TIME
      ClassifiedMichelinePrimitive tag
C_Prim_EMIT -> (Int, Int, Int) -> Either (FromExpError x) ()
annsCnt (Int
0, Int
1, Int
1) Either (FromExpError x) ()
-> (Maybe Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (Maybe Ty -> InstrAbstract [] op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> FieldAnn -> Maybe Ty -> InstrAbstract [] op
forall (f :: * -> *) op.
VarAnn -> FieldAnn -> Maybe Ty -> InstrAbstract f op
EMIT VarAnn
va FieldAnn
fa Either (FromExpError x) (Maybe Ty -> InstrAbstract [] op)
-> Either (FromExpError x) (Maybe Ty)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b.
Either (FromExpError x) (a -> b)
-> Either (FromExpError x) a -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> case [Exp x]
args of
        [] -> Maybe Ty -> Either (FromExpError x) (Maybe Ty)
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Ty
forall a. Maybe a
Nothing
        [Exp x
ty] -> Ty -> Maybe Ty
forall a. a -> Maybe a
Just (Ty -> Maybe Ty)
-> Either (FromExpError x) Ty -> Either (FromExpError x) (Maybe Ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
ty
        [Exp x]
_ -> NonEmpty Word -> Either (FromExpError x) (Maybe Ty)
forall b. NonEmpty Word -> Either (FromExpError x) b
invalidNumArgs (Word
0 Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Word
1])
    Sing tag
s -> Either (FromExpError x) (InstrAbstract [] op)
-> ClassifiedMichelinePrimitive tag
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. a -> b -> a
const (Either (FromExpError x) (InstrAbstract [] op)
 -> ClassifiedMichelinePrimitive tag
 -> Either (FromExpError x) (InstrAbstract [] op))
-> Either (FromExpError x) (InstrAbstract [] op)
-> ClassifiedMichelinePrimitive tag
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ FromExpError x -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (InstrAbstract [] op))
-> FromExpError x -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ MichelinePrimitiveTag
-> MichelinePrimitiveTag -> FromExpErrorReason
FEERUnexpectedPrimClass MichelinePrimitiveTag
MPTInstr (Sing tag -> Demote MichelinePrimitiveTag
forall k (a :: k). SingKind k => Sing a -> Demote k
forall (a :: MichelinePrimitiveTag).
Sing a -> Demote MichelinePrimitiveTag
fromSing Sing tag
s)

    where
      annSet :: AnnotationSet
annSet = [Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns
      va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      fa1 :: FieldAnn
fa1 = FieldAnn
fa
      fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
      va1 :: VarAnn
va1 = VarAnn
va
      va2 :: VarAnn
va2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @VarTag AnnotationSet
annSet

      withArgsAnns
        :: WithArgsRec x a (InstrAbstract [] op)
        => (Int, Int, Int) -> a -> Either (FromExpError x) (InstrAbstract [] op)
      withArgsAnns :: forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int, Int, Int)
n a
f = (Int, Int, Int) -> Either (FromExpError x) ()
annsCnt (Int, Int, Int)
n Either (FromExpError x) ()
-> Either (FromExpError x) (InstrAbstract [] op)
-> Either (FromExpError x) (InstrAbstract [] op)
forall a b.
Either (FromExpError x) a
-> Either (FromExpError x) b -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Exp x
-> [Exp x] -> a -> Either (FromExpError x) (InstrAbstract [] op)
forall (x :: ExpExtensionDescriptorKind) a r.
WithArgsRec x a r =>
Exp x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec Exp x
e [Exp x]
args a
f

      invalidNumArgs :: NonEmpty Word -> Either (FromExpError x) b
      invalidNumArgs :: forall b. NonEmpty Word -> Either (FromExpError x) b
invalidNumArgs NonEmpty Word
expected = FromExpError x -> Either (FromExpError x) b
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) b)
-> FromExpError x -> Either (FromExpError x) b
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$
        NonEmpty Word -> Int -> FromExpErrorReason
FEERArgumentCountMismatch NonEmpty Word
expected ([Exp x] -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length [Exp x]
args)

      annsCnt :: (Int, Int, Int) -> Either (FromExpError x) ()
annsCnt = Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet

      nil :: (Int, Int, Int)
nil = (Int
0, Int
0, Int
0)

      nilAnns :: Either (FromExpError x) ()
nilAnns = (Int, Int, Int) -> Either (FromExpError x) ()
annsCnt (Int, Int, Int)
nil

      mkInstrWithVarAnn
        :: WithArgsRec x a (InstrAbstract [] op)
        => (Untyped.Annotation VarTag -> a)
        -> Either (FromExpError x) (InstrAbstract [] op)
      mkInstrWithVarAnn :: forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(VarAnn -> a) -> Either (FromExpError x) (InstrAbstract [] op)
mkInstrWithVarAnn VarAnn -> a
ctor = (Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
forall a.
WithArgsRec x a (InstrAbstract [] op) =>
(Int, Int, Int)
-> a -> Either (FromExpError x) (InstrAbstract [] op)
withArgsAnns (Int
0, Int
0, Int
1) (a -> Either (FromExpError x) (InstrAbstract [] op))
-> a -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ VarAnn -> a
ctor VarAnn
va

      mkInstrWithAnyAnns :: ([Untyped.AnyAnn] -> t) -> t
      mkInstrWithAnyAnns :: forall t. ([AnyAnn] -> t) -> t
mkInstrWithAnyAnns [AnyAnn] -> t
ctor = [AnyAnn] -> t
ctor ([AnyAnn] -> t) -> [AnyAnn] -> t
forall a b. (a -> b) -> a -> b
$ [Annotation]
anns [Annotation] -> (Annotation -> AnyAnn) -> [AnyAnn]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        AnnotationType TypeAnn
x -> TypeAnn -> AnyAnn
Untyped.AnyAnnType TypeAnn
x
        AnnotationField FieldAnn
x -> FieldAnn -> AnyAnn
Untyped.AnyAnnField FieldAnn
x
        AnnotationVariable VarAnn
x -> VarAnn -> AnyAnn
Untyped.AnyAnnVar VarAnn
x

  fromExp Exp x
e = FromExpError x -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (InstrAbstract [] op))
-> FromExpError x -> Either (FromExpError x) (InstrAbstract [] op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ NonEmpty MichelinePrimitiveTag -> FromExpErrorReason
FEERExpectedPrim (OneItem (NonEmpty MichelinePrimitiveTag)
-> NonEmpty MichelinePrimitiveTag
forall x. One x => OneItem x -> x
one OneItem (NonEmpty MichelinePrimitiveTag)
MichelinePrimitiveTag
MPTInstr)

instance (FromExp x op) => FromExp x (Untyped.Contract' op) where
  fromExp :: Exp x -> Either (FromExpError x) (Contract' op)
fromExp Exp x
blocks = case Exp x
blocks of
    ExpSeq XExpSeq x
_ [Exp x]
bs -> do
      [ContractBlock op]
bs' <- (Exp x -> Either (FromExpError x) (ContractBlock op))
-> [Exp x] -> Either (FromExpError x) [ContractBlock op]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Exp x -> Either (FromExpError x) (ContractBlock op)
exprToCB [Exp x]
bs
      (NonEmpty ContractBlockError -> FromExpError x)
-> Either (NonEmpty ContractBlockError) (Contract' op)
-> Either (FromExpError x) (Contract' op)
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 (Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
blocks (FromExpErrorReason -> FromExpError x)
-> (NonEmpty ContractBlockError -> FromExpErrorReason)
-> NonEmpty ContractBlockError
-> FromExpError x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ContractBlockError -> FromExpErrorReason
FEERBadContractBlocks) (Either (NonEmpty ContractBlockError) (Contract' op)
 -> Either (FromExpError x) (Contract' op))
-> Either (NonEmpty ContractBlockError) (Contract' op)
-> Either (FromExpError x) (Contract' op)
forall a b. (a -> b) -> a -> b
$ [ContractBlock op]
-> Either (NonEmpty ContractBlockError) (Contract' op)
forall op.
[ContractBlock op]
-> Either (NonEmpty ContractBlockError) (Contract' op)
orderContractBlock [ContractBlock op]
bs'
    Exp x
expr -> FromExpError x -> Either (FromExpError x) (Contract' op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Contract' op))
-> FromExpError x -> Either (FromExpError x) (Contract' op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
expr FromExpErrorReason
FEERExpectedSeq
    where
      exprToCB
        :: Exp x
        -> Either (FromExpError x) (ContractBlock op)
      exprToCB :: Exp x -> Either (FromExpError x) (ContractBlock op)
exprToCB e :: Exp x
e@(ExpPrim' XExpPrim x
_ MichelinePrimitive
prim [Exp x]
args [Annotation]
anns) = MichelinePrimitive
-> (forall (tag :: MichelinePrimitiveTag).
    Sing tag
    -> ClassifiedMichelinePrimitive tag
    -> Either (FromExpError x) (ContractBlock op))
-> Either (FromExpError x) (ContractBlock op)
forall r.
MichelinePrimitive
-> (forall (tag :: MichelinePrimitiveTag).
    Sing tag -> ClassifiedMichelinePrimitive tag -> r)
-> r
withClassifiedPrim MichelinePrimitive
prim \case
        Sing tag
SingMichelinePrimitiveTag tag
SMPTKeyword -> \case
          ClassifiedMichelinePrimitive tag
C_Prim_parameter -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCbParam Exp x
e [Exp x]
args [Annotation]
anns
          ClassifiedMichelinePrimitive tag
C_Prim_storage   -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBStorage Exp x
e [Exp x]
args [Annotation]
anns
          ClassifiedMichelinePrimitive tag
C_Prim_code      -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBCode Exp x
e [Exp x]
args [Annotation]
anns
          ClassifiedMichelinePrimitive tag
C_Prim_view      -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBView Exp x
e [Exp x]
args [Annotation]
anns
        Sing tag
s -> Either (FromExpError x) (ContractBlock op)
-> ClassifiedMichelinePrimitive tag
-> Either (FromExpError x) (ContractBlock op)
forall a b. a -> b -> a
const (Either (FromExpError x) (ContractBlock op)
 -> ClassifiedMichelinePrimitive tag
 -> Either (FromExpError x) (ContractBlock op))
-> Either (FromExpError x) (ContractBlock op)
-> ClassifiedMichelinePrimitive tag
-> Either (FromExpError x) (ContractBlock op)
forall a b. (a -> b) -> a -> b
$ FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (ContractBlock op))
-> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ MichelinePrimitiveTag
-> MichelinePrimitiveTag -> FromExpErrorReason
FEERUnexpectedPrimClass MichelinePrimitiveTag
MPTKeyword (Sing tag -> Demote MichelinePrimitiveTag
forall k (a :: k). SingKind k => Sing a -> Demote k
forall (a :: MichelinePrimitiveTag).
Sing a -> Demote MichelinePrimitiveTag
fromSing Sing tag
s)
      exprToCB Exp x
e = FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (ContractBlock op))
-> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ NonEmpty MichelinePrimitiveTag -> FromExpErrorReason
FEERExpectedPrim (NonEmpty MichelinePrimitiveTag -> FromExpErrorReason)
-> NonEmpty MichelinePrimitiveTag -> FromExpErrorReason
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty MichelinePrimitiveTag)
-> NonEmpty MichelinePrimitiveTag
forall x. One x => OneItem x -> x
one OneItem (NonEmpty MichelinePrimitiveTag)
MichelinePrimitiveTag
MPTKeyword

      mkCbParam
        :: Exp x
        -> [Exp x]
        -> [Annotation]
        -> Either (FromExpError x) (ContractBlock op)
      mkCbParam :: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCbParam Exp x
e [Exp x]
args [Annotation]
anns = Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e ([Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns) (Int
0, Int
0, Int
0) Either (FromExpError x) ()
-> Either (FromExpError x) (ContractBlock op)
-> Either (FromExpError x) (ContractBlock op)
forall a b.
Either (FromExpError x) a
-> Either (FromExpError x) b -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> case [Exp x]
args of
        [Exp x
p] -> do
          let annSet :: AnnotationSet
annSet = [Annotation] -> AnnotationSet
toAnnSet (Exp x
p Exp x -> Getting [Annotation] (Exp x) [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. ((XExpPrim x, MichelinePrimAp x)
 -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
       (f :: * -> *).
(Choice p, Applicative f) =>
p (XExpPrim x, MichelinePrimAp x)
  (f (XExpPrim x, MichelinePrimAp x))
-> p (Exp x) (f (Exp x))
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
  -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
 -> Exp x -> Const [Annotation] (Exp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> (XExpPrim x, MichelinePrimAp x)
    -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Getting [Annotation] (Exp x) [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (XExpPrim x, MichelinePrimAp x)
  (XExpPrim x, MichelinePrimAp x)
  (MichelinePrimAp x)
  (MichelinePrimAp x)
_2 ((MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
 -> (XExpPrim x, MichelinePrimAp x)
 -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> ([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind) (f :: * -> *).
Functor f =>
([Annotation] -> f [Annotation])
-> MichelinePrimAp x -> f (MichelinePrimAp x)
mpaAnnotsL)
              annCnt :: (Int, Int, Int)
annCnt = AnnotationSet -> (Int, Int, Int)
annsCount AnnotationSet
annSet
          let rootAnn :: FieldAnn
rootAnn = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
          Bool -> Either (FromExpError x) () -> Either (FromExpError x) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
forall {k} (a :: k). Annotation a
noAnn) (Either (FromExpError x) () -> Either (FromExpError x) ())
-> Either (FromExpError x) () -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$
            FromExpError x -> Either (FromExpError x) ()
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) ())
-> FromExpError x -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
p (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ (Maybe Int, Maybe Int, Maybe Int)
-> (Int, Int, Int) -> FromExpErrorReason
FEERTooManyAnns (Maybe Int
forall a. Maybe a
Nothing, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1, Maybe Int
forall a. Maybe a
Nothing) (Int, Int, Int)
annCnt
          Ty
p' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty
            (Exp x
p Exp x -> (Exp x -> Exp x) -> Exp x
forall a b. a -> (a -> b) -> b
& ((XExpPrim x, MichelinePrimAp x)
 -> Identity (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Identity (Exp x)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
       (f :: * -> *).
(Choice p, Applicative f) =>
p (XExpPrim x, MichelinePrimAp x)
  (f (XExpPrim x, MichelinePrimAp x))
-> p (Exp x) (f (Exp x))
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
  -> Identity (XExpPrim x, MichelinePrimAp x))
 -> Exp x -> Identity (Exp x))
-> (([Annotation] -> Identity [Annotation])
    -> (XExpPrim x, MichelinePrimAp x)
    -> Identity (XExpPrim x, MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> Exp x
-> Identity (Exp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (XExpPrim x, MichelinePrimAp x)
  (XExpPrim x, MichelinePrimAp x)
  (MichelinePrimAp x)
  (MichelinePrimAp x)
_2 ((MichelinePrimAp x -> Identity (MichelinePrimAp x))
 -> (XExpPrim x, MichelinePrimAp x)
 -> Identity (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Identity [Annotation])
    -> MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp x -> Identity (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind) (f :: * -> *).
Functor f =>
([Annotation] -> f [Annotation])
-> MichelinePrimAp x -> f (MichelinePrimAp x)
mpaAnnotsL (([Annotation] -> Identity [Annotation])
 -> Exp x -> Identity (Exp x))
-> ([Annotation] -> [Annotation]) -> Exp x -> Exp x
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Annotation -> Bool) -> [Annotation] -> [Annotation]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
forall a. Boolean a => a -> a
not (Bool -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Bool
isAnnotationField))
          pure $ ParameterType -> ContractBlock op
forall op. ParameterType -> ContractBlock op
CBParam (ParameterType -> ContractBlock op)
-> ParameterType -> ContractBlock op
forall a b. (a -> b) -> a -> b
$ Ty -> FieldAnn -> ParameterType
Untyped.ParameterType Ty
p' FieldAnn
rootAnn
        [Exp x]
_ -> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (ContractBlock op))
-> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ NonEmpty Word -> Int -> FromExpErrorReason
FEERArgumentCountMismatch (OneItem (NonEmpty Word) -> NonEmpty Word
forall x. One x => OneItem x -> x
one Word
OneItem (NonEmpty Word)
1) ([Exp x] -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length [Exp x]
args)

      mkCBStorage
        :: Exp x
        -> [Exp x]
        -> [Annotation]
        -> Either (FromExpError x) (ContractBlock op)
      mkCBStorage :: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBStorage Exp x
e [Exp x]
args [Annotation]
anns = Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e ([Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns) (Int
0, Int
0, Int
0) Either (FromExpError x) ()
-> Either (FromExpError x) (ContractBlock op)
-> Either (FromExpError x) (ContractBlock op)
forall a b.
Either (FromExpError x) a
-> Either (FromExpError x) b -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
        Exp x
-> [Exp x]
-> (Ty -> ContractBlock op)
-> Either (FromExpError x) (ContractBlock op)
forall (x :: ExpExtensionDescriptorKind) a r.
WithArgsRec x a r =>
Exp x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec Exp x
e [Exp x]
args Ty -> ContractBlock op
forall op. Ty -> ContractBlock op
CBStorage

      mkCBCode
        :: Exp x
        -> [Exp x]
        -> [Annotation]
        -> Either (FromExpError x) (ContractBlock op)
      mkCBCode :: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBCode Exp x
e [Exp x]
args [Annotation]
anns = Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e ([Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns) (Int
0, Int
0, Int
0) Either (FromExpError x) ()
-> Either (FromExpError x) (ContractBlock op)
-> Either (FromExpError x) (ContractBlock op)
forall a b.
Either (FromExpError x) a
-> Either (FromExpError x) b -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
        Exp x
-> [Exp x]
-> (op -> ContractBlock op)
-> Either (FromExpError x) (ContractBlock op)
forall (x :: ExpExtensionDescriptorKind) a r.
WithArgsRec x a r =>
Exp x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec Exp x
e [Exp x]
args op -> ContractBlock op
forall op. op -> ContractBlock op
CBCode

      mkCBView
        :: Exp x
        -> [Exp x]
        -> [Annotation]
        -> Either (FromExpError x) (ContractBlock op)
      mkCBView :: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBView Exp x
e [Exp x]
args [Annotation]
anns = Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e ([Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns) (Int
0, Int
0, Int
0) Either (FromExpError x) ()
-> Either (FromExpError x) (ContractBlock op)
-> Either (FromExpError x) (ContractBlock op)
forall a b.
Either (FromExpError x) a
-> Either (FromExpError x) b -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
        Exp x
-> [Exp x]
-> (ViewName -> Ty -> Ty -> op -> ContractBlock op)
-> Either (FromExpError x) (ContractBlock op)
forall (x :: ExpExtensionDescriptorKind) a r.
WithArgsRec x a r =>
Exp x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec Exp x
e [Exp x]
args (View' op -> ContractBlock op
forall op. View' op -> ContractBlock op
CBView (View' op -> ContractBlock op)
-> (ViewName -> Ty -> Ty -> op -> View' op)
-> ViewName
-> Ty
-> Ty
-> op
-> ContractBlock op
forall a b c. SuperComposition a b c => a -> b -> c
... ViewName -> Ty -> Ty -> op -> View' op
forall op. ViewName -> Ty -> Ty -> op -> View' op
Untyped.View)

instance FromExp x Untyped.T where
  fromExp :: Exp x -> Either (FromExpError x) T
fromExp e :: Exp x
e@(ExpPrim' XExpPrim x
_ MichelinePrimitive
prim [Exp x]
args [Annotation]
anns) = Either (FromExpError x) ()
assertNoAnns Either (FromExpError x) ()
-> Either (FromExpError x) T -> Either (FromExpError x) T
forall a b.
Either (FromExpError x) a
-> Either (FromExpError x) b -> Either (FromExpError x) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MichelinePrimitive
-> (forall (tag :: MichelinePrimitiveTag).
    Sing tag
    -> ClassifiedMichelinePrimitive tag -> Either (FromExpError x) T)
-> Either (FromExpError x) T
forall r.
MichelinePrimitive
-> (forall (tag :: MichelinePrimitiveTag).
    Sing tag -> ClassifiedMichelinePrimitive tag -> r)
-> r
withClassifiedPrim MichelinePrimitive
prim \case
    Sing tag
SingMichelinePrimitiveTag tag
SMPTType -> \case
      ClassifiedMichelinePrimitive tag
C_Prim_key -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TKey
      ClassifiedMichelinePrimitive tag
C_Prim_unit -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TUnit
      ClassifiedMichelinePrimitive tag
C_Prim_signature -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TSignature
      ClassifiedMichelinePrimitive tag
C_Prim_chain_id -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TChainId
      ClassifiedMichelinePrimitive tag
C_Prim_option -> (Ty -> T) -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs Ty -> T
Untyped.TOption
      ClassifiedMichelinePrimitive tag
C_Prim_list -> (Ty -> T) -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs Ty -> T
Untyped.TList
      ClassifiedMichelinePrimitive tag
C_Prim_set -> (Ty -> T) -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs Ty -> T
Untyped.TSet
      ClassifiedMichelinePrimitive tag
C_Prim_operation -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TOperation
      ClassifiedMichelinePrimitive tag
C_Prim_contract -> (Ty -> T) -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs Ty -> T
Untyped.TContract
      ClassifiedMichelinePrimitive tag
C_Prim_ticket -> (Ty -> T) -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs Ty -> T
Untyped.TTicket
      ClassifiedMichelinePrimitive tag
C_Prim_or
        | [Exp x
arg1, Exp x
arg2] <- [Exp x]
args -> do
            let as1 :: AnnotationSet
as1 = [Annotation] -> AnnotationSet
toAnnSet ([Annotation] -> AnnotationSet) -> [Annotation] -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ Exp x
arg1 Exp x -> Getting [Annotation] (Exp x) [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. ((XExpPrim x, MichelinePrimAp x)
 -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
       (f :: * -> *).
(Choice p, Applicative f) =>
p (XExpPrim x, MichelinePrimAp x)
  (f (XExpPrim x, MichelinePrimAp x))
-> p (Exp x) (f (Exp x))
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
  -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
 -> Exp x -> Const [Annotation] (Exp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> (XExpPrim x, MichelinePrimAp x)
    -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Getting [Annotation] (Exp x) [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (XExpPrim x, MichelinePrimAp x)
  (XExpPrim x, MichelinePrimAp x)
  (MichelinePrimAp x)
  (MichelinePrimAp x)
_2 ((MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
 -> (XExpPrim x, MichelinePrimAp x)
 -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> ([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind) (f :: * -> *).
Functor f =>
([Annotation] -> f [Annotation])
-> MichelinePrimAp x -> f (MichelinePrimAp x)
mpaAnnotsL
            let as2 :: AnnotationSet
as2 = [Annotation] -> AnnotationSet
toAnnSet ([Annotation] -> AnnotationSet) -> [Annotation] -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ Exp x
arg2 Exp x -> Getting [Annotation] (Exp x) [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. ((XExpPrim x, MichelinePrimAp x)
 -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
       (f :: * -> *).
(Choice p, Applicative f) =>
p (XExpPrim x, MichelinePrimAp x)
  (f (XExpPrim x, MichelinePrimAp x))
-> p (Exp x) (f (Exp x))
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
  -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
 -> Exp x -> Const [Annotation] (Exp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> (XExpPrim x, MichelinePrimAp x)
    -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Getting [Annotation] (Exp x) [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (XExpPrim x, MichelinePrimAp x)
  (XExpPrim x, MichelinePrimAp x)
  (MichelinePrimAp x)
  (MichelinePrimAp x)
_2 ((MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
 -> (XExpPrim x, MichelinePrimAp x)
 -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> ([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind) (f :: * -> *).
Functor f =>
([Annotation] -> f [Annotation])
-> MichelinePrimAp x -> f (MichelinePrimAp x)
mpaAnnotsL
            Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
as1 (Int
1, Int
1, Int
0)
            Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
as2 (Int
1, Int
1, Int
0)
            let fa1 :: FieldAnn
fa1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
as1
            let fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
as2
            Ty
l <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp (Exp x -> Either (FromExpError x) Ty)
-> Exp x -> Either (FromExpError x) Ty
forall a b. (a -> b) -> a -> b
$ Exp x -> (Annotation -> Bool) -> Exp x
removeAnns Exp x
arg1 Annotation -> Bool
isAnnotationField
            Ty
r <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp (Exp x -> Either (FromExpError x) Ty)
-> Exp x -> Either (FromExpError x) Ty
forall a b. (a -> b) -> a -> b
$ Exp x -> (Annotation -> Bool) -> Exp x
removeAnns Exp x
arg2 Annotation -> Bool
isAnnotationField
            pure $ FieldAnn -> FieldAnn -> Ty -> Ty -> T
Untyped.TOr FieldAnn
fa1 FieldAnn
fa2 Ty
l Ty
r
        | Bool
otherwise -> FromExpError x -> Either (FromExpError x) T
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) T)
-> FromExpError x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$
            NonEmpty Word -> Int -> FromExpErrorReason
FEERArgumentCountMismatch (OneItem (NonEmpty Word) -> NonEmpty Word
forall x. One x => OneItem x -> x
one Word
OneItem (NonEmpty Word)
2) ([Exp x] -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length [Exp x]
args)
      ClassifiedMichelinePrimitive tag
C_Prim_pair -> do
        NonEmpty (Exp x)
args2 <- case [Exp x] -> Maybe (NonEmpty (Exp x))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Exp x]
args Maybe (NonEmpty (Exp x))
-> (NonEmpty (Exp x) -> Maybe (NonEmpty (Exp x)))
-> Maybe (NonEmpty (Exp x))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NonEmpty (Exp x) -> Maybe (NonEmpty (Exp x))
forall a. NonEmpty a -> Maybe (NonEmpty a)
forbidSingletonList of
          Maybe (NonEmpty (Exp x))
Nothing -> FromExpError x -> Either (FromExpError x) (NonEmpty (Exp x))
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (NonEmpty (Exp x)))
-> FromExpError x -> Either (FromExpError x) (NonEmpty (Exp x))
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ Word -> Int -> FromExpErrorReason
FEERNotEnoughArguments Word
2 ([Exp x] -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length [Exp x]
args)
          Just NonEmpty (Exp x)
as -> NonEmpty (Exp x) -> Either (FromExpError x) (NonEmpty (Exp x))
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty (Exp x)
as
        -- Check and extract annotations info
        NonEmpty (Ty, FieldAnn, VarAnn)
tyInfos <- NonEmpty (Exp x)
-> (Exp x -> Either (FromExpError x) (Ty, FieldAnn, VarAnn))
-> Either (FromExpError x) (NonEmpty (Ty, FieldAnn, VarAnn))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty (Exp x)
args2 \Exp x
arg -> do
          let as :: AnnotationSet
as = [Annotation] -> AnnotationSet
toAnnSet ([Annotation] -> AnnotationSet) -> [Annotation] -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ Exp x
arg Exp x -> Getting [Annotation] (Exp x) [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. ((XExpPrim x, MichelinePrimAp x)
 -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
       (f :: * -> *).
(Choice p, Applicative f) =>
p (XExpPrim x, MichelinePrimAp x)
  (f (XExpPrim x, MichelinePrimAp x))
-> p (Exp x) (f (Exp x))
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
  -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
 -> Exp x -> Const [Annotation] (Exp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> (XExpPrim x, MichelinePrimAp x)
    -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Getting [Annotation] (Exp x) [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (XExpPrim x, MichelinePrimAp x)
  (XExpPrim x, MichelinePrimAp x)
  (MichelinePrimAp x)
  (MichelinePrimAp x)
_2 ((MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
 -> (XExpPrim x, MichelinePrimAp x)
 -> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> ([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind) (f :: * -> *).
Functor f =>
([Annotation] -> f [Annotation])
-> MichelinePrimAp x -> f (MichelinePrimAp x)
mpaAnnotsL
          Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
as (Int
1, Int
1, Int
1)
          let fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
as
          let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
as
          Ty
ty <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp (Exp x -> Either (FromExpError x) Ty)
-> Exp x -> Either (FromExpError x) Ty
forall a b. (a -> b) -> a -> b
$ Exp x -> (Annotation -> Bool) -> Exp x
removeAnns Exp x
arg
            (Annotation -> Bool
isAnnotationField (Annotation -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall a. Boolean a => a -> a -> a
|| Annotation -> Bool
isAnnotationVariable)
          return (Ty
ty, FieldAnn
fa, VarAnn
va)
        -- Make a right-comb pairs tree
        let combiner :: (Ty, FieldAnn, VarAnn)
-> (Ty, FieldAnn, VarAnn) -> (Ty, Annotation a, Annotation a)
combiner (Ty
ty1, FieldAnn
fa1, VarAnn
va1) (Ty
ty2, FieldAnn
fa2, VarAnn
va2) =
              ( T -> TypeAnn -> Ty
Ty (FieldAnn -> FieldAnn -> VarAnn -> VarAnn -> Ty -> Ty -> T
Untyped.TPair FieldAnn
fa1 FieldAnn
fa2 VarAnn
va1 VarAnn
va2 Ty
ty1 Ty
ty2) TypeAnn
forall {k} (a :: k). Annotation a
noAnn
              , Annotation a
forall {k} (a :: k). Annotation a
noAnn
              , Annotation a
forall {k} (a :: k). Annotation a
noAnn
              )
        let (Ty T
tRes TypeAnn
_, FieldAnn
_, VarAnn
_) = ((Ty, FieldAnn, VarAnn)
 -> (Ty, FieldAnn, VarAnn) -> (Ty, FieldAnn, VarAnn))
-> NonEmpty (Ty, FieldAnn, VarAnn) -> (Ty, FieldAnn, VarAnn)
forall a. (a -> a -> a) -> NonEmpty a -> a
foldr1 (Ty, FieldAnn, VarAnn)
-> (Ty, FieldAnn, VarAnn) -> (Ty, FieldAnn, VarAnn)
forall {k} {k} {a :: k} {a :: k}.
(Ty, FieldAnn, VarAnn)
-> (Ty, FieldAnn, VarAnn) -> (Ty, Annotation a, Annotation a)
combiner NonEmpty (Ty, FieldAnn, VarAnn)
tyInfos
        T -> Either (FromExpError x) T
forall a. a -> Either (FromExpError x) a
forall (f :: * -> *) a. Applicative f => a -> f a
return T
tRes
      ClassifiedMichelinePrimitive tag
C_Prim_lambda -> (Ty -> Ty -> T) -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs Ty -> Ty -> T
Untyped.TLambda
      ClassifiedMichelinePrimitive tag
C_Prim_map -> (Ty -> Ty -> T) -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs Ty -> Ty -> T
Untyped.TMap
      ClassifiedMichelinePrimitive tag
C_Prim_big_map -> (Ty -> Ty -> T) -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs Ty -> Ty -> T
Untyped.TBigMap
      ClassifiedMichelinePrimitive tag
C_Prim_int -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TInt
      ClassifiedMichelinePrimitive tag
C_Prim_nat -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TNat
      ClassifiedMichelinePrimitive tag
C_Prim_string -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TString
      ClassifiedMichelinePrimitive tag
C_Prim_bytes -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TBytes
      ClassifiedMichelinePrimitive tag
C_Prim_mutez -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TMutez
      ClassifiedMichelinePrimitive tag
C_Prim_bool -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TBool
      ClassifiedMichelinePrimitive tag
C_Prim_key_hash -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TKeyHash
      ClassifiedMichelinePrimitive tag
C_Prim_bls12_381_fr -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TBls12381Fr
      ClassifiedMichelinePrimitive tag
C_Prim_bls12_381_g1 -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TBls12381G1
      ClassifiedMichelinePrimitive tag
C_Prim_bls12_381_g2 -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TBls12381G2
      ClassifiedMichelinePrimitive tag
C_Prim_timestamp -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TTimestamp
      ClassifiedMichelinePrimitive tag
C_Prim_address -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TAddress
      ClassifiedMichelinePrimitive tag
C_Prim_chest -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TChest
      ClassifiedMichelinePrimitive tag
C_Prim_chest_key -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TChestKey
      ClassifiedMichelinePrimitive tag
C_Prim_tx_rollup_l2_address ->
        FromExpError x -> Either (FromExpError x) T
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) T)
-> FromExpError x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e FromExpErrorReason
FEERUnsupported
      ClassifiedMichelinePrimitive tag
C_Prim_never -> T -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs T
Untyped.TNever
      ClassifiedMichelinePrimitive tag
C_Prim_sapling_state -> (Natural -> T) -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs Natural -> T
Untyped.TSaplingState
      ClassifiedMichelinePrimitive tag
C_Prim_sapling_transaction -> (Natural -> T) -> Either (FromExpError x) T
forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs Natural -> T
Untyped.TSaplingTransaction
      ClassifiedMichelinePrimitive tag
C_Prim_sapling_transaction_deprecated ->
        FromExpError x -> Either (FromExpError x) T
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) T)
-> FromExpError x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e FromExpErrorReason
FEERDeprecated
    Sing tag
s -> Either (FromExpError x) T
-> ClassifiedMichelinePrimitive tag -> Either (FromExpError x) T
forall a b. a -> b -> a
const (Either (FromExpError x) T
 -> ClassifiedMichelinePrimitive tag -> Either (FromExpError x) T)
-> Either (FromExpError x) T
-> ClassifiedMichelinePrimitive tag
-> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ FromExpError x -> Either (FromExpError x) T
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) T)
-> FromExpError x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ MichelinePrimitiveTag
-> MichelinePrimitiveTag -> FromExpErrorReason
FEERUnexpectedPrimClass MichelinePrimitiveTag
MPTType (Sing tag -> Demote MichelinePrimitiveTag
forall k (a :: k). SingKind k => Sing a -> Demote k
forall (a :: MichelinePrimitiveTag).
Sing a -> Demote MichelinePrimitiveTag
fromSing Sing tag
s)
    where
      assertNoAnns :: Either (FromExpError x) ()
assertNoAnns = Bool -> Either (FromExpError x) () -> Either (FromExpError x) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Annotation] -> Bool
forall t. Container t => t -> Bool
null [Annotation]
anns) (Either (FromExpError x) () -> Either (FromExpError x) ())
-> Either (FromExpError x) () -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$ FromExpError x -> Either (FromExpError x) ()
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) ())
-> FromExpError x -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e FromExpErrorReason
FEERUnexpectedAnnotations
      withArgs :: WithArgsRec x a Untyped.T => a -> Either (FromExpError x) Untyped.T
      withArgs :: forall a. WithArgsRec x a T => a -> Either (FromExpError x) T
withArgs = Exp x -> [Exp x] -> a -> Either (FromExpError x) T
forall (x :: ExpExtensionDescriptorKind) a r.
WithArgsRec x a r =>
Exp x -> [Exp x] -> a -> Either (FromExpError x) r
withArgsRec Exp x
e [Exp x]
args

      removeAnns :: Exp x -> (Annotation -> Bool) -> Exp x
      removeAnns :: Exp x -> (Annotation -> Bool) -> Exp x
removeAnns Exp x
expr Annotation -> Bool
p =
        Exp x
expr Exp x -> (Exp x -> Exp x) -> Exp x
forall a b. a -> (a -> b) -> b
& ((XExpPrim x, MichelinePrimAp x)
 -> Identity (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Identity (Exp x)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
       (f :: * -> *).
(Choice p, Applicative f) =>
p (XExpPrim x, MichelinePrimAp x)
  (f (XExpPrim x, MichelinePrimAp x))
-> p (Exp x) (f (Exp x))
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
  -> Identity (XExpPrim x, MichelinePrimAp x))
 -> Exp x -> Identity (Exp x))
-> (([Annotation] -> Identity [Annotation])
    -> (XExpPrim x, MichelinePrimAp x)
    -> Identity (XExpPrim x, MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> Exp x
-> Identity (Exp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (XExpPrim x, MichelinePrimAp x)
  (XExpPrim x, MichelinePrimAp x)
  (MichelinePrimAp x)
  (MichelinePrimAp x)
_2 ((MichelinePrimAp x -> Identity (MichelinePrimAp x))
 -> (XExpPrim x, MichelinePrimAp x)
 -> Identity (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Identity [Annotation])
    -> MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp x -> Identity (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind) (f :: * -> *).
Functor f =>
([Annotation] -> f [Annotation])
-> MichelinePrimAp x -> f (MichelinePrimAp x)
mpaAnnotsL (([Annotation] -> Identity [Annotation])
 -> Exp x -> Identity (Exp x))
-> ([Annotation] -> [Annotation]) -> Exp x -> Exp x
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Annotation -> Bool) -> [Annotation] -> [Annotation]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
forall a. Boolean a => a -> a
not (Bool -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Bool
p)
  fromExp Exp x
e = FromExpError x -> Either (FromExpError x) T
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) T)
-> FromExpError x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ NonEmpty MichelinePrimitiveTag -> FromExpErrorReason
FEERExpectedPrim (NonEmpty MichelinePrimitiveTag -> FromExpErrorReason)
-> NonEmpty MichelinePrimitiveTag -> FromExpErrorReason
forall a b. (a -> b) -> a -> b
$ OneItem (NonEmpty MichelinePrimitiveTag)
-> NonEmpty MichelinePrimitiveTag
forall x. One x => OneItem x -> x
one OneItem (NonEmpty MichelinePrimitiveTag)
MichelinePrimitiveTag
MPTType

instance FromExp x Ty where
  fromExp :: Exp x -> Either (FromExpError x) Ty
fromExp Exp x
e = case Exp x
e of
    ExpPrim' XExpPrim x
ex MichelinePrimitive
primName [Exp x]
args [Annotation]
anns -> do
      let annSet :: AnnotationSet
annSet = [Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns
          annCnt :: (Int, Int, Int)
annCnt = AnnotationSet -> (Int, Int, Int)
annsCount AnnotationSet
annSet
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      Bool -> Either (FromExpError x) () -> Either (FromExpError x) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @TypeTag AnnotationSet
annSet TypeAnn -> TypeAnn -> Bool
forall a. Eq a => a -> a -> Bool
/= TypeAnn
forall {k} (a :: k). Annotation a
noAnn) (Either (FromExpError x) () -> Either (FromExpError x) ())
-> Either (FromExpError x) () -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$
        FromExpError x -> Either (FromExpError x) ()
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) ())
-> FromExpError x -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ (Maybe Int, Maybe Int, Maybe Int)
-> (Int, Int, Int) -> FromExpErrorReason
FEERTooManyAnns (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1, Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing) (Int, Int, Int)
annCnt
      T
t <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Untyped.T (Exp x -> Either (FromExpError x) T)
-> Exp x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ XExpPrim x
-> MichelinePrimitive -> [Exp x] -> [Annotation] -> Exp x
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x
-> MichelinePrimitive -> [Exp x] -> [Annotation] -> Exp x
ExpPrim' XExpPrim x
ex MichelinePrimitive
primName [Exp x]
args ([Annotation] -> Exp x) -> [Annotation] -> Exp x
forall a b. (a -> b) -> a -> b
$ (Annotation -> Bool) -> [Annotation] -> [Annotation]
forall a. (a -> Bool) -> [a] -> [a]
filter
        (Bool -> Bool
forall a. Boolean a => a -> a
not (Bool -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Bool
isAnnotationType) [Annotation]
anns
      pure $ T -> TypeAnn -> Ty
Ty T
t TypeAnn
ta
    Exp x
_ -> FromExpError x -> Either (FromExpError x) Ty
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) Ty)
-> FromExpError x -> Either (FromExpError x) Ty
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ NonEmpty MichelinePrimitiveTag -> FromExpErrorReason
FEERExpectedPrim (OneItem (NonEmpty MichelinePrimitiveTag)
-> NonEmpty MichelinePrimitiveTag
forall x. One x => OneItem x -> x
one OneItem (NonEmpty MichelinePrimitiveTag)
MichelinePrimitiveTag
MPTType)

instance FromExp x T where
  fromExp :: Exp x -> Either (FromExpError x) T
fromExp =
    (Ty -> T)
-> Either (FromExpError x) Ty -> Either (FromExpError x) T
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Ty -> T
fromUType (Either (FromExpError x) Ty -> Either (FromExpError x) T)
-> (Exp x -> Either (FromExpError x) Ty)
-> Exp x
-> Either (FromExpError x) T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Untyped.Ty

-- Note: we should generalize this to work for any instruction,
-- not just lambdas (i.e. instructions with one input and one output).
instance (SingI inp, SingI out) => FromExp RegularExp (Instr '[inp] '[out]) where
  fromExp :: Expression -> Either FromExpressionError (Instr '[inp] '[out])
fromExp Expression
expr =
    forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @(Value ('TLambda inp out)) Expression
expr Either FromExpressionError (Value ('TLambda inp out))
-> (Value ('TLambda inp out)
    -> Either FromExpressionError (Instr '[inp] '[out]))
-> Either FromExpressionError (Instr '[inp] '[out])
forall a b.
Either FromExpressionError a
-> (a -> Either FromExpressionError b)
-> Either FromExpressionError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      VLam (LambdaCode RemFail Instr '[inp] '[out]
instr) -> Instr '[inp] '[out]
-> Either FromExpressionError (Instr '[inp] '[out])
forall a. a -> Either FromExpressionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instr '[inp] '[out]
 -> Either FromExpressionError (Instr '[inp] '[out]))
-> Instr '[inp] '[out]
-> Either FromExpressionError (Instr '[inp] '[out])
forall a b. (a -> b) -> a -> b
$ RemFail Instr '[inp] '[out] -> Instr '[inp] '[out]
forall {k} (instr :: k -> k -> *) (i :: k) (o :: k).
RemFail instr i o -> instr i o
rfAnyInstr RemFail Instr '[inp] '[out]
RemFail Instr '[inp] '[out]
instr
      VLam LambdaCodeRec{} -> FromExpressionError
-> Either FromExpressionError (Instr '[inp] '[out])
forall a b. a -> Either a b
Left (FromExpressionError
 -> Either FromExpressionError (Instr '[inp] '[out]))
-> FromExpressionError
-> Either FromExpressionError (Instr '[inp] '[out])
forall a b. (a -> b) -> a -> b
$ Expression -> FromExpErrorReason -> FromExpressionError
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Expression
expr (FromExpErrorReason -> FromExpressionError)
-> FromExpErrorReason -> FromExpressionError
forall a b. (a -> b) -> a -> b
$
        Maybe MichelinePrimitive
-> MichelinePrimitive -> FromExpErrorReason
FEERUnexpectedPrim Maybe MichelinePrimitive
forall a. Maybe a
Nothing MichelinePrimitive
Prim_Lambda_rec

instance FromExp x ViewName where
  fromExp :: Exp x -> Either (FromExpError x) ViewName
fromExp Exp x
e = case Exp x
e of
    ExpString XExpString x
_ Text
s ->
      (BadViewNameError -> FromExpError x)
-> Either BadViewNameError ViewName
-> Either (FromExpError x) ViewName
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 (Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> (BadViewNameError -> FromExpErrorReason)
-> BadViewNameError
-> FromExpError x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BadViewNameError -> FromExpErrorReason
FEERViewNameError) (Either BadViewNameError ViewName
 -> Either (FromExpError x) ViewName)
-> Either BadViewNameError ViewName
-> Either (FromExpError x) ViewName
forall a b. (a -> b) -> a -> b
$ Text -> Either BadViewNameError ViewName
mkViewName Text
s
    Exp x
_ -> FromExpError x -> Either (FromExpError x) ViewName
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) ViewName)
-> FromExpError x -> Either (FromExpError x) ViewName
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e FromExpErrorReason
FEERExpectedString

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

-- | Adds annotations to the expression, after removing empty annotations
-- at the end of each list.
addTrimmedAnns
  :: Exp x
  -> [TypeAnn]
  -> [FieldAnn]
  -> [VarAnn]
  -> Exp x
addTrimmedAnns :: forall (x :: ExpExtensionDescriptorKind).
Exp x -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Exp x
addTrimmedAnns Exp x
e [TypeAnn]
tas [FieldAnn]
fas [VarAnn]
vas =
  Exp x
e Exp x -> (Exp x -> Exp x) -> Exp x
forall a b. a -> (a -> b) -> b
& ((XExpPrim x, MichelinePrimAp x)
 -> Identity (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Identity (Exp x)
forall (x :: ExpExtensionDescriptorKind) (p :: * -> * -> *)
       (f :: * -> *).
(Choice p, Applicative f) =>
p (XExpPrim x, MichelinePrimAp x)
  (f (XExpPrim x, MichelinePrimAp x))
-> p (Exp x) (f (Exp x))
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
  -> Identity (XExpPrim x, MichelinePrimAp x))
 -> Exp x -> Identity (Exp x))
-> (([Annotation] -> Identity [Annotation])
    -> (XExpPrim x, MichelinePrimAp x)
    -> Identity (XExpPrim x, MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> Exp x
-> Identity (Exp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (XExpPrim x, MichelinePrimAp x)
  (XExpPrim x, MichelinePrimAp x)
  (MichelinePrimAp x)
  (MichelinePrimAp x)
_2 ((MichelinePrimAp x -> Identity (MichelinePrimAp x))
 -> (XExpPrim x, MichelinePrimAp x)
 -> Identity (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Identity [Annotation])
    -> MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp x -> Identity (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind) (f :: * -> *).
Functor f =>
([Annotation] -> f [Annotation])
-> MichelinePrimAp x -> f (MichelinePrimAp x)
mpaAnnotsL (([Annotation] -> Identity [Annotation])
 -> Exp x -> Identity (Exp x))
-> [Annotation] -> Exp x -> Exp x
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn]
tas [FieldAnn]
fas [VarAnn]
vas

-- | Inserts the root annotation into the contract parameter.
insertRootAnn :: HasCallStack => Expression -> RootAnn -> Expression
insertRootAnn :: HasCallStack => Expression -> FieldAnn -> Expression
insertRootAnn Expression
expr FieldAnn
rootAnn = case Expression
expr of
  ExpPrim () MichelinePrimAp RegularExp
p
    -- The order of annotations is important iff there are
    -- multiple annotations of the same kind or there are
    -- other kinds of annotations in the list.
    -- Prepending root field annotation is okay because
    -- there can not be more than one root annotation.
    | FieldAnn
rootAnn FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldAnn
forall {k} (a :: k). Annotation a
noAnn -> MichelinePrimAp RegularExp -> Expression
expressionPrim MichelinePrimAp RegularExp
p
      { mpaAnnots :: [Annotation]
mpaAnnots = FieldAnn -> Annotation
AnnotationField FieldAnn
rootAnn Annotation -> [Annotation] -> [Annotation]
forall a. a -> [a] -> [a]
: MichelinePrimAp RegularExp -> [Annotation]
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> [Annotation]
mpaAnnots MichelinePrimAp RegularExp
p
      }
    | Bool
otherwise -> Expression
expr
  -- Currently this error can't happen because parameter type
  -- must be a Micheline primitive. If it ever changes, we
  -- would like to notice it ASAP and update this place.
  Expression
_ -> Text -> Expression
forall a. HasCallStack => Text -> a
error (Text -> Expression) -> Text -> Expression
forall a b. (a -> b) -> a -> b
$ Text
"parameter is not a primitive: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty Expression
expr

-- | Checks for a given expression that the number of annotations
-- of each type in it doesn't exceed the specified threshold.
checkAnnsCount
  :: Exp x
  -> AnnotationSet
  -> (Int, Int, Int)
  -> Either (FromExpError x) ()
checkAnnsCount :: forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet maxCount :: (Int, Int, Int)
maxCount@(Int
maxTas, Int
maxFas, Int
maxVas) = do
  let actualCount :: (Int, Int, Int)
actualCount = AnnotationSet -> (Int, Int, Int)
annsCount AnnotationSet
annSet
  Bool -> Either (FromExpError x) () -> Either (FromExpError x) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Int, Int, Int)
actualCount (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int, Int, Int)
maxCount) (Either (FromExpError x) () -> Either (FromExpError x) ())
-> Either (FromExpError x) () -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$
    FromExpError x -> Either (FromExpError x) ()
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) ())
-> FromExpError x -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e (FromExpErrorReason -> FromExpError x)
-> FromExpErrorReason -> FromExpError x
forall a b. (a -> b) -> a -> b
$ (Maybe Int, Maybe Int, Maybe Int)
-> (Int, Int, Int) -> FromExpErrorReason
FEERTooManyAnns (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maxTas, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maxFas, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maxVas) (Int, Int, Int)
actualCount

forbidSingletonList :: NonEmpty a -> Maybe (NonEmpty a)
forbidSingletonList :: forall a. NonEmpty a -> Maybe (NonEmpty a)
forbidSingletonList = \case
  a
_ :| [] -> Maybe (NonEmpty a)
forall a. Maybe a
Nothing
  NonEmpty a
x       -> NonEmpty a -> Maybe (NonEmpty a)
forall a. a -> Maybe a
Just NonEmpty a
x

integralToExpr :: Integral i => i -> Expression
integralToExpr :: forall i. Integral i => i -> Expression
integralToExpr = Integer -> Expression
expressionInt (Integer -> Expression) -> (i -> Integer) -> i -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Integer
forall a. Integral a => a -> Integer
toInteger

integralFromExpr :: (Integral i, Bits i) => Exp x -> Either (FromExpError x) i
integralFromExpr :: forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
e = case Exp x
e of
  ExpInt XExpInt x
_ Integer
v ->
    FromExpError x -> Maybe i -> Either (FromExpError x) i
forall l r. l -> Maybe r -> Either l r
maybeToRight (Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e FromExpErrorReason
FEEROutOfBounds)
      (forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
fromIntegralMaybe @Integer Integer
v)
  Exp x
_ -> FromExpError x -> Either (FromExpError x) i
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) i)
-> FromExpError x -> Either (FromExpError x) i
forall a b. (a -> b) -> a -> b
$ Exp x -> FromExpErrorReason -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> FromExpErrorReason -> FromExpError x
FromExpError Exp x
e FromExpErrorReason
FEERExpectedNumber