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

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

import Control.Lens ((<>~))
import Data.Bits (toIntegralSized)
import Data.Default
import Data.Singletons (SingI(..), demote)
import Fmt (Buildable(..), indentF, pretty, unlinesF)

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

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

instance forall t . (SingI t, 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). (SingI 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
PrimExpr Text
"Unit" [] []
    Value
Untyped.ValueTrue -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"True" [] []
    Value
Untyped.ValueFalse -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"False" [] []
    Untyped.ValuePair Value
l Value
r ->
      Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr Text
"Left" [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
    Untyped.ValueRight Value
v -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"Right" [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
    Untyped.ValueSome Value
v -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"Some" [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
    Value
Untyped.ValueNone -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
    where
      eltToExpr :: Untyped.Elt ExpandedOp -> Expression
      eltToExpr :: Elt ExpandedOp -> Expression
eltToExpr (Untyped.Elt Value
l Value
r) = Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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 SingI t => 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). SingI x => Notes x -> Ty
mkUType

instance ToExpression Untyped.T where
  toExpression :: T -> Expression
toExpression = \case
    T
Untyped.TKey -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"key" [] []
    T
Untyped.TUnit -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"unit" [] []
    T
Untyped.TSignature -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"signature" [] []
    T
Untyped.TChainId -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"chain_id" [] []
    Untyped.TOption Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"option" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    Untyped.TList Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"list" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    Untyped.TSet Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"set" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    T
Untyped.TOperation -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"operation" [] []
    Untyped.TContract Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"contract" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    Untyped.TTicket Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"ticket" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
    t :: T
t@Untyped.TPair{} -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"pair"
      (Ty -> (FieldAnn, VarAnn) -> [Expression]
rightCombedPairToList (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)) []
    Untyped.TOr FieldAnn
fa1 FieldAnn
fa2 Ty
l Ty
r ->
      let exprL :: Expression
exprL = Expression -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Expression
addTrimmedAnns (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
l) [] [FieldAnn
fa1] []
          exprR :: Expression
exprR = Expression -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Expression
addTrimmedAnns (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
r) [] [FieldAnn
fa2] []
      in Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"or" [Expression
exprL, Expression
exprR] []
    Untyped.TLambda Ty
inp Ty
out ->
      Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr Text
"int" [] []
    T
Untyped.TNat -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"nat" [] []
    T
Untyped.TString -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"string" [] []
    T
Untyped.TBytes -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"bytes" [] []
    T
Untyped.TMutez -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"mutez" [] []
    T
Untyped.TBool -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"bool" [] []
    T
Untyped.TKeyHash -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"key_hash" [] []
    T
Untyped.TBls12381Fr -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"bls12_381_fr" [] []
    T
Untyped.TBls12381G1 -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"bls12_381_g1" [] []
    T
Untyped.TBls12381G2 -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"bls12_381_g2" [] []
    T
Untyped.TTimestamp -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"timestamp" [] []
    T
Untyped.TAddress -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"address" [] []
    T
Untyped.TNever -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"never" [] []

    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 -> Identity MichelinePrimAp)
-> Expression -> Identity Expression
Prism' Expression MichelinePrimAp
_ExpressionPrim ((MichelinePrimAp -> Identity MichelinePrimAp)
 -> Expression -> Identity Expression)
-> (([Annotation] -> Identity [Annotation])
    -> MichelinePrimAp -> Identity MichelinePrimAp)
-> ([Annotation] -> Identity [Annotation])
-> Expression
-> Identity Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp -> Identity MichelinePrimAp
Lens' MichelinePrimAp [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 :: Ty -> (FieldAnn, VarAnn) -> [Expression]
      rightCombedPairToList :: Ty -> (FieldAnn, VarAnn) -> [Expression]
rightCombedPairToList Ty
ty (FieldAnn
fa, VarAnn
va) = case (Ty
ty, FieldAnn
fa) of
        (Ty (Untyped.TPair FieldAnn
fa1 FieldAnn
fa2 VarAnn
va1 VarAnn
va2 Ty
l Ty
r) (Untyped.Annotation Text
""), Untyped.Annotation Text
"") ->
          let annsL :: [Annotation]
annsL = [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa1] [VarAnn
va1]
              exprL :: Expression
exprL = Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
l Expression -> [Annotation] -> Expression
`addAnns` [Annotation]
annsL
          in Expression
exprL Expression -> [Expression] -> [Expression]
forall a. a -> [a] -> [a]
: (Ty -> (FieldAnn, VarAnn) -> [Expression]
rightCombedPairToList Ty
r (FieldAnn
fa2, VarAnn
va2))
        (Ty, FieldAnn)
_ ->
          let anns :: [Annotation]
anns = [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
          in 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` [Annotation]
anns

instance ToExpression Ty where
  toExpression :: Ty -> Expression
toExpression (Ty T
t TypeAnn
ta) = Expression -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Expression
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 InstrCallStack
_ ExpandedOp
op -> ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression ExpandedOp
op

instance ToExpression ExpandedInstr where
  toExpression :: ExpandedInstr -> Expression
toExpression = \case
    PUSH VarAnn
va Ty
ty Value
v -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr Text
"DROP" [] []
    DROPN Word
n -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"DROP" [Word -> Expression
wordToExpr Word
n] []
    DUP VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr Text
"DUP" [Word -> Expression
wordToExpr 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
PrimExpr Text
"SWAP" [] []
    DIG Word
n -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"DIG" [Word -> Expression
wordToExpr Word
n] []
    DUG Word
n -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"DUG" [Word -> Expression
wordToExpr Word
n] []
    SOME TypeAnn
ta VarAnn
va ->
      Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr Text
"PAIR" [Word -> Expression
wordToExpr 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
PrimExpr Text
"UNPAIR" [Word -> Expression
wordToExpr Word
n] []
    CAR VarAnn
va FieldAnn
fa -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr Text
"ITER" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    MEM VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr 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
PrimExpr Text
"GET" [Word -> Expression
wordToExpr 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
PrimExpr 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
PrimExpr Text
"UPDATE" [Word -> Expression
wordToExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr Text
"LOOP" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    LOOP_LEFT [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr 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]
    EXEC VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr 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
PrimExpr Text
"DIP" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    DIPN Word
n [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"DIP" [Word -> Expression
wordToExpr Word
n, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
    ExpandedInstr
FAILWITH -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"FAILWITH" [] []
    CAST VarAnn
va Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr Text
"SUB" [] ([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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr Text
"INT" [] ([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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr 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
PrimExpr Text
"TICKET" [] ([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
PrimExpr 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
PrimExpr 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
PrimExpr Text
"JOIN_TICKETS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
    ExpandedInstr
NEVER -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"NEVER" [] []
    EXT ExtInstrAbstract ExpandedOp
_ -> [Expression] -> Expression
ExpressionSeq []
    where
      wordToExpr :: Word -> Expression
      wordToExpr :: Word -> Expression
wordToExpr = ToExpression (Value 'TInt) => Value 'TInt -> Expression
forall a. ToExpression a => a -> Expression
toExpression @(Value 'TInt) (Value 'TInt -> Expression)
-> (Word -> Value 'TInt) -> Word -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Value 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt (Integer -> Value 'TInt)
-> (Word -> Integer) -> Word -> Value 'TInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral Word, Num Integer) => Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Integer

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)
-> [Expression]
forall op a.
Contract' op
-> (ParameterType -> a) -> (Ty -> a) -> ([op] -> a) -> [a]
Untyped.mapEntriesOrdered Contract' ExpandedOp
contract
          (\(Untyped.ParameterType Ty
ty FieldAnn
rootAnn) -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr 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
PrimExpr Text
"storage" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
storage] [])
          (\[ExpandedOp]
code -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
"code" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
code] [])

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

-- | Errors that can happen when we convert an 'Expression' to our
-- data type.
data FromExpressionError = FromExpressionError Expression Text
  deriving stock (Int -> FromExpressionError -> ShowS
[FromExpressionError] -> ShowS
FromExpressionError -> String
(Int -> FromExpressionError -> ShowS)
-> (FromExpressionError -> String)
-> ([FromExpressionError] -> ShowS)
-> Show FromExpressionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromExpressionError] -> ShowS
$cshowList :: [FromExpressionError] -> ShowS
show :: FromExpressionError -> String
$cshow :: FromExpressionError -> String
showsPrec :: Int -> FromExpressionError -> ShowS
$cshowsPrec :: Int -> FromExpressionError -> ShowS
Show, FromExpressionError -> FromExpressionError -> Bool
(FromExpressionError -> FromExpressionError -> Bool)
-> (FromExpressionError -> FromExpressionError -> Bool)
-> Eq FromExpressionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromExpressionError -> FromExpressionError -> Bool
$c/= :: FromExpressionError -> FromExpressionError -> Bool
== :: FromExpressionError -> FromExpressionError -> Bool
$c== :: FromExpressionError -> FromExpressionError -> Bool
Eq)

instance Buildable FromExpressionError where
  build :: FromExpressionError -> Builder
build (FromExpressionError 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 FromExpression a where
  fromExpression :: Expression -> Either FromExpressionError a

instance (SingI t) => FromExpression (Value t) where
  fromExpression :: Expression -> Either FromExpressionError (Value t)
fromExpression Expression
expr =
    case Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Untyped.Value Expression
expr of
    Right Value
uv -> case Value -> Either TCError (Value t)
typeCheck Value
uv of
      Left TCError
tcErr -> FromExpressionError -> Either FromExpressionError (Value t)
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError (Value t))
-> FromExpressionError -> Either FromExpressionError (Value t)
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
expr (Text -> FromExpressionError) -> Text -> FromExpressionError
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
$ (SingKind T, SingI t) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @t
          , Builder
""
          , Builder
"Typechecker error:"
          , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ TCError -> Builder
forall p. Buildable p => p -> Builder
build TCError
tcErr
          ]
      Right Value t
tv -> Value t -> Either FromExpressionError (Value t)
forall a b. b -> Either a b
Right Value t
tv
    Left FromExpressionError
e -> FromExpressionError -> Either FromExpressionError (Value t)
forall a b. a -> Either a b
Left FromExpressionError
e
    where
      typeCheck :: Value -> Either TCError (Value t)
typeCheck Value
uv = TypeCheckOptions
-> TypeCheckResult (Value t) -> Either TCError (Value t)
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith (Bool -> Bool -> TypeCheckOptions
TypeCheckOptions Bool
False Bool
False) (TypeCheckResult (Value t) -> Either TCError (Value t))
-> TypeCheckResult (Value t) -> Either TCError (Value t)
forall a b. (a -> b) -> a -> b
$
        (TypeCheckMode -> TypeCheck (Value t) -> TypeCheckResult (Value t)
forall a. TypeCheckMode -> TypeCheck a -> TypeCheckResult a
runTypeCheck (TypeCheckMode -> TypeCheck (Value t) -> TypeCheckResult (Value t))
-> TypeCheckMode
-> TypeCheck (Value t)
-> TypeCheckResult (Value t)
forall a b. (a -> b) -> a -> b
$ (Value, T) -> TypeCheckMode
TypeCheckValue (Value
uv, (SingKind T, SingI t) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @t)) (TypeCheck (Value t) -> TypeCheckResult (Value t))
-> TypeCheck (Value t) -> TypeCheckResult (Value t)
forall a b. (a -> b) -> a -> b
$
        InstrCallStack
-> ReaderT InstrCallStack TypeCheck (Value t)
-> TypeCheck (Value t)
forall r (m :: * -> *) a. r -> ReaderT r m a -> m a
usingReaderT InstrCallStack
forall a. Default a => a
def (ReaderT InstrCallStack TypeCheck (Value t) -> TypeCheck (Value t))
-> ReaderT InstrCallStack TypeCheck (Value t)
-> TypeCheck (Value t)
forall a b. (a -> b) -> a -> b
$
        Value -> ReaderT InstrCallStack TypeCheck (Value t)
forall (t :: T). SingI t => Value -> TypeCheckInstr (Value t)
typeCheckValue Value
uv

instance FromExpression Untyped.Value where
  fromExpression :: Expression -> Either FromExpressionError Value
fromExpression Expression
e = case Expression
e of
    ExpressionInt Integer
v -> Value -> Either FromExpressionError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either FromExpressionError Value)
-> Value -> Either FromExpressionError Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
forall op. Integer -> Value' op
Untyped.ValueInt Integer
v
    ExpressionString Text
s -> (Text -> FromExpressionError)
-> Either Text Value -> Either FromExpressionError Value
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Expression -> Text -> FromExpressionError
FromExpressionError Expression
e)
      (MText -> Value
forall op. MText -> Value' op
Untyped.ValueString (MText -> Value) -> Either Text MText -> Either Text Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text MText
mkMText Text
s)
    ExpressionBytes ByteString
bs -> Value -> Either FromExpressionError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either FromExpressionError Value)
-> Value -> Either FromExpressionError Value
forall a b. (a -> b) -> a -> b
$ InternalByteString -> Value
forall op. InternalByteString -> Value' op
Untyped.ValueBytes (InternalByteString -> Value) -> InternalByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> InternalByteString
Untyped.InternalByteString ByteString
bs
    PrimExpr Text
"Unit" [] [] -> Value -> Either FromExpressionError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
forall op. Value' op
Untyped.ValueUnit
    PrimExpr Text
"True" [] [] -> Value -> Either FromExpressionError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
forall op. Value' op
Untyped.ValueTrue
    PrimExpr Text
"False" [] [] -> Value -> Either FromExpressionError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
forall op. Value' op
Untyped.ValueFalse
    PrimExpr Text
"Pair" [Expression
l, Expression
r] [] -> do
      Value
l' <- Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
l
      Value
r' <- Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
r
      pure $ Value -> Value -> Value
forall op. Value' op -> Value' op -> Value' op
Untyped.ValuePair Value
l' Value
r'
    PrimExpr Text
"Pair" [Expression]
args [] ->
      case ([Expression] -> Maybe (NonEmpty Expression)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Expression]
args) Maybe (NonEmpty Expression)
-> (NonEmpty Expression -> Maybe (NonEmpty Expression))
-> Maybe (NonEmpty Expression)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NonEmpty Expression -> Maybe (NonEmpty Expression)
forall a. NonEmpty a -> Maybe (NonEmpty a)
forbidSingletonList of
        Maybe (NonEmpty Expression)
Nothing -> FromExpressionError -> Either FromExpressionError Value
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError Value)
-> FromExpressionError -> Either FromExpressionError Value
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e
          Text
"Expected a pair with at least 2 arguments"
        Just NonEmpty Expression
args' -> Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression (Expression -> Either FromExpressionError Value)
-> Expression -> Either FromExpressionError Value
forall a b. (a -> b) -> a -> b
$ NonEmpty Expression -> Text -> Expression
seqToPairExpr NonEmpty Expression
args' Text
"Pair"
    PrimExpr Text
"Left" [Expression
arg] [] -> do
      Value
arg' <- Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
arg
      pure $ Value -> Value
forall op. Value' op -> Value' op
Untyped.ValueLeft Value
arg'
    PrimExpr Text
"Right" [Expression
arg] [] -> do
      Value
arg' <- Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
arg
      pure $ Value -> Value
forall op. Value' op -> Value' op
Untyped.ValueRight Value
arg'
    PrimExpr Text
"Some" [Expression
arg] [] -> do
      Value
arg' <- Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
arg
      pure $ Value -> Value
forall op. Value' op -> Value' op
Untyped.ValueSome Value
arg'
    PrimExpr Text
"None" [] [] -> Value -> Either FromExpressionError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
forall op. Value' op
Untyped.ValueNone
    ExpressionSeq [] -> Value -> Either FromExpressionError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
forall op. Value' op
Untyped.ValueNil
    ExpressionSeq (Expression
h : [Expression]
t) ->
      case Expression -> Either FromExpressionError ExpandedOp
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Untyped.ExpandedOp Expression
h of
      Right ExpandedOp
op -> do
        [ExpandedOp]
ops <- (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 (FromExpression ExpandedOp =>
Expression -> Either FromExpressionError ExpandedOp
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Untyped.ExpandedOp) [Expression]
t
        Value -> Either FromExpressionError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either FromExpressionError Value)
-> (NonEmpty ExpandedOp -> Value)
-> NonEmpty ExpandedOp
-> Either FromExpressionError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ExpandedOp -> Value
forall op. NonEmpty op -> Value' op
Untyped.ValueLambda (NonEmpty ExpandedOp -> Either FromExpressionError Value)
-> NonEmpty ExpandedOp -> Either FromExpressionError Value
forall a b. (a -> b) -> a -> b
$ ExpandedOp
op ExpandedOp -> [ExpandedOp] -> NonEmpty ExpandedOp
forall a. a -> [a] -> NonEmpty a
:| [ExpandedOp]
ops
      Left FromExpressionError
_ -> case Expression -> Either FromExpressionError (Elt ExpandedOp)
exprToElt Expression
h of
        Right Elt ExpandedOp
elt -> do
          [Elt ExpandedOp]
elts <- (Expression -> Either FromExpressionError (Elt ExpandedOp))
-> [Expression] -> Either FromExpressionError [Elt ExpandedOp]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expression -> Either FromExpressionError (Elt ExpandedOp)
exprToElt [Expression]
t
          Value -> Either FromExpressionError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either FromExpressionError Value)
-> ((NonEmpty $ Elt ExpandedOp) -> Value)
-> (NonEmpty $ Elt ExpandedOp)
-> Either FromExpressionError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty $ Elt ExpandedOp) -> Value
forall op. (NonEmpty $ Elt op) -> Value' op
Untyped.ValueMap ((NonEmpty $ Elt ExpandedOp) -> Either FromExpressionError Value)
-> (NonEmpty $ Elt ExpandedOp) -> Either FromExpressionError Value
forall a b. (a -> b) -> a -> b
$ Elt ExpandedOp
elt Elt ExpandedOp -> [Elt ExpandedOp] -> NonEmpty $ Elt ExpandedOp
forall a. a -> [a] -> NonEmpty a
:| [Elt ExpandedOp]
elts
        Left FromExpressionError
_ -> case Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
h of
          Left (FromExpressionError Expression
err Text
_) -> FromExpressionError -> Either FromExpressionError Value
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError Value)
-> FromExpressionError -> Either FromExpressionError Value
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
err
            Text
"Value, instruction or 'Elt' expression expected"
          Right Value
h' -> do
            [Value]
t' <- (Expression -> Either FromExpressionError Value)
-> [Expression] -> Either FromExpressionError [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression [Expression]
t
            Value -> Either FromExpressionError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either FromExpressionError Value)
-> ((NonEmpty $ Value) -> Value)
-> (NonEmpty $ Value)
-> Either FromExpressionError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty $ Value) -> Value
forall op. (NonEmpty $ Value' op) -> Value' op
Untyped.ValueSeq ((NonEmpty $ Value) -> Either FromExpressionError Value)
-> (NonEmpty $ Value) -> Either FromExpressionError Value
forall a b. (a -> b) -> a -> b
$ Value
h' Value -> [Value] -> NonEmpty $ Value
forall a. a -> [a] -> NonEmpty a
:| [Value]
t'
    Expression
_ -> FromExpressionError -> Either FromExpressionError Value
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError Value)
-> FromExpressionError -> Either FromExpressionError Value
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e Text
"Expected a value"
    where
      exprToElt :: Expression -> Either FromExpressionError (Untyped.Elt ExpandedOp)
      exprToElt :: Expression -> Either FromExpressionError (Elt ExpandedOp)
exprToElt Expression
ex = case Expression
ex of
        PrimExpr Text
"Elt" [Expression
l, Expression
r] [] -> do
          Value
l' <- Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
l
          Value
r' <- Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
r
          pure $ Value -> Value -> Elt ExpandedOp
forall op. Value' op -> Value' op -> Elt op
Untyped.Elt Value
l' Value
r'
        PrimExpr Text
"Elt" [Expression]
_ [] -> FromExpressionError -> Either FromExpressionError (Elt ExpandedOp)
forall a b. a -> Either a b
Left (FromExpressionError
 -> Either FromExpressionError (Elt ExpandedOp))
-> FromExpressionError
-> Either FromExpressionError (Elt ExpandedOp)
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
ex
          Text
"Expected 'Elt' expression with exactly 2 elements"
        PrimExpr Text
"Elt" [Expression]
_ [Annotation]
_ -> FromExpressionError -> Either FromExpressionError (Elt ExpandedOp)
forall a b. a -> Either a b
Left (FromExpressionError
 -> Either FromExpressionError (Elt ExpandedOp))
-> FromExpressionError
-> Either FromExpressionError (Elt ExpandedOp)
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
ex
          Text
"Expected 'Elt' expression without annotations"
        Expression
_ -> FromExpressionError -> Either FromExpressionError (Elt ExpandedOp)
forall a b. a -> Either a b
Left (FromExpressionError
 -> Either FromExpressionError (Elt ExpandedOp))
-> FromExpressionError
-> Either FromExpressionError (Elt ExpandedOp)
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
ex Text
"Expected 'Elt' expression"

instance (FromExpression a) => FromExpression [a] where
  fromExpression :: Expression -> Either FromExpressionError [a]
fromExpression = \case
    ExpressionSeq [Expression]
exprs -> (Expression -> Either FromExpressionError a)
-> [Expression] -> Either FromExpressionError [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expression -> Either FromExpressionError a
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression [Expression]
exprs
    Expression
e -> FromExpressionError -> Either FromExpressionError [a]
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError [a])
-> FromExpressionError -> Either FromExpressionError [a]
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e Text
"'ExpressionSeq' expected"

instance FromExpression ExpandedOp where
  fromExpression :: Expression -> Either FromExpressionError ExpandedOp
fromExpression = \case
    ExpressionSeq [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 a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression [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 a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
e

instance FromExpression ExpandedInstr where
  fromExpression :: Expression -> Either FromExpressionError ExpandedInstr
fromExpression Expression
e = let annSet :: AnnotationSet
annSet = Expression -> AnnotationSet
getAnnSet Expression
e in case Expression
e of
    PrimExpr Text
"DROP" [Expression
n] [] -> do
      Word
n' <- Expression -> Either FromExpressionError Word
intExprToWord Expression
n
      pure $ Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
DROPN Word
n'
    PrimExpr Text
"DROP" [] [Annotation]
_ -> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpandedInstr -> Either FromExpressionError ExpandedInstr)
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall a b. (a -> b) -> a -> b
$ ExpandedInstr
forall op. InstrAbstract op
DROP
    PrimExpr Text
"DUP" [Expression
n] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      Word
n' <- Expression -> Either FromExpressionError Word
intExprToWord Expression
n
      pure $ VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
DUPN VarAnn
va Word
n'
    PrimExpr Text
"DUP" [] [Annotation]
_ ->
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      in Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
1) Either FromExpressionError ()
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
va
    PrimExpr Text
"SWAP" [] [] -> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpandedInstr -> Either FromExpressionError ExpandedInstr)
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall a b. (a -> b) -> a -> b
$ ExpandedInstr
forall op. InstrAbstract op
SWAP
    PrimExpr Text
"DIG" [Expression
n] [] -> do
      Word
n' <- Expression -> Either FromExpressionError Word
intExprToWord Expression
n
      pure $ Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
DIG (Word -> ExpandedInstr) -> Word -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ Word
n'
    PrimExpr Text
"DUG" [Expression
n] [] -> do
      Word
n' <- Expression -> Either FromExpressionError Word
intExprToWord Expression
n
      pure $ Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
DUG Word
n'
    PrimExpr Text
"PUSH" [Expression
t, Expression
v] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      Ty
t' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
t
      Value
v' <- Expression -> Either FromExpressionError Value
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Untyped.Value Expression
v
      pure $ VarAnn -> Ty -> Value -> ExpandedInstr
forall op. VarAnn -> Ty -> Value' op -> InstrAbstract op
PUSH VarAnn
va Ty
t' Value
v'
    PrimExpr Text
"SOME" [] [Annotation]
_ ->
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
          va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      in Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
0, Int
1) Either FromExpressionError ()
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
SOME TypeAnn
ta VarAnn
va
    PrimExpr Text
"NONE" [Expression
t] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      Ty
t' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
t
      pure $ TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
NONE TypeAnn
ta VarAnn
va Ty
t'
    PrimExpr Text
"UNIT" [] [Annotation]
_ ->
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
          va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      in Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
0, Int
1) Either FromExpressionError ()
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
UNIT TypeAnn
ta VarAnn
va
    PrimExpr Text
"IF_NONE" [Expression
ops1, Expression
ops2] [] -> do
      [ExpandedOp]
ops1' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops1
      [ExpandedOp]
ops2' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops2
      pure $ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_NONE [ExpandedOp]
ops1' [ExpandedOp]
ops2'
    PrimExpr Text
"PAIR" [] [Annotation]
_ ->
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
          va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
          fa1 :: FieldAnn
fa1 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
          fa2 :: FieldAnn
fa2 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
      in (Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
2, Int
1)) Either FromExpressionError ()
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2
    PrimExpr Text
"UNPAIR" [] [Annotation]
_ ->
      let va1 :: VarAnn
va1 = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
          va2 :: VarAnn
va2 = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @VarTag AnnotationSet
annSet
          fa1 :: FieldAnn
fa1 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
          fa2 :: FieldAnn
fa2 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
      in Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
2, Int
2) Either FromExpressionError ()
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
UNPAIR VarAnn
va1 VarAnn
va2 FieldAnn
fa1 FieldAnn
fa2
    PrimExpr Text
"PAIR" [Expression
n] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
      Word
n' <- Expression -> Either FromExpressionError Word
intExprToWord Expression
n
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
PAIRN VarAnn
va Word
n'
    PrimExpr Text
"UNPAIR" [Expression
n] [] -> do
      Word
n' <- Expression -> Either FromExpressionError Word
intExprToWord Expression
n
      pure $ Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
UNPAIRN Word
n'
    PrimExpr Text
"CAR" [] [Annotation]
_ ->
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
          fa :: FieldAnn
fa = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      in Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
1, Int
1) Either FromExpressionError ()
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
va FieldAnn
fa
    PrimExpr Text
"CDR" [] [Annotation]
_ ->
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
          fa :: FieldAnn
fa = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      in Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
1, Int
1) Either FromExpressionError ()
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
va FieldAnn
fa
    PrimExpr Text
"LEFT" [Expression
t] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
2, Int
1)
      Ty
t' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
t
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let fa1 :: FieldAnn
fa1 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      let fa2 :: FieldAnn
fa2 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract op
LEFT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
t'
    PrimExpr Text
"RIGHT" [Expression
t] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
2, Int
1)
      Ty
t' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
t
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let fa1 :: FieldAnn
fa1 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      let fa2 :: FieldAnn
fa2 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract op
RIGHT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
t'
    PrimExpr Text
"IF_LEFT" [Expression
ops1, Expression
ops2] [] -> do
      [ExpandedOp]
ops1' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops1
      [ExpandedOp]
ops2' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops2
      pure $ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT [ExpandedOp]
ops1' [ExpandedOp]
ops2'
    PrimExpr Text
"NIL" [Expression
t] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
      Ty
t' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
t
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
NIL TypeAnn
ta VarAnn
va Ty
t'
    PrimExpr Text
"CONS" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
CONS [Annotation]
anns
    PrimExpr Text
"IF_CONS" [Expression
ops1, Expression
ops2] [] -> do
      [ExpandedOp]
ops1' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops1
      [ExpandedOp]
ops2' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops2
      pure $ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_CONS [ExpandedOp]
ops1' [ExpandedOp]
ops2'
    PrimExpr Text
"SIZE" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SIZE [Annotation]
anns
    PrimExpr Text
"EMPTY_SET" [Expression
t] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
      Ty
t' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
t
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
EMPTY_SET TypeAnn
ta VarAnn
va Ty
t'
    PrimExpr Text
"EMPTY_MAP" [Expression
kt, Expression
vt] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
      Ty
kt' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
kt
      Ty
vt' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
vt
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> Ty -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
EMPTY_MAP TypeAnn
ta VarAnn
va Ty
kt' Ty
vt'
    PrimExpr Text
"EMPTY_BIG_MAP" [Expression
kt, Expression
vt] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
      Ty
kt' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
kt
      Ty
vt' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
vt
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> Ty -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
EMPTY_BIG_MAP TypeAnn
ta VarAnn
va Ty
kt' Ty
vt'
    PrimExpr Text
"MAP" [Expression
ops] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
      [ExpandedOp]
ops' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> [op] -> InstrAbstract op
MAP VarAnn
va [ExpandedOp]
ops'
    PrimExpr Text
"ITER" [Expression
ops] [] -> do
      [ExpandedOp]
ops' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops
      pure $ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
ITER [ExpandedOp]
ops'
    PrimExpr Text
"MEM" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
MEM [Annotation]
anns
    PrimExpr Text
"GET" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
GET [Annotation]
anns
    PrimExpr Text
"GET" [Expression
n] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
      Word
n' <- Expression -> Either FromExpressionError Word
intExprToWord Expression
n
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
GETN VarAnn
va Word
n'
    PrimExpr Text
"UPDATE" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
UPDATE [Annotation]
anns
    PrimExpr Text
"UPDATE" [Expression
n] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
      Word
n' <- Expression -> Either FromExpressionError Word
intExprToWord Expression
n
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
UPDATEN VarAnn
va Word
n'
    PrimExpr Text
"GET_AND_UPDATE" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
GET_AND_UPDATE [Annotation]
anns
    PrimExpr Text
"IF" [Expression
ops1, Expression
ops2] [] -> do
      [ExpandedOp]
ops1' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops1
      [ExpandedOp]
ops2' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops2
      pure $ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF [ExpandedOp]
ops1' [ExpandedOp]
ops2'
    PrimExpr Text
"LOOP" [Expression
ops] [] -> do
      [ExpandedOp]
ops' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops
      pure $ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
LOOP [ExpandedOp]
ops'
    PrimExpr Text
"LOOP_LEFT" [Expression
ops] [] -> do
      [ExpandedOp]
ops' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops
      pure $ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
LOOP_LEFT [ExpandedOp]
ops'
    PrimExpr Text
"LAMBDA" [Expression
inp, Expression
out, Expression
ops] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
      Ty
inp' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
inp
      Ty
out' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
out
      [ExpandedOp]
ops' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Ty -> Ty -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
LAMBDA VarAnn
va Ty
inp' Ty
out' [ExpandedOp]
ops'
    PrimExpr Text
"EXEC" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
EXEC [Annotation]
anns
    PrimExpr Text
"APPLY" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
APPLY [Annotation]
anns
    PrimExpr Text
"DIP" [Expression
ops] [] -> do
      [ExpandedOp]
ops' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops
      pure $ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP [ExpandedOp]
ops'
    PrimExpr Text
"DIP" [Expression
n, Expression
ops] [] -> do
      Word
n' <- Expression -> Either FromExpressionError Word
intExprToWord Expression
n
      [ExpandedOp]
ops' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops
      pure $ Word -> [ExpandedOp] -> ExpandedInstr
forall op. Word -> [op] -> InstrAbstract op
DIPN Word
n' [ExpandedOp]
ops'
    PrimExpr Text
"FAILWITH" [] [] -> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExpandedInstr
forall op. InstrAbstract op
FAILWITH
    PrimExpr Text
"CAST" [Expression
t] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
      Ty
t' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
t
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> Ty -> ExpandedInstr
forall op. VarAnn -> Ty -> InstrAbstract op
CAST VarAnn
va Ty
t'
    PrimExpr Text
"RENAME" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
RENAME [Annotation]
anns
    PrimExpr Text
"PACK" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
PACK [Annotation]
anns
    PrimExpr Text
"UNPACK" [Expression
t] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
      Ty
t' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
t
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      pure $ TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
UNPACK TypeAnn
ta VarAnn
va Ty
t'
    PrimExpr Text
"CONCAT" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
CONCAT [Annotation]
anns
    PrimExpr Text
"SLICE" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SLICE [Annotation]
anns
    PrimExpr Text
"ISNAT" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
ISNAT [Annotation]
anns
    PrimExpr Text
"ADD" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
ADD [Annotation]
anns
    PrimExpr Text
"SUB" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SUB [Annotation]
anns
    PrimExpr Text
"MUL" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
MUL [Annotation]
anns
    PrimExpr Text
"EDIV" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
EDIV [Annotation]
anns
    PrimExpr Text
"ABS" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
ABS [Annotation]
anns
    PrimExpr Text
"NEG" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
NEG [Annotation]
anns
    PrimExpr Text
"LSL" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
LSL [Annotation]
anns
    PrimExpr Text
"LSR" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
LSR [Annotation]
anns
    PrimExpr Text
"OR" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
OR [Annotation]
anns
    PrimExpr Text
"AND" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
AND [Annotation]
anns
    PrimExpr Text
"XOR" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
XOR [Annotation]
anns
    PrimExpr Text
"NOT" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
NOT [Annotation]
anns
    PrimExpr Text
"COMPARE" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
COMPARE [Annotation]
anns
    PrimExpr Text
"EQ" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
Untyped.EQ [Annotation]
anns
    PrimExpr Text
"NEQ" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
NEQ [Annotation]
anns
    PrimExpr Text
"LT" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
Untyped.LT [Annotation]
anns
    PrimExpr Text
"GT" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
Untyped.GT [Annotation]
anns
    PrimExpr Text
"LE" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
LE [Annotation]
anns
    PrimExpr Text
"GE" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
GE [Annotation]
anns
    PrimExpr Text
"INT" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
INT [Annotation]
anns
    PrimExpr Text
"SELF" [] [Annotation]
_ ->
      let fa :: FieldAnn
fa = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
          va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      in Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
1, Int
1) Either FromExpressionError ()
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
SELF VarAnn
va FieldAnn
fa
    PrimExpr Text
"CONTRACT" [Expression
t] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
1, Int
1)
      Ty
t' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
t
      let va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let fa :: FieldAnn
fa = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
      pure $ VarAnn -> FieldAnn -> Ty -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> Ty -> InstrAbstract op
CONTRACT VarAnn
va FieldAnn
fa Ty
t'
    PrimExpr Text
"TRANSFER_TOKENS" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
TRANSFER_TOKENS [Annotation]
anns
    PrimExpr Text
"SET_DELEGATE" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SET_DELEGATE [Annotation]
anns
    PrimExpr Text
"CREATE_CONTRACT" [Expression
c] [Annotation]
_ -> do
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
2)
      Contract' ExpandedOp
c' <- Expression -> Either FromExpressionError (Contract' ExpandedOp)
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Untyped.Contract Expression
c
      let va1 :: VarAnn
va1 = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
      let va2 :: VarAnn
va2 = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @VarTag AnnotationSet
annSet
      pure $ VarAnn -> VarAnn -> Contract' ExpandedOp -> ExpandedInstr
forall op. VarAnn -> VarAnn -> Contract' op -> InstrAbstract op
CREATE_CONTRACT VarAnn
va1 VarAnn
va2 Contract' ExpandedOp
c'
    PrimExpr Text
"IMPLICIT_ACCOUNT" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
IMPLICIT_ACCOUNT [Annotation]
anns
    PrimExpr Text
"NOW" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
NOW [Annotation]
anns
    PrimExpr Text
"AMOUNT" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
AMOUNT [Annotation]
anns
    PrimExpr Text
"BALANCE" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
BALANCE [Annotation]
anns
    PrimExpr Text
"VOTING_POWER" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
VOTING_POWER [Annotation]
anns
    PrimExpr Text
"TOTAL_VOTING_POWER" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
TOTAL_VOTING_POWER [Annotation]
anns
    PrimExpr Text
"CHECK_SIGNATURE" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
CHECK_SIGNATURE [Annotation]
anns
    PrimExpr Text
"SHA256" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SHA256 [Annotation]
anns
    PrimExpr Text
"SHA512" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SHA512 [Annotation]
anns
    PrimExpr Text
"BLAKE2B" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
BLAKE2B [Annotation]
anns
    PrimExpr Text
"SHA3" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SHA3 [Annotation]
anns
    PrimExpr Text
"KECCAK" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
KECCAK [Annotation]
anns
    PrimExpr Text
"HASH_KEY" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
HASH_KEY [Annotation]
anns
    PrimExpr Text
"PAIRING_CHECK" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
PAIRING_CHECK [Annotation]
anns
    PrimExpr Text
"SOURCE" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SOURCE [Annotation]
anns
    PrimExpr Text
"SENDER" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SENDER [Annotation]
anns
    PrimExpr Text
"ADDRESS" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
ADDRESS [Annotation]
anns
    PrimExpr Text
"CHAIN_ID" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
CHAIN_ID [Annotation]
anns
    PrimExpr Text
"LEVEL" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
LEVEL [Annotation]
anns
    PrimExpr Text
"SELF_ADDRESS" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SELF_ADDRESS [Annotation]
anns
    PrimExpr Text
"NEVER" [] [] -> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExpandedInstr
forall op. InstrAbstract op
NEVER
    PrimExpr Text
"TICKET" [] [Annotation]
anns -> (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
TICKET [Annotation]
anns
    PrimExpr Text
"READ_TICKET" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
READ_TICKET [Annotation]
anns
    PrimExpr Text
"SPLIT_TICKET" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
SPLIT_TICKET [Annotation]
anns
    PrimExpr Text
"JOIN_TICKETS" [] [Annotation]
anns ->
      (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
JOIN_TICKETS [Annotation]
anns
    Expression
_ -> FromExpressionError -> Either FromExpressionError ExpandedInstr
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError ExpandedInstr)
-> FromExpressionError -> Either FromExpressionError ExpandedInstr
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e Text
"Expected an instruction"

    where
      intExprToWord :: Expression -> Either FromExpressionError Word
      intExprToWord :: Expression -> Either FromExpressionError Word
intExprToWord Expression
n = do
        Value 'TInt
v <- Expression -> Either FromExpressionError (Value 'TInt)
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @(Value 'TInt) Expression
n
        case Value 'TInt
v of
          VInt Integer
n' -> FromExpressionError
-> Maybe Word -> Either FromExpressionError Word
forall l r. l -> Maybe r -> Either l r
maybeToRight (Expression -> Text -> FromExpressionError
FromExpressionError Expression
n Text
"Value is out of bounds")
            (Integer -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized @Integer @Word Integer
n')

      mkInstrWithVarAnn
        :: (VarAnn -> ExpandedInstr)
        -> [Annotation]
        -> Either FromExpressionError ExpandedInstr
      mkInstrWithVarAnn :: (VarAnn -> ExpandedInstr)
-> [Annotation] -> Either FromExpressionError ExpandedInstr
mkInstrWithVarAnn VarAnn -> ExpandedInstr
ctor [Annotation]
anns =
        let annSet :: AnnotationSet
annSet = [Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns
            va :: VarAnn
va = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
        in Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
annSet (Int
0, Int
0, Int
1) Either FromExpressionError ()
-> ExpandedInstr -> Either FromExpressionError ExpandedInstr
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> ExpandedInstr
ctor VarAnn
va

      getAnnSet :: Expression -> AnnotationSet
      getAnnSet :: Expression -> AnnotationSet
getAnnSet = \case
        PrimExpr Text
_ [Expression]
_ [Annotation]
anns -> [Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns
        Expression
_                 -> AnnotationSet
emptyAnnSet

instance FromExpression Untyped.Contract where
  fromExpression :: Expression -> Either FromExpressionError (Contract' ExpandedOp)
fromExpression Expression
blocks = case Expression
blocks of
    ExpressionSeq [Expression
b1, Expression
b2, Expression
b3] -> do
      ContractBlock ExpandedOp
b1' <- Expression -> Either FromExpressionError (ContractBlock ExpandedOp)
exprToCB Expression
b1
      ContractBlock ExpandedOp
b2' <- Expression -> Either FromExpressionError (ContractBlock ExpandedOp)
exprToCB Expression
b2
      ContractBlock ExpandedOp
b3' <- Expression -> Either FromExpressionError (ContractBlock ExpandedOp)
exprToCB Expression
b3
      FromExpressionError
-> Maybe (Contract' ExpandedOp)
-> Either FromExpressionError (Contract' ExpandedOp)
forall l r. l -> Maybe r -> Either l r
maybeToRight (Expression -> Text -> FromExpressionError
FromExpressionError Expression
blocks Text
fullErrorMsg)
        ((ContractBlock ExpandedOp, ContractBlock ExpandedOp,
 ContractBlock ExpandedOp)
-> Maybe (Contract' ExpandedOp)
forall op.
(ContractBlock op, ContractBlock op, ContractBlock op)
-> Maybe (Contract' op)
orderContractBlock (ContractBlock ExpandedOp
b1', ContractBlock ExpandedOp
b2', ContractBlock ExpandedOp
b3'))
    Expression
expr -> FromExpressionError
-> Either FromExpressionError (Contract' ExpandedOp)
forall a b. a -> Either a b
Left (FromExpressionError
 -> Either FromExpressionError (Contract' ExpandedOp))
-> FromExpressionError
-> Either FromExpressionError (Contract' ExpandedOp)
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
expr Text
fullErrorMsg
    where
      exprToCB
        :: Expression
        -> Either FromExpressionError (ContractBlock ExpandedOp)
      exprToCB :: Expression -> Either FromExpressionError (ContractBlock ExpandedOp)
exprToCB Expression
e = case Expression
e of
        PrimExpr Text
"parameter" [Expression]
args [Annotation]
anns -> Expression
-> [Expression]
-> [Annotation]
-> Either FromExpressionError (ContractBlock ExpandedOp)
mkCbParam Expression
e [Expression]
args [Annotation]
anns
        PrimExpr Text
"storage"   [Expression]
args [Annotation]
anns -> Expression
-> [Expression]
-> [Annotation]
-> Either FromExpressionError (ContractBlock ExpandedOp)
mkCBStorage Expression
e [Expression]
args [Annotation]
anns
        PrimExpr Text
"code"      [Expression]
args [Annotation]
anns -> Expression
-> [Expression]
-> [Annotation]
-> Either FromExpressionError (ContractBlock ExpandedOp)
mkCBCode Expression
e [Expression]
args [Annotation]
anns
        Expression
_                              -> FromExpressionError
-> Either FromExpressionError (ContractBlock ExpandedOp)
forall a b. a -> Either a b
Left (FromExpressionError
 -> Either FromExpressionError (ContractBlock ExpandedOp))
-> FromExpressionError
-> Either FromExpressionError (ContractBlock ExpandedOp)
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e Text
fullErrorMsg

      mkCbParam
        :: Expression
        -> [Expression]
        -> [Annotation]
        -> Either FromExpressionError (ContractBlock ExpandedOp)
      mkCbParam :: Expression
-> [Expression]
-> [Annotation]
-> Either FromExpressionError (ContractBlock ExpandedOp)
mkCbParam Expression
e [Expression]
args [Annotation]
anns = case ([Expression]
args, [Annotation]
anns) of
        ([Expression
p], []) -> do
          let annSet :: AnnotationSet
annSet = [Annotation] -> AnnotationSet
toAnnSet (Expression
p Expression
-> Getting [Annotation] Expression [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. (MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
-> Expression -> Const [Annotation] Expression
Prism' Expression MichelinePrimAp
_ExpressionPrim ((MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
 -> Expression -> Const [Annotation] Expression)
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
-> Getting [Annotation] Expression [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp -> Const [Annotation] MichelinePrimAp
Lens' MichelinePrimAp [Annotation]
mpaAnnotsL)
          let rootAnn :: FieldAnn
rootAnn = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
          Bool
-> Either FromExpressionError () -> Either FromExpressionError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AnnotationSet -> FieldAnn
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 FromExpressionError () -> Either FromExpressionError ())
-> Either FromExpressionError () -> Either FromExpressionError ()
forall a b. (a -> b) -> a -> b
$
            FromExpressionError -> Either FromExpressionError ()
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError ())
-> FromExpressionError -> Either FromExpressionError ()
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
p
              Text
"Expected parameter with at most 1 root annotation"
          Ty
p' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty
            (Expression
p Expression -> (Expression -> Expression) -> Expression
forall a b. a -> (a -> b) -> b
& (MichelinePrimAp -> Identity MichelinePrimAp)
-> Expression -> Identity Expression
Prism' Expression MichelinePrimAp
_ExpressionPrim ((MichelinePrimAp -> Identity MichelinePrimAp)
 -> Expression -> Identity Expression)
-> (([Annotation] -> Identity [Annotation])
    -> MichelinePrimAp -> Identity MichelinePrimAp)
-> ([Annotation] -> Identity [Annotation])
-> Expression
-> Identity Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp -> Identity MichelinePrimAp
Lens' MichelinePrimAp [Annotation]
mpaAnnotsL (([Annotation] -> Identity [Annotation])
 -> Expression -> Identity Expression)
-> ([Annotation] -> [Annotation]) -> Expression -> Expression
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 ExpandedOp
forall op. ParameterType -> ContractBlock op
CBParam (ParameterType -> ContractBlock ExpandedOp)
-> ParameterType -> ContractBlock ExpandedOp
forall a b. (a -> b) -> a -> b
$ Ty -> FieldAnn -> ParameterType
Untyped.ParameterType Ty
p' FieldAnn
rootAnn
        ([Expression], [Annotation])
_ -> FromExpressionError
-> Either FromExpressionError (ContractBlock ExpandedOp)
forall a b. a -> Either a b
Left (FromExpressionError
 -> Either FromExpressionError (ContractBlock ExpandedOp))
-> FromExpressionError
-> Either FromExpressionError (ContractBlock ExpandedOp)
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e
          Text
"Expected 'parameter' block without annotations and exactly 1 argument"

      mkCBStorage
        :: Expression
        -> [Expression]
        -> [Annotation]
        -> Either FromExpressionError (ContractBlock ExpandedOp)
      mkCBStorage :: Expression
-> [Expression]
-> [Annotation]
-> Either FromExpressionError (ContractBlock ExpandedOp)
mkCBStorage Expression
e [Expression]
args [Annotation]
anns = case ([Expression]
args, [Annotation]
anns) of
        ([Expression
s], []) -> do
          Ty
s' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Ty Expression
s
          pure $ Ty -> ContractBlock ExpandedOp
forall op. Ty -> ContractBlock op
CBStorage Ty
s'
        ([Expression], [Annotation])
_ -> FromExpressionError
-> Either FromExpressionError (ContractBlock ExpandedOp)
forall a b. a -> Either a b
Left (FromExpressionError
 -> Either FromExpressionError (ContractBlock ExpandedOp))
-> FromExpressionError
-> Either FromExpressionError (ContractBlock ExpandedOp)
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e
               Text
"Expected 'storage' block without annotations and exactly 1 argument"

      mkCBCode
        :: Expression
        -> [Expression]
        -> [Annotation]
        -> Either FromExpressionError (ContractBlock ExpandedOp)
      mkCBCode :: Expression
-> [Expression]
-> [Annotation]
-> Either FromExpressionError (ContractBlock ExpandedOp)
mkCBCode Expression
e [Expression]
args [Annotation]
anns = case ([Expression]
args, [Annotation]
anns) of
        ([Expression
ops], []) -> do
          [ExpandedOp]
ops' <- Expression -> Either FromExpressionError [ExpandedOp]
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @([ExpandedOp]) Expression
ops
          pure $ [ExpandedOp] -> ContractBlock ExpandedOp
forall op. [op] -> ContractBlock op
CBCode [ExpandedOp]
ops'
        ([Expression], [Annotation])
_ -> FromExpressionError
-> Either FromExpressionError (ContractBlock ExpandedOp)
forall a b. a -> Either a b
Left (FromExpressionError
 -> Either FromExpressionError (ContractBlock ExpandedOp))
-> FromExpressionError
-> Either FromExpressionError (ContractBlock ExpandedOp)
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e
               Text
"Expected 'code' block without annotations"

      fullErrorMsg :: Text
fullErrorMsg = Text
"Expected contract expression to have exactly 3 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"sub-expressions ('parameter', 'storage' and 'code')"


instance FromExpression Untyped.T where
  fromExpression :: Expression -> Either FromExpressionError T
fromExpression Expression
e = case Expression
e of
    PrimExpr Text
"key" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TKey
    PrimExpr Text
"unit" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TUnit
    PrimExpr Text
"signature" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TSignature
    PrimExpr Text
"chain_id" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TChainId
    PrimExpr Text
"option" [Expression
arg] [] -> do
      Ty
arg' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
arg
      pure $ Ty -> T
Untyped.TOption Ty
arg'
    PrimExpr Text
"list" [Expression
arg] [] -> do
      Ty
arg' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
arg
      pure $ Ty -> T
Untyped.TList Ty
arg'
    PrimExpr Text
"set" [Expression
arg] [] -> do
      Ty
arg' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
arg
      pure $ Ty -> T
Untyped.TSet Ty
arg'
    PrimExpr Text
"operation" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TOperation
    PrimExpr Text
"contract" [Expression
arg] [] -> do
      Ty
arg' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
arg
      pure $ Ty -> T
Untyped.TContract Ty
arg'
    PrimExpr Text
"ticket" [Expression
arg] [] -> do
      Ty
arg' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
arg
      pure $ Ty -> T
Untyped.TTicket Ty
arg'
    PrimExpr Text
"or" [Expression
arg1, Expression
arg2] [] -> do
      let as1 :: AnnotationSet
as1 = [Annotation] -> AnnotationSet
toAnnSet ([Annotation] -> AnnotationSet) -> [Annotation] -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ Expression
arg1 Expression
-> Getting [Annotation] Expression [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. (MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
-> Expression -> Const [Annotation] Expression
Prism' Expression MichelinePrimAp
_ExpressionPrim ((MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
 -> Expression -> Const [Annotation] Expression)
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
-> Getting [Annotation] Expression [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp -> Const [Annotation] MichelinePrimAp
Lens' MichelinePrimAp [Annotation]
mpaAnnotsL
      let as2 :: AnnotationSet
as2 = [Annotation] -> AnnotationSet
toAnnSet ([Annotation] -> AnnotationSet) -> [Annotation] -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ Expression
arg2 Expression
-> Getting [Annotation] Expression [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. (MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
-> Expression -> Const [Annotation] Expression
Prism' Expression MichelinePrimAp
_ExpressionPrim ((MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
 -> Expression -> Const [Annotation] Expression)
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
-> Getting [Annotation] Expression [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp -> Const [Annotation] MichelinePrimAp
Lens' MichelinePrimAp [Annotation]
mpaAnnotsL
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
as1 (Int
1, Int
1, Int
0)
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
as2 (Int
1, Int
1, Int
0)
      let fa1 :: FieldAnn
fa1 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
as1
      let fa2 :: FieldAnn
fa2 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
as2
      Ty
l <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression (Expression -> Either FromExpressionError Ty)
-> Expression -> Either FromExpressionError Ty
forall a b. (a -> b) -> a -> b
$ Expression -> (Annotation -> Bool) -> Expression
removeAnns Expression
arg1 Annotation -> Bool
isAnnotationField
      Ty
r <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression (Expression -> Either FromExpressionError Ty)
-> Expression -> Either FromExpressionError Ty
forall a b. (a -> b) -> a -> b
$ Expression -> (Annotation -> Bool) -> Expression
removeAnns Expression
arg2 Annotation -> Bool
isAnnotationField
      pure $ FieldAnn -> FieldAnn -> Ty -> Ty -> T
Untyped.TOr FieldAnn
fa1 FieldAnn
fa2 Ty
l Ty
r
    PrimExpr Text
"pair" [Expression
arg1, Expression
arg2] [] -> do
      let as1 :: AnnotationSet
as1 = [Annotation] -> AnnotationSet
toAnnSet ([Annotation] -> AnnotationSet) -> [Annotation] -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ Expression
arg1 Expression
-> Getting [Annotation] Expression [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. (MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
-> Expression -> Const [Annotation] Expression
Prism' Expression MichelinePrimAp
_ExpressionPrim ((MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
 -> Expression -> Const [Annotation] Expression)
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
-> Getting [Annotation] Expression [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp -> Const [Annotation] MichelinePrimAp
Lens' MichelinePrimAp [Annotation]
mpaAnnotsL
      let as2 :: AnnotationSet
as2 = [Annotation] -> AnnotationSet
toAnnSet ([Annotation] -> AnnotationSet) -> [Annotation] -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ Expression
arg2 Expression
-> Getting [Annotation] Expression [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. (MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
-> Expression -> Const [Annotation] Expression
Prism' Expression MichelinePrimAp
_ExpressionPrim ((MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
 -> Expression -> Const [Annotation] Expression)
-> (([Annotation] -> Const [Annotation] [Annotation])
    -> MichelinePrimAp -> Const [Annotation] MichelinePrimAp)
-> Getting [Annotation] Expression [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp -> Const [Annotation] MichelinePrimAp
Lens' MichelinePrimAp [Annotation]
mpaAnnotsL
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
as1 (Int
1, Int
1, Int
1)
      Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
e AnnotationSet
as2 (Int
1, Int
1, Int
1)
      let fa1 :: FieldAnn
fa1 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
as1
      let fa2 :: FieldAnn
fa2 = AnnotationSet -> FieldAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
as2
      let va1 :: VarAnn
va1 = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
as1
      let va2 :: VarAnn
va2 = AnnotationSet -> VarAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
as2
      Ty
l <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression (Expression -> Either FromExpressionError Ty)
-> Expression -> Either FromExpressionError Ty
forall a b. (a -> b) -> a -> b
$ Expression -> (Annotation -> Bool) -> Expression
removeAnns Expression
arg1
        (Annotation -> Bool
isAnnotationField (Annotation -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall a. Boolean a => a -> a -> a
|| Annotation -> Bool
isAnnotationVariable)
      Ty
r <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression (Expression -> Either FromExpressionError Ty)
-> Expression -> Either FromExpressionError Ty
forall a b. (a -> b) -> a -> b
$ Expression -> (Annotation -> Bool) -> Expression
removeAnns Expression
arg2
        (Annotation -> Bool
isAnnotationField (Annotation -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall a. Boolean a => a -> a -> a
|| Annotation -> Bool
isAnnotationVariable)
      pure $ FieldAnn -> FieldAnn -> VarAnn -> VarAnn -> Ty -> Ty -> T
Untyped.TPair FieldAnn
fa1 FieldAnn
fa2 VarAnn
va1 VarAnn
va2 Ty
l Ty
r
    PrimExpr Text
"pair" [Expression]
args [] ->
      case ([Expression] -> Maybe (NonEmpty Expression)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Expression]
args) Maybe (NonEmpty Expression)
-> (NonEmpty Expression -> Maybe (NonEmpty Expression))
-> Maybe (NonEmpty Expression)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NonEmpty Expression -> Maybe (NonEmpty Expression)
forall a. NonEmpty a -> Maybe (NonEmpty a)
forbidSingletonList of
        Maybe (NonEmpty Expression)
Nothing -> FromExpressionError -> Either FromExpressionError T
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError T)
-> FromExpressionError -> Either FromExpressionError T
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e
          Text
"Expected a pair with at least 2 arguments"
        Just NonEmpty Expression
args' -> Expression -> Either FromExpressionError T
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression (Expression -> Either FromExpressionError T)
-> Expression -> Either FromExpressionError T
forall a b. (a -> b) -> a -> b
$ NonEmpty Expression -> Text -> Expression
seqToPairExpr NonEmpty Expression
args' Text
"pair"
    PrimExpr Text
"lambda" [Expression]
args [] -> (Ty -> Ty -> T)
-> [Expression]
-> Expression
-> Text
-> Either FromExpressionError T
mkDoubleParamType Ty -> Ty -> T
Untyped.TLambda [Expression]
args Expression
e
      Text
"Expected a lambda with input and output types"
    PrimExpr Text
"map" [Expression]
args [] -> (Ty -> Ty -> T)
-> [Expression]
-> Expression
-> Text
-> Either FromExpressionError T
mkDoubleParamType Ty -> Ty -> T
Untyped.TMap [Expression]
args Expression
e
      Text
"Expected a map with key and value types"
    PrimExpr Text
"big_map" [Expression]
args [] -> (Ty -> Ty -> T)
-> [Expression]
-> Expression
-> Text
-> Either FromExpressionError T
mkDoubleParamType Ty -> Ty -> T
Untyped.TBigMap [Expression]
args Expression
e
      Text
"Expected a big_map with key and value types"
    PrimExpr Text
"int" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TInt
    PrimExpr Text
"nat" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TNat
    PrimExpr Text
"string" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TString
    PrimExpr Text
"bytes" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBytes
    PrimExpr Text
"mutez" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TMutez
    PrimExpr Text
"bool" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBool
    PrimExpr Text
"key_hash" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TKeyHash
    PrimExpr Text
"bls12_381_fr" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBls12381Fr
    PrimExpr Text
"bls12_381_g1" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBls12381G1
    PrimExpr Text
"bls12_381_g2" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBls12381G2
    PrimExpr Text
"timestamp" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TTimestamp
    PrimExpr Text
"address" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TAddress
    PrimExpr Text
"never" [] [] -> T -> Either FromExpressionError T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TNever
    Expression
_ -> FromExpressionError -> Either FromExpressionError T
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError T)
-> FromExpressionError -> Either FromExpressionError T
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e Text
"Expected a type"
    where
      mkDoubleParamType
        :: (Ty -> Ty -> Untyped.T)
        -> [Expression]
        -> Expression
        -> Text
        -> Either FromExpressionError Untyped.T
      mkDoubleParamType :: (Ty -> Ty -> T)
-> [Expression]
-> Expression
-> Text
-> Either FromExpressionError T
mkDoubleParamType Ty -> Ty -> T
ctor [Expression]
args Expression
expr Text
msg = do
        case [Expression]
args of
          [Expression
arg1, Expression
arg2] -> do
            Ty
arg1' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
arg1
            Ty
arg2' <- Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression Expression
arg2
            pure $ Ty -> Ty -> T
ctor Ty
arg1' Ty
arg2'
          [Expression]
_ -> FromExpressionError -> Either FromExpressionError T
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError T)
-> FromExpressionError -> Either FromExpressionError T
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
expr Text
msg

      removeAnns :: Expression -> (Annotation -> Bool) -> Expression
      removeAnns :: Expression -> (Annotation -> Bool) -> Expression
removeAnns Expression
expr Annotation -> Bool
p =
        Expression
expr Expression -> (Expression -> Expression) -> Expression
forall a b. a -> (a -> b) -> b
& (MichelinePrimAp -> Identity MichelinePrimAp)
-> Expression -> Identity Expression
Prism' Expression MichelinePrimAp
_ExpressionPrim ((MichelinePrimAp -> Identity MichelinePrimAp)
 -> Expression -> Identity Expression)
-> (([Annotation] -> Identity [Annotation])
    -> MichelinePrimAp -> Identity MichelinePrimAp)
-> ([Annotation] -> Identity [Annotation])
-> Expression
-> Identity Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp -> Identity MichelinePrimAp
Lens' MichelinePrimAp [Annotation]
mpaAnnotsL (([Annotation] -> Identity [Annotation])
 -> Expression -> Identity Expression)
-> ([Annotation] -> [Annotation]) -> Expression -> Expression
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 FromExpression Ty where
  fromExpression :: Expression -> Either FromExpressionError Ty
fromExpression Expression
e = case Expression
e of
    PrimExpr Text
primName [Expression]
args [Annotation]
anns -> do
      let annSet :: AnnotationSet
annSet = [Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns
      let ta :: TypeAnn
ta = AnnotationSet -> TypeAnn
forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
      Bool
-> Either FromExpressionError () -> Either FromExpressionError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AnnotationSet -> TypeAnn
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 FromExpressionError () -> Either FromExpressionError ())
-> Either FromExpressionError () -> Either FromExpressionError ()
forall a b. (a -> b) -> a -> b
$
        FromExpressionError -> Either FromExpressionError ()
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError ())
-> FromExpressionError -> Either FromExpressionError ()
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e
          Text
"Expected expression with at most 1 type annotation"
      T
t <- FromExpression T => Expression -> Either FromExpressionError T
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @Untyped.T (Expression -> Either FromExpressionError T)
-> Expression -> Either FromExpressionError T
forall a b. (a -> b) -> a -> b
$ Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
primName [Expression]
args ([Annotation] -> Expression) -> [Annotation] -> Expression
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
    Expression
_ -> FromExpressionError -> Either FromExpressionError Ty
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError Ty)
-> FromExpressionError -> Either FromExpressionError Ty
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e Text
"Expected a type"

instance FromExpression T where
  fromExpression :: Expression -> Either FromExpressionError T
fromExpression =
    (Ty -> T)
-> Either FromExpressionError Ty -> Either FromExpressionError T
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Ty -> T
fromUType (Either FromExpressionError Ty -> Either FromExpressionError T)
-> (Expression -> Either FromExpressionError Ty)
-> Expression
-> Either FromExpressionError T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromExpression Ty => Expression -> Either FromExpressionError Ty
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @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) => FromExpression (Instr '[inp] '[out]) where
  fromExpression :: Expression -> Either FromExpressionError (Instr '[inp] '[out])
fromExpression Expression
expr =
    Expression -> Either FromExpressionError (Value ('TLambda inp out))
forall a.
FromExpression a =>
Expression -> Either FromExpressionError a
fromExpression @(Value ('TLambda inp out)) Expression
expr Either FromExpressionError (Value ('TLambda inp out))
-> (Value ('TLambda inp out) -> Instr '[inp] '[out])
-> Either FromExpressionError (Instr '[inp] '[out])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      VLam RemFail Instr '[inp] '[out]
instr -> 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

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

-- | Converts a sequence of expression to the right combed pair.
seqToPairExpr :: NonEmpty Expression -> Text -> Expression
seqToPairExpr :: NonEmpty Expression -> Text -> Expression
seqToPairExpr NonEmpty Expression
e Text
name = (Element (NonEmpty Expression)
 -> Element (NonEmpty Expression) -> Element (NonEmpty Expression))
-> NonEmpty Expression -> Element (NonEmpty Expression)
forall t.
Container t =>
(Element t -> Element t -> Element t) -> t -> Element t
foldr1 (\Element (NonEmpty Expression)
x Element (NonEmpty Expression)
xs -> Text -> [Expression] -> [Annotation] -> Expression
PrimExpr Text
name [Element (NonEmpty Expression)
Expression
x, Element (NonEmpty Expression)
Expression
xs] []) NonEmpty Expression
e

-- | Adds annotations to the expression, after removing empty annotations
-- at the end of each list.
addTrimmedAnns
  :: Expression
  -> [TypeAnn]
  -> [FieldAnn]
  -> [VarAnn]
  -> Expression
addTrimmedAnns :: Expression -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Expression
addTrimmedAnns Expression
e [TypeAnn]
tas [FieldAnn]
fas [VarAnn]
vas =
  Expression
e Expression -> (Expression -> Expression) -> Expression
forall a b. a -> (a -> b) -> b
& (MichelinePrimAp -> Identity MichelinePrimAp)
-> Expression -> Identity Expression
Prism' Expression MichelinePrimAp
_ExpressionPrim ((MichelinePrimAp -> Identity MichelinePrimAp)
 -> Expression -> Identity Expression)
-> (([Annotation] -> Identity [Annotation])
    -> MichelinePrimAp -> Identity MichelinePrimAp)
-> ([Annotation] -> Identity [Annotation])
-> Expression
-> Identity Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp -> Identity MichelinePrimAp
Lens' MichelinePrimAp [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
<>~ [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 :: Expression -> FieldAnn -> Expression
insertRootAnn Expression
expr FieldAnn
rootAnn = case Expression
expr of
  ExpressionPrim MichelinePrimAp
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 -> Expression
ExpressionPrim MichelinePrimAp
p
      { mpaAnnots :: [Annotation]
mpaAnnots = FieldAnn -> Annotation
AnnotationField FieldAnn
rootAnn Annotation -> [Annotation] -> [Annotation]
forall a. a -> [a] -> [a]
: MichelinePrimAp -> [Annotation]
mpaAnnots MichelinePrimAp
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 b a. (Show a, IsString b) => a -> b
show Expression
expr

-- | Checks for a given expression that the number of annotations
-- of each type in it doesn't exceed the specified threshold.
checkAnnsCount
  :: Expression
  -> AnnotationSet
  -> (Int, Int, Int)
  -> Either FromExpressionError ()
checkAnnsCount :: Expression
-> AnnotationSet
-> (Int, Int, Int)
-> Either FromExpressionError ()
checkAnnsCount Expression
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 FromExpressionError () -> Either FromExpressionError ()
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 FromExpressionError () -> Either FromExpressionError ())
-> Either FromExpressionError () -> Either FromExpressionError ()
forall a b. (a -> b) -> a -> b
$
    FromExpressionError -> Either FromExpressionError ()
forall a b. a -> Either a b
Left (FromExpressionError -> Either FromExpressionError ())
-> FromExpressionError -> Either FromExpressionError ()
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
FromExpressionError Expression
e (Text -> FromExpressionError) -> Text -> FromExpressionError
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 :: 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