-- 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)
import Fmt (Buildable(..), indentF, pretty, unlinesF)

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

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

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

instance (HasNoOp 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). HasNoOp 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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Unit" [] []
    Value
Untyped.ValueTrue -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"True" [] []
    Value
Untyped.ValueFalse -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"False" [] []
    Untyped.ValuePair Value
l Value
r ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Left" [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
    Untyped.ValueRight Value
v -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Right" [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
    Untyped.ValueSome Value
v -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Some" [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
    Value
Untyped.ValueNone -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 NonEmpty ExpandedOp
ops -> NonEmpty ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression NonEmpty ExpandedOp
ops
    Untyped.ValueLamRec NonEmpty ExpandedOp
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Lambda_rec" [NonEmpty ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression NonEmpty ExpandedOp
ops] []
    where
      eltToExpr :: Untyped.Elt ExpandedOp -> Expression
      eltToExpr :: Elt ExpandedOp -> Expression
eltToExpr (Untyped.Elt Value
l Value
r) = Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"key" [] []
    T
Untyped.TUnit -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"unit" [] []
    T
Untyped.TSignature -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"signature" [] []
    T
Untyped.TChainId -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"chain_id" [] []
    Untyped.TOption Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"option" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    Untyped.TList Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"list" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    Untyped.TSet Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"set" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    T
Untyped.TOperation -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"operation" [] []
    Untyped.TContract Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"contract" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    Untyped.TTicket Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ticket" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    t :: T
t@Untyped.TPair{} -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"or" [Expression
exprL, Expression
exprR] []
    Untyped.TLambda Ty
inp Ty
out ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"int" [] []
    T
Untyped.TNat -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"nat" [] []
    T
Untyped.TString -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"string" [] []
    T
Untyped.TBytes -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"bytes" [] []
    T
Untyped.TMutez -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"mutez" [] []
    T
Untyped.TBool -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"bool" [] []
    T
Untyped.TKeyHash -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"key_hash" [] []
    T
Untyped.TBls12381Fr -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"bls12_381_fr" [] []
    T
Untyped.TBls12381G1 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"bls12_381_g1" [] []
    T
Untyped.TBls12381G2 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"bls12_381_g2" [] []
    T
Untyped.TTimestamp -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"timestamp" [] []
    T
Untyped.TAddress -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"address" [] []
    T
Untyped.TChest -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"chest" [] []
    T
Untyped.TChestKey -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"chest_key" [] []
    T
Untyped.TTxRollupL2Address -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"tx_rollup_l2_address" [] []
    T
Untyped.TNever -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"never" [] []
    Untyped.TSaplingState Natural
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"sapling_state" [Natural -> Expression
forall i. Integral i => i -> Expression
integralToExpr Natural
n] []
    Untyped.TSaplingTransaction Natural
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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).
Lens' (MichelinePrimAp x) [Annotation]
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]
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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DROP" [] []
    DROPN Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DROP" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
    DUP VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DUP" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    DUPN VarAnn
va Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SWAP" [] []
    DIG Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DIG" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
    DUG Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DUG" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
    SOME TypeAnn
ta VarAnn
va ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"UNPAIR" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
    CAR VarAnn
va FieldAnn
fa -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ITER" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    MEM VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"MEM" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    GET VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"GET" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    GETN VarAnn
va Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"UPDATE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    UPDATEN VarAnn
va Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LOOP" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    LOOP_LEFT [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LOOP_LEFT" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    LAMBDA VarAnn
va Ty
tyin Ty
tyout [ExpandedOp]
ops ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"EXEC" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    APPLY VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"APPLY" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    DIP [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DIP" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    DIPN Word
n [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"FAILWITH" [] []
    CAST VarAnn
va Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"RENAME" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    PACK VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CONCAT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SLICE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SLICE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ISNAT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ISNAT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ADD VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ADD" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SUB VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SUB" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SUB_MUTEZ VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SUB_MUTEZ" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    MUL VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"MUL" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    EDIV VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"EDIV" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ABS VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ABS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    NEG VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NEG" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    LSL VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LSL" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    LSR VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LSR" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    OR VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"OR" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    AND VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"AND" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    XOR VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"XOR" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    NOT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NOT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    COMPARE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"COMPARE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    Untyped.EQ VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"EQ" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    NEQ VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NEQ" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    Untyped.LT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    Untyped.GT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"GT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    LE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    GE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"GE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    INT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"INT" [] ([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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"TRANSFER_TOKENS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SET_DELEGATE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 ->
      Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"IMPLICIT_ACCOUNT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
      [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    NOW VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NOW" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    AMOUNT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"AMOUNT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    BALANCE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"BALANCE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    VOTING_POWER VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CHECK_SIGNATURE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SHA256 VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SHA256" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SHA512 VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SHA512" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    BLAKE2B VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"BLAKE2B" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SHA3 VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SHA3" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    KECCAK VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"KECCAK" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    HASH_KEY VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"HASH_KEY" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    PAIRING_CHECK VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"PAIRING_CHECK" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SOURCE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SOURCE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SENDER VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SENDER" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ADDRESS VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ADDRESS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    CHAIN_ID VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CHAIN_ID" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    LEVEL VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LEVEL" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SELF_ADDRESS VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SELF_ADDRESS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    TICKET VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"TICKET" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    TICKET_DEPRECATED VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"TICKET_DEPRECATED" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    READ_TICKET VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"READ_TICKET" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    SPLIT_TICKET VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SPLIT_TICKET" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    JOIN_TICKETS VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"JOIN_TICKETS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    OPEN_CHEST VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"OPEN_CHEST" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ExpandedInstr
NEVER -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NEVER" [] []
    EXT ExtInstrAbstract ExpandedOp
_ -> [Expression] -> Expression
expressionSeq []
    SAPLING_EMPTY_STATE VarAnn
va Natural
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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) -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"parameter"
            [HasCallStack => Expression -> FieldAnn -> Expression
Expression -> FieldAnn -> Expression
insertRootAnn (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty) FieldAnn
rootAnn] [])
          (\Ty
storage -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"storage" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
storage] [])
          (\[ExpandedOp]
code -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"code" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
code] [])
          (\Untyped.View{[ExpandedOp]
Ty
ViewName
viewCode :: forall op. View' op -> [op]
viewReturn :: forall op. View' op -> Ty
viewArgument :: forall op. View' op -> Ty
viewName :: forall op. View' op -> ViewName
viewCode :: [ExpandedOp]
viewReturn :: Ty
viewArgument :: Ty
viewName :: ViewName
..} -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"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
convertContract

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

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

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

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

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

instance Exception FromExpressionError where
  displayException :: FromExpressionError -> String
displayException = FromExpressionError -> String
forall a b. (Buildable a, FromBuilder 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' ExpandedOp) (Value t)
forall {t :: T}.
SingI t =>
Value -> Either (TcError' ExpandedOp) (Value t)
typeCheck Value
uv of
      Left TcError' ExpandedOp
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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
expr (Text -> FromExpError x) -> Text -> FromExpError x
forall a b. (a -> b) -> a -> b
$
        Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
          [ Builder
"Failed to typecheck expression as a value of type:"
          , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ T -> Builder
forall p. Buildable p => p -> Builder
build (T -> Builder) -> T -> Builder
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @t
          , Builder
""
          , Builder
"Typechecker error:"
          , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ TcError' ExpandedOp -> Builder
forall p. Buildable p => p -> Builder
build TcError' ExpandedOp
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' ExpandedOp) (Value t)
typeCheck Value
uv = TypeCheckOptions
-> TypeCheckResult ExpandedOp (Value t)
-> Either (TcError' ExpandedOp) (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' ExpandedOp) (Value t))
-> TypeCheckResult ExpandedOp (Value t)
-> Either (TcError' ExpandedOp) (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 (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 op. Integer -> Value' op
Untyped.ValueInt Integer
v
    ExpString XExpString x
_ Text
s -> (Text -> FromExpError x)
-> Either Text (Value' op) -> Either (FromExpError x) (Value' op)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e)
      (MText -> Value' op
forall op. MText -> Value' 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 (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 op. InternalByteString -> Value' 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
_ MichelinePrimitive
"Unit" [] [] -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' op
forall op. Value' op
Untyped.ValueUnit
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"True" [] [] -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' op
forall op. Value' op
Untyped.ValueTrue
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"False" [] [] -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' op
forall op. Value' op
Untyped.ValueFalse
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"Pair" [Exp x]
args [] ->
      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 (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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
          Text
"Expected a pair with at least 2 arguments"
        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)
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 op. Value' op -> Value' op -> Value' op
Untyped.ValuePair NonEmpty (Value' op)
tys
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"Left" [Exp x
arg] [] -> do
      Value' op
arg' <- Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
      pure $ Value' op -> Value' op
forall op. Value' op -> Value' op
Untyped.ValueLeft Value' op
arg'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"Right" [Exp x
arg] [] -> do
      Value' op
arg' <- Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
      pure $ Value' op -> Value' op
forall op. Value' op -> Value' op
Untyped.ValueRight Value' op
arg'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"Some" [Exp x
arg] [] -> do
      Value' op
arg' <- Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
      pure $ Value' op -> Value' op
forall op. Value' op -> Value' op
Untyped.ValueSome Value' op
arg'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"None" [] [] -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' op
forall op. Value' op
Untyped.ValueNone
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"Lambda_rec" [Exp x
args] [] -> (NonEmpty op -> Value' op)
-> Either (FromExpError x) (NonEmpty op)
-> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty op -> Value' op
forall op. NonEmpty op -> Value' op
Untyped.ValueLamRec (Either (FromExpError x) (NonEmpty op)
 -> Either (FromExpError x) (Value' op))
-> Either (FromExpError x) (NonEmpty op)
-> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$
      Exp x -> Either (FromExpError x) [op]
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
args Either (FromExpError x) [op]
-> ([op] -> Either (FromExpError x) (NonEmpty op))
-> Either (FromExpError x) (NonEmpty op)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FromExpError x
-> Maybe (NonEmpty op) -> Either (FromExpError x) (NonEmpty op)
forall l r. l -> Maybe r -> Either l r
maybeToRight (Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected at least one instruction") (Maybe (NonEmpty op) -> Either (FromExpError x) (NonEmpty op))
-> ([op] -> Maybe (NonEmpty op))
-> [op]
-> Either (FromExpError x) (NonEmpty op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [op] -> Maybe (NonEmpty op)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
    ExpSeq XExpSeq x
_ [] -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' op
forall op. Value' 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)
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 (f :: * -> *) a. Applicative f => a -> f a
pure (Value' op -> Either (FromExpError x) (Value' op))
-> (NonEmpty op -> Value' op)
-> NonEmpty op
-> Either (FromExpError x) (Value' op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty op -> Value' op
forall op. NonEmpty op -> Value' op
Untyped.ValueLambda (NonEmpty op -> Either (FromExpError x) (Value' op))
-> NonEmpty op -> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$ op
op op -> [op] -> NonEmpty op
forall a. a -> [a] -> NonEmpty 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)
traverse Exp x -> Either (FromExpError x) (Elt op)
exprToElt [Exp x]
t
          Value' op -> Either (FromExpError x) (Value' op)
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 op. (NonEmpty $ Elt op) -> Value' 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 Text
_) -> 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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
err
            Text
"Value, instruction or 'Elt' expression expected"
          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)
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 (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 op. (NonEmpty $ Value' op) -> Value' 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'
    Exp 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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected a value"
    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
"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 op. Value' op -> Value' op -> Elt op
Untyped.Elt Value' op
l' Value' op
r'
        ExpPrim' XExpPrim x
_ MichelinePrimitive
"Elt" [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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
ex
          Text
"Expected 'Elt' expression with exactly 2 elements"
        ExpPrim' XExpPrim x
_ MichelinePrimitive
"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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
ex
          Text
"Expected 'Elt' expression without annotations"
        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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
ex Text
"Expected 'Elt' expression"

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)
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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"'ExpressionSeq' expected"

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)
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

-- 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 Exp x
e = let annSet :: AnnotationSet
annSet = Exp x -> AnnotationSet
forall (d :: ExpExtensionDescriptorKind). Exp d -> AnnotationSet
getAnnSet Exp x
e in case Exp x
e of
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"DROP" [Exp x
n] [] -> do
      Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      pure $ Word -> InstrAbstract op
forall op. Word -> InstrAbstract op
DROPN Word
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"DROP" [] [Annotation]
_ -> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
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
$ InstrAbstract op
forall op. InstrAbstract op
DROP
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"DUP" [Exp x
n] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
1)
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      pure $ VarAnn -> Word -> InstrAbstract op
forall op. VarAnn -> Word -> InstrAbstract op
DUPN VarAnn
va Word
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"DUP" [] [Annotation]
_ ->
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      in 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 (Int
0, Int
0, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
va
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SWAP" [] [] -> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
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
$ InstrAbstract op
forall op. InstrAbstract op
SWAP
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"DIG" [Exp x
n] [] -> do
      Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      pure $ Word -> InstrAbstract op
forall op. Word -> InstrAbstract op
DIG (Word -> InstrAbstract op) -> Word -> InstrAbstract op
forall a b. (a -> b) -> a -> b
$ Word
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"DUG" [Exp x
n] [] -> do
      Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      pure $ Word -> InstrAbstract op
forall op. Word -> InstrAbstract op
DUG Word
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"PUSH" [Exp x
t, Exp x
v] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
1)
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
      Value' op
v' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @(Untyped.Value' op) Exp x
v
      pure $ VarAnn -> Ty -> Value' op -> InstrAbstract op
forall op. VarAnn -> Ty -> Value' op -> InstrAbstract op
PUSH VarAnn
va Ty
t' Value' op
v'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SOME" [] [Annotation]
_ ->
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
          va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      in 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 (Int
1, Int
0, 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 -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> InstrAbstract op
SOME TypeAnn
ta VarAnn
va
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"NONE" [Exp x
t] [Annotation]
_ -> do
      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 (Int
1, Int
0, Int
1)
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
      pure $ TypeAnn -> VarAnn -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
NONE TypeAnn
ta VarAnn
va Ty
t'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"UNIT" [] [Annotation]
_ ->
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
          va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      in 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 (Int
1, Int
0, 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 -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> InstrAbstract op
UNIT TypeAnn
ta VarAnn
va
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"IF_NONE" [Exp x
ops1, Exp x
ops2] [] -> do
      [op]
ops1' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops1
      [op]
ops2' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops2
      pure $ [op] -> [op] -> InstrAbstract op
forall op. [op] -> [op] -> InstrAbstract op
IF_NONE [op]
ops1' [op]
ops2'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"PAIR" [] [Annotation]
_ ->
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
          va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
          fa1 :: FieldAnn
fa1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
          fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
      in (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 (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 op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"UNPAIR" [] [Annotation]
_ ->
      let va1 :: VarAnn
va1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
          va2 :: VarAnn
va2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @VarTag AnnotationSet
annSet
          fa1 :: FieldAnn
fa1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
          fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
      in 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 (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 op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
UNPAIR VarAnn
va1 VarAnn
va2 FieldAnn
fa1 FieldAnn
fa2
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"PAIR" [Exp x
n] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
1)
      Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Word -> InstrAbstract op
forall op. VarAnn -> Word -> InstrAbstract op
PAIRN VarAnn
va Word
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"UNPAIR" [Exp x
n] [] -> do
      Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      pure $ Word -> InstrAbstract op
forall op. Word -> InstrAbstract op
UNPAIRN Word
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"CAR" [] [Annotation]
_ ->
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
          fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      in 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 (Int
0, Int
1, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> FieldAnn -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
va FieldAnn
fa
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"CDR" [] [Annotation]
_ ->
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
          fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      in 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 (Int
0, Int
1, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> FieldAnn -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
va FieldAnn
fa
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"LEFT" [Exp x
t] [Annotation]
_ -> do
      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 (Int
1, Int
2, Int
1)
      Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let fa1 :: FieldAnn
fa1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      let fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract op
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract op
LEFT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
t'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"RIGHT" [Exp x
t] [Annotation]
_ -> do
      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 (Int
1, Int
2, Int
1)
      Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let fa1 :: FieldAnn
fa1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      let fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract op
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract op
RIGHT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
t'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"IF_LEFT" [Exp x
ops1, Exp x
ops2] [] -> do
      [op]
ops1' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops1
      [op]
ops2' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops2
      pure $ [op] -> [op] -> InstrAbstract op
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT [op]
ops1' [op]
ops2'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"NIL" [Exp x
t] [Annotation]
_ -> do
      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 (Int
1, Int
0, Int
1)
      Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
NIL TypeAnn
ta VarAnn
va Ty
t'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"CONS" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
CONS [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"IF_CONS" [Exp x
ops1, Exp x
ops2] [] -> do
      [op]
ops1' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops1
      [op]
ops2' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops2
      pure $ [op] -> [op] -> InstrAbstract op
forall op. [op] -> [op] -> InstrAbstract op
IF_CONS [op]
ops1' [op]
ops2'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SIZE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SIZE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"EMPTY_SET" [Exp x
t] [Annotation]
_ -> do
      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 (Int
1, Int
0, Int
1)
      Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
EMPTY_SET TypeAnn
ta VarAnn
va Ty
t'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"EMPTY_MAP" [Exp x
kt, Exp x
vt] [Annotation]
_ -> do
      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 (Int
1, Int
0, Int
1)
      Ty
kt' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
kt
      Ty
vt' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
vt
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
EMPTY_MAP TypeAnn
ta VarAnn
va Ty
kt' Ty
vt'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"EMPTY_BIG_MAP" [Exp x
kt, Exp x
vt] [Annotation]
_ -> do
      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 (Int
1, Int
0, Int
1)
      Ty
kt' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
kt
      Ty
vt' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
vt
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
EMPTY_BIG_MAP TypeAnn
ta VarAnn
va Ty
kt' Ty
vt'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"MAP" [Exp x
ops] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
1)
      [op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> [op] -> InstrAbstract op
forall op. VarAnn -> [op] -> InstrAbstract op
MAP VarAnn
va [op]
ops'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"ITER" [Exp x
ops] [] -> do
      [op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
      pure $ [op] -> InstrAbstract op
forall op. [op] -> InstrAbstract op
ITER [op]
ops'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"MEM" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
MEM [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"GET" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
GET [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"GET" [Exp x
n] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
1)
      Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Word -> InstrAbstract op
forall op. VarAnn -> Word -> InstrAbstract op
GETN VarAnn
va Word
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"UPDATE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
UPDATE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"UPDATE" [Exp x
n] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
1)
      Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Word -> InstrAbstract op
forall op. VarAnn -> Word -> InstrAbstract op
UPDATEN VarAnn
va Word
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"GET_AND_UPDATE" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
GET_AND_UPDATE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"IF" [Exp x
ops1, Exp x
ops2] [] -> do
      [op]
ops1' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops1
      [op]
ops2' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops2
      pure $ [op] -> [op] -> InstrAbstract op
forall op. [op] -> [op] -> InstrAbstract op
IF [op]
ops1' [op]
ops2'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"LOOP" [Exp x
ops] [] -> do
      [op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
      pure $ [op] -> InstrAbstract op
forall op. [op] -> InstrAbstract op
LOOP [op]
ops'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"LOOP_LEFT" [Exp x
ops] [] -> do
      [op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
      pure $ [op] -> InstrAbstract op
forall op. [op] -> InstrAbstract op
LOOP_LEFT [op]
ops'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"LAMBDA" [Exp x
inp, Exp x
out, Exp x
ops] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
1)
      Ty
inp' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
inp
      Ty
out' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
out
      [op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
forall op. VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
LAMBDA VarAnn
va Ty
inp' Ty
out' [op]
ops'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"LAMBDA_REC" [Exp x
inp, Exp x
out, Exp x
ops] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
1)
      Ty
inp' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
inp
      Ty
out' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
out
      [op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
forall op. VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
LAMBDA_REC VarAnn
va Ty
inp' Ty
out' [op]
ops'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"EXEC" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
EXEC [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"APPLY" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
APPLY [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"DIP" [Exp x
ops] [] -> do
      [op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
      pure $ [op] -> InstrAbstract op
forall op. [op] -> InstrAbstract op
DIP [op]
ops'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"DIP" [Exp x
n, Exp x
ops] [] -> do
      Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      [op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
      pure $ Word -> [op] -> InstrAbstract op
forall op. Word -> [op] -> InstrAbstract op
DIPN Word
n' [op]
ops'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"FAILWITH" [] [] -> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstrAbstract op
forall op. InstrAbstract op
FAILWITH
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"CAST" [Exp x
t] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
1)
      Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Ty -> InstrAbstract op
forall op. VarAnn -> Ty -> InstrAbstract op
CAST VarAnn
va Ty
t'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"RENAME" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
RENAME [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"PACK" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
PACK [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"UNPACK" [Exp x
t] [Annotation]
_ -> do
      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 (Int
1, Int
0, Int
1)
      Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
      let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
UNPACK TypeAnn
ta VarAnn
va Ty
t'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"CONCAT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
CONCAT [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SLICE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SLICE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"ISNAT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
ISNAT [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"ADD" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
ADD [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SUB" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SUB [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SUB_MUTEZ" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SUB_MUTEZ [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"MUL" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
MUL [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"EDIV" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
EDIV [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"ABS" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
ABS [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"NEG" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
NEG [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"LSL" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
LSL [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"LSR" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
LSR [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"OR" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
OR [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"AND" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
AND [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"XOR" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
XOR [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"NOT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
NOT [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"COMPARE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
COMPARE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"EQ" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
Untyped.EQ [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"NEQ" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
NEQ [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"LT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
Untyped.LT [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"GT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
Untyped.GT [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"LE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
LE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"GE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
GE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"INT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
INT [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"VIEW" [Exp x
name, Exp x
t] [Annotation]
_ -> do
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      ViewName
name' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @ViewName Exp x
name
      Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
      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 (Int
0, Int
0, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> ViewName -> Ty -> InstrAbstract op
forall op. VarAnn -> ViewName -> Ty -> InstrAbstract op
VIEW VarAnn
va ViewName
name' Ty
t'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SELF" [] [Annotation]
_ ->
      let fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
          va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      in 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 (Int
0, Int
1, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> FieldAnn -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> InstrAbstract op
SELF VarAnn
va FieldAnn
fa
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"CONTRACT" [Exp x
t] [Annotation]
_ -> do
      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 (Int
0, Int
1, Int
1)
      Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      pure $ VarAnn -> FieldAnn -> Ty -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> Ty -> InstrAbstract op
CONTRACT VarAnn
va FieldAnn
fa Ty
t'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"TRANSFER_TOKENS" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
TRANSFER_TOKENS [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SET_DELEGATE" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SET_DELEGATE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"CREATE_CONTRACT" [Exp x
c] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
2)
      Contract' op
c' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @(Untyped.Contract' op) Exp x
c
      let va1 :: VarAnn
va1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let va2 :: VarAnn
va2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> VarAnn -> Contract' op -> InstrAbstract op
forall op. VarAnn -> VarAnn -> Contract' op -> InstrAbstract op
CREATE_CONTRACT VarAnn
va1 VarAnn
va2 Contract' op
c'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"IMPLICIT_ACCOUNT" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
IMPLICIT_ACCOUNT [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"NOW" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
NOW [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"AMOUNT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
AMOUNT [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"BALANCE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
BALANCE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"VOTING_POWER" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
VOTING_POWER [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"TOTAL_VOTING_POWER" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
TOTAL_VOTING_POWER [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"CHECK_SIGNATURE" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
CHECK_SIGNATURE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SHA256" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SHA256 [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SHA512" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SHA512 [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"BLAKE2B" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
BLAKE2B [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SHA3" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SHA3 [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"KECCAK" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
KECCAK [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"HASH_KEY" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
HASH_KEY [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"PAIRING_CHECK" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
PAIRING_CHECK [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SOURCE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SOURCE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SENDER" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SENDER [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"ADDRESS" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
ADDRESS [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"CHAIN_ID" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
CHAIN_ID [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"LEVEL" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
LEVEL [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SELF_ADDRESS" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SELF_ADDRESS [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"NEVER" [] [] -> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstrAbstract op
forall op. InstrAbstract op
NEVER
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"TICKET_DEPRECATED" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
TICKET_DEPRECATED [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"TICKET" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
TICKET [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"READ_TICKET" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
READ_TICKET [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SPLIT_TICKET" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SPLIT_TICKET [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"JOIN_TICKETS" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
JOIN_TICKETS [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"OPEN_CHEST" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
OPEN_CHEST [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SAPLING_EMPTY_STATE" [Exp x
n] [Annotation]
_ -> do
      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 (Int
0, Int
0, Int
1)
      Natural
n' <- Exp x -> Either (FromExpError x) Natural
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Natural -> InstrAbstract op
forall op. VarAnn -> Natural -> InstrAbstract op
SAPLING_EMPTY_STATE VarAnn
va Natural
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"SAPLING_VERIFY_UPDATE" [] [Annotation]
anns ->
      (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SAPLING_VERIFY_UPDATE [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"MIN_BLOCK_TIME" [] [Annotation]
anns -> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
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
$ ([AnyAnn] -> InstrAbstract op) -> [Annotation] -> InstrAbstract op
mkInstrWithAnyAnns [AnyAnn] -> InstrAbstract op
forall op. [AnyAnn] -> InstrAbstract op
MIN_BLOCK_TIME [Annotation]
anns
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"EMIT" [Exp x]
mty [Annotation]
_ -> do
      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 (Int
0, Int
1, Int
1)
      let tag :: FieldAnn
tag = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
          va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      Maybe Ty
ty' <- Either (FromExpError x) (Maybe Ty)
-> (Exp x -> Either (FromExpError x) (Maybe Ty))
-> Maybe (Exp x)
-> Either (FromExpError x) (Maybe Ty)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Ty -> Either (FromExpError x) (Maybe Ty)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Ty
forall a. Maybe a
Nothing) ((Ty -> Maybe Ty)
-> Either (FromExpError x) Ty -> Either (FromExpError x) (Maybe Ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ty -> Maybe Ty
forall a. a -> Maybe a
Just (Either (FromExpError x) Ty -> Either (FromExpError x) (Maybe Ty))
-> (Exp x -> Either (FromExpError x) Ty)
-> Exp x
-> Either (FromExpError x) (Maybe Ty)
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 @Ty) (Maybe (Exp x) -> Either (FromExpError x) (Maybe Ty))
-> Maybe (Exp x) -> Either (FromExpError x) (Maybe Ty)
forall a b. (a -> b) -> a -> b
$ [Exp x] -> Maybe (Exp x)
forall a. [a] -> Maybe a
listToMaybe [Exp x]
mty
      pure $ VarAnn -> FieldAnn -> Maybe Ty -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> Maybe Ty -> InstrAbstract op
EMIT VarAnn
va FieldAnn
tag Maybe Ty
ty'
    Exp x
_ -> 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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected an instruction"

    where
      mkInstrWithVarAnn
        :: (VarAnn -> InstrAbstract op)
        -> [Annotation]
        -> Either (FromExpError x) (InstrAbstract op)
      mkInstrWithVarAnn :: (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
ctor [Annotation]
anns =
        let annSet :: AnnotationSet
annSet = [Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns
            va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
        in 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 (Int
0, Int
0, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> InstrAbstract op
ctor VarAnn
va

      mkInstrWithAnyAnns
        :: ([Untyped.AnyAnn] -> InstrAbstract op)
        -> [Annotation]
        -> InstrAbstract op
      mkInstrWithAnyAnns :: ([AnyAnn] -> InstrAbstract op) -> [Annotation] -> InstrAbstract op
mkInstrWithAnyAnns [AnyAnn] -> InstrAbstract op
ctor [Annotation]
anns = [AnyAnn] -> InstrAbstract op
ctor ([AnyAnn] -> InstrAbstract op) -> [AnyAnn] -> InstrAbstract op
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

      getAnnSet :: Exp d -> AnnotationSet
      getAnnSet :: forall (d :: ExpExtensionDescriptorKind). Exp d -> AnnotationSet
getAnnSet = \case
        ExpPrim' XExpPrim d
_ MichelinePrimitive
_ [Exp d]
_ [Annotation]
anns -> [Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns
        Exp d
_                   -> AnnotationSet
emptyAnnSet

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)
mapM Exp x -> Either (FromExpError x) (ContractBlock op)
exprToCB [Exp x]
bs
      FromExpError x
-> Maybe (Contract' op) -> Either (FromExpError x) (Contract' op)
forall l r. l -> Maybe r -> Either l r
maybeToRight (Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
blocks Text
"Something's wrong with top-level contract blocks")
        ([ContractBlock op] -> Maybe (Contract' op)
forall op. [ContractBlock op] -> Maybe (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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
expr Text
"Failed to parse contract, expected sequence"
    where
      exprToCB
        :: Exp x
        -> Either (FromExpError x) (ContractBlock op)
      exprToCB :: Exp x -> Either (FromExpError x) (ContractBlock op)
exprToCB Exp x
e = case Exp x
e of
        ExpPrim' XExpPrim x
_ MichelinePrimitive
"parameter" [Exp x]
args [Annotation]
anns -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCbParam Exp x
e [Exp x]
args [Annotation]
anns
        ExpPrim' XExpPrim x
_ MichelinePrimitive
"storage"   [Exp x]
args [Annotation]
anns -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBStorage Exp x
e [Exp x]
args [Annotation]
anns
        ExpPrim' XExpPrim x
_ MichelinePrimitive
"code"      [Exp x]
args [Annotation]
anns -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBCode Exp x
e [Exp x]
args [Annotation]
anns
        ExpPrim' XExpPrim x
_ MichelinePrimitive
"view"      [Exp x]
args [Annotation]
anns -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBView Exp x
e [Exp x]
args [Annotation]
anns
        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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Unexpected primitive at contract top-level"

      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 = case ([Exp x]
args, [Annotation]
anns) 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 (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_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
_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).
Lens' (MichelinePrimAp x) [Annotation]
mpaAnnotsL)
          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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
p
              Text
"Expected parameter with at most 1 root annotation"
          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 (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_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
_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).
Lens' (MichelinePrimAp x) [Annotation]
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
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], [Annotation])
_ -> 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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
          Text
"Expected 'parameter' block without annotations and exactly 1 argument"

      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 = case ([Exp x]
args, [Annotation]
anns) of
        ([Exp x
s], []) -> do
          Ty
s' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
s
          pure $ Ty -> ContractBlock op
forall op. Ty -> ContractBlock op
CBStorage Ty
s'
        ([Exp x], [Annotation])
_ -> 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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
               Text
"Expected 'storage' block without annotations and exactly 1 argument"

      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 = case ([Exp x]
args, [Annotation]
anns) of
        ([Exp x
ops], []) -> do
          [op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
          pure $ [op] -> ContractBlock op
forall op. [op] -> ContractBlock op
CBCode [op]
ops'
        ([Exp x], [Annotation])
_ -> 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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
               Text
"Expected 'code' block without annotations"

      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 = case ([Exp x]
args, [Annotation]
anns) of
        ([Exp x
name, Exp x
arg, Exp x
ret, Exp x
ops], []) -> do
          ViewName
name' <- Exp x -> Either (FromExpError x) ViewName
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
name
          Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
          Ty
ret' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
ret
          [op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
          pure $ View' op -> ContractBlock op
forall op. View' op -> ContractBlock op
CBView (View' op -> ContractBlock op) -> View' op -> ContractBlock op
forall a b. (a -> b) -> a -> b
$ ViewName -> Ty -> Ty -> [op] -> View' op
forall op. ViewName -> Ty -> Ty -> [op] -> View' op
Untyped.View ViewName
name' Ty
arg' Ty
ret' [op]
ops'
        ([Exp x]
_, Annotation
_ : [Annotation]
_) ->
          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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
               Text
"Expected 'view' block without annotations"
        ([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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
               Text
"Invalid 'view' block, expected 4 expressions in it"

instance FromExp x Untyped.T where
  fromExp :: Exp x -> Either (FromExpError x) T
fromExp Exp x
e = case Exp x
e of
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"key" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TKey
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"unit" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TUnit
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"signature" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TSignature
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"chain_id" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TChainId
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"option" [Exp x
arg] [] -> do
      Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
      pure $ Ty -> T
Untyped.TOption Ty
arg'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"list" [Exp x
arg] [] -> do
      Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
      pure $ Ty -> T
Untyped.TList Ty
arg'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"set" [Exp x
arg] [] -> do
      Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
      pure $ Ty -> T
Untyped.TSet Ty
arg'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"operation" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TOperation
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"contract" [Exp x
arg] [] -> do
      Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
      pure $ Ty -> T
Untyped.TContract Ty
arg'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"ticket" [Exp x
arg] [] -> do
      Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
      pure $ Ty -> T
Untyped.TTicket Ty
arg'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"or" [Exp x
arg1, Exp x
arg2] [] -> 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 (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_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
_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).
Lens' (MichelinePrimAp x) [Annotation]
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 (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_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
_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).
Lens' (MichelinePrimAp x) [Annotation]
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
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"pair" [Exp x]
args [] -> 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 (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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
          Text
"Expected a pair with at least 2 arguments"
        Just NonEmpty (Exp x)
as -> NonEmpty (Exp x) -> Either (FromExpError x) (NonEmpty (Exp x))
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 (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_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
_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).
Lens' (MichelinePrimAp x) [Annotation]
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 (m :: * -> *) a. Monad m => a -> m a
return T
tRes
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"lambda" [Exp x]
args [] -> (Ty -> Ty -> T)
-> [Exp x] -> Exp x -> Text -> Either (FromExpError x) T
mkDoubleParamType Ty -> Ty -> T
Untyped.TLambda [Exp x]
args Exp x
e
      Text
"Expected a lambda with input and output types"
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"map" [Exp x]
args [] -> (Ty -> Ty -> T)
-> [Exp x] -> Exp x -> Text -> Either (FromExpError x) T
mkDoubleParamType Ty -> Ty -> T
Untyped.TMap [Exp x]
args Exp x
e
      Text
"Expected a map with key and value types"
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"big_map" [Exp x]
args [] -> (Ty -> Ty -> T)
-> [Exp x] -> Exp x -> Text -> Either (FromExpError x) T
mkDoubleParamType Ty -> Ty -> T
Untyped.TBigMap [Exp x]
args Exp x
e
      Text
"Expected a big_map with key and value types"
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"int" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TInt
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"nat" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TNat
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"string" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TString
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"bytes" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBytes
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"mutez" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TMutez
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"bool" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBool
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"key_hash" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TKeyHash
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"bls12_381_fr" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBls12381Fr
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"bls12_381_g1" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBls12381G1
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"bls12_381_g2" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBls12381G2
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"timestamp" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TTimestamp
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"address" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TAddress
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"chest" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TChest
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"chest_key" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TChestKey
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"tx_rollup_l2_address" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TTxRollupL2Address
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"never" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TNever
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"sapling_state" [Exp x
n] [] -> do
      Natural
n' <- Exp x -> Either (FromExpError x) Natural
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      pure $ Natural -> T
Untyped.TSaplingState Natural
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"sapling_transaction" [Exp x
n] [] -> do
      Natural
n' <- Exp x -> Either (FromExpError x) Natural
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
      pure $ Natural -> T
Untyped.TSaplingTransaction Natural
n'
    ExpPrim' XExpPrim x
_ MichelinePrimitive
"sapling_transaction_deprecated" [Exp x]
_ [Annotation]
_ -> do
      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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Use of deprecated type: sapling_transaction_deprecated"
    Exp x
_ -> 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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected a type"
    where
      mkDoubleParamType
        :: (Ty -> Ty -> Untyped.T)
        -> [Exp x]
        -> Exp x
        -> Text
        -> Either (FromExpError x) Untyped.T
      mkDoubleParamType :: (Ty -> Ty -> T)
-> [Exp x] -> Exp x -> Text -> Either (FromExpError x) T
mkDoubleParamType Ty -> Ty -> T
ctor [Exp x]
args Exp x
expr Text
msg = do
        case [Exp x]
args of
          [Exp x
arg1, Exp x
arg2] -> do
            Ty
arg1' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg1
            Ty
arg2' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg2
            pure $ Ty -> Ty -> T
ctor Ty
arg1' Ty
arg2'
          [Exp x]
_ -> 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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
expr Text
msg

      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 (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_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
_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).
Lens' (MichelinePrimAp x) [Annotation]
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
not (Bool -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Bool
p)

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
      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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
          Text
"Expected expression with at most 1 type annotation"
      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
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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected a type"

instance FromExp x T where
  fromExp :: Exp x -> Either (FromExpError x) T
fromExp =
    (Ty -> T)
-> Either (FromExpError x) Ty -> Either (FromExpError x) T
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 (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 (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]
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 -> Text -> FromExpressionError
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Expression
expr
        Text
"Expected block of code, found 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 (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e (Text -> FromExpError x)
-> (BadViewNameError -> Text) -> BadViewNameError -> FromExpError x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BadViewNameError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) (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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected view name"

----------------------------------------------------------------------------
-- 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 (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_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
_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).
Lens' (MichelinePrimAp x) [Annotation]
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, FromBuilder 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) =
  let actualCount :: (Int, Int, Int)
actualCount@(Int
tasCnt, Int
fasCnt, Int
vasCnt) = AnnotationSet -> (Int, Int, Int)
annsCount AnnotationSet
annSet
  in 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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e (Text -> FromExpError x) -> Text -> FromExpError x
forall a b. (a -> b) -> a -> b
$ Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
      [ Builder
"Expected at most"
      , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
maxTas Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" type annotations,"
      , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
maxFas Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" field annotations,"
      , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
maxVas Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" variable annotations"
      , Builder
"but found:"
      , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
tasCnt Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" type annotations,"
      , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
fasCnt Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" field annotations,"
      , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
vasCnt Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" variable annotations."
      ]

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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Value is out of bounds")
      (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 -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected a number here"