module Morley.Micheline.Class
( ToExpression (..)
, FromExpError (..)
, FromExpressionError
, FromExp (..)
, FromExpression
, fromExpression
) where
import Control.Lens ((<>~))
import Data.Bits (Bits)
import Data.Singletons (SingI(..), demote)
import Fmt (Buildable(..), indentF, pretty, unlinesF)
import Morley.Micheline.Expression
import Morley.Michelson.Text (mkMText, unMText)
import Morley.Michelson.TypeCheck (TypeCheckOptions(..), typeCheckingWith)
import Morley.Michelson.TypeCheck.Instr (typeCheckValue)
import Morley.Michelson.Typed
(Contract, HasNoOp, Instr, LambdaCode'(..), Notes(..), T(..), Value, Value'(..), fromUType,
mkUType, rfAnyInstr, toUType)
import Morley.Michelson.Typed.Convert (convertContract, instrToOpsOptimized, untypeValueOptimized)
import Morley.Michelson.Untyped qualified as Untyped
import Morley.Michelson.Untyped.Annotation
(AnnotationSet(..), FieldAnn, FieldTag, RootAnn, TypeAnn, TypeTag, VarAnn, VarTag, annsCount,
emptyAnnSet, firstAnn, noAnn, secondAnn)
import Morley.Michelson.Untyped.Contract (ContractBlock(..), orderContractBlock)
import Morley.Michelson.Untyped.Instr (ExpandedInstr, ExpandedOp(..), InstrAbstract(..))
import Morley.Michelson.Untyped.Type (Ty(..))
import Morley.Michelson.Untyped.View
class ToExpression a where
toExpression :: a -> Expression
instance (HasNoOp t) => ToExpression (Value t) where
toExpression :: Value t -> Expression
toExpression = Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Value -> Expression)
-> (Value t -> Value) -> Value t -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value t -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
untypeValueOptimized
instance ToExpression Untyped.Value where
toExpression :: Value -> Expression
toExpression = \case
Untyped.ValueInt Integer
v -> Integer -> Expression
expressionInt Integer
v
Untyped.ValueString MText
s -> Text -> Expression
expressionString (Text -> Expression) -> Text -> Expression
forall a b. (a -> b) -> a -> b
$ MText -> Text
unMText MText
s
Untyped.ValueBytes (Untyped.InternalByteString ByteString
bs) -> ByteString -> Expression
expressionBytes ByteString
bs
Value
Untyped.ValueUnit -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Unit" [] []
Value
Untyped.ValueTrue -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"True" [] []
Value
Untyped.ValueFalse -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"False" [] []
Untyped.ValuePair Value
l Value
r ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Pair" [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
l, Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
r] []
Untyped.ValueLeft Value
v -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Left" [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
Untyped.ValueRight Value
v -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Right" [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
Untyped.ValueSome Value
v -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Some" [Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] []
Value
Untyped.ValueNone -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"None" [] []
Value
Untyped.ValueNil -> [Expression] -> Expression
expressionSeq []
Untyped.ValueSeq NonEmpty $ Value
vs -> (NonEmpty $ Value) -> Expression
forall a. ToExpression a => a -> Expression
toExpression NonEmpty $ Value
vs
Untyped.ValueMap NonEmpty $ Elt ExpandedOp
elts -> NonEmpty Expression -> Expression
forall a. ToExpression a => a -> Expression
toExpression (NonEmpty Expression -> Expression)
-> NonEmpty Expression -> Expression
forall a b. (a -> b) -> a -> b
$ Elt ExpandedOp -> Expression
eltToExpr (Elt ExpandedOp -> Expression)
-> (NonEmpty $ Elt ExpandedOp) -> NonEmpty Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty $ Elt ExpandedOp
elts
Untyped.ValueLambda NonEmpty ExpandedOp
ops -> NonEmpty ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression NonEmpty ExpandedOp
ops
Untyped.ValueLamRec NonEmpty ExpandedOp
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Lambda_rec" [NonEmpty ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression NonEmpty ExpandedOp
ops] []
where
eltToExpr :: Untyped.Elt ExpandedOp -> Expression
eltToExpr :: Elt ExpandedOp -> Expression
eltToExpr (Untyped.Elt Value
l Value
r) = Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"Elt"
[Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
l, Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
r] []
instance ToExpression (Instr inp out) where
toExpression :: Instr inp out -> Expression
toExpression = [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression ([ExpandedOp] -> Expression)
-> (Instr inp out -> [ExpandedOp]) -> Instr inp out -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOpsOptimized
instance ToExpression T where
toExpression :: T -> Expression
toExpression = Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Ty -> Expression) -> (T -> Ty) -> T -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Ty
toUType
instance ToExpression (Notes t) where
toExpression :: Notes t -> Expression
toExpression = Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Ty -> Expression) -> (Notes t -> Ty) -> Notes t -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notes t -> Ty
forall (x :: T). Notes x -> Ty
mkUType
instance ToExpression Untyped.T where
toExpression :: T -> Expression
toExpression = \case
T
Untyped.TKey -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"key" [] []
T
Untyped.TUnit -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"unit" [] []
T
Untyped.TSignature -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"signature" [] []
T
Untyped.TChainId -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"chain_id" [] []
Untyped.TOption Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"option" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
Untyped.TList Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"list" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
Untyped.TSet Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"set" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
T
Untyped.TOperation -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"operation" [] []
Untyped.TContract Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"contract" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
Untyped.TTicket Ty
arg -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ticket" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
arg] []
t :: T
t@Untyped.TPair{} -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"pair" (T -> [Expression]
rightCombedPairToList T
t) []
Untyped.TOr FieldAnn
fa1 FieldAnn
fa2 Ty
l Ty
r ->
let exprL :: Expression
exprL = Expression -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Expression
forall (x :: ExpExtensionDescriptorKind).
Exp x -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Exp x
addTrimmedAnns (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
l) [] [FieldAnn
fa1] []
exprR :: Expression
exprR = Expression -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Expression
forall (x :: ExpExtensionDescriptorKind).
Exp x -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Exp x
addTrimmedAnns (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
r) [] [FieldAnn
fa2] []
in Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"or" [Expression
exprL, Expression
exprR] []
Untyped.TLambda Ty
inp Ty
out ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"lambda" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
inp, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
out] []
Untyped.TMap Ty
k Ty
v ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"map" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
k, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
v] []
Untyped.TBigMap Ty
k Ty
v ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"big_map" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
k, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
v] []
T
Untyped.TInt -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"int" [] []
T
Untyped.TNat -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"nat" [] []
T
Untyped.TString -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"string" [] []
T
Untyped.TBytes -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"bytes" [] []
T
Untyped.TMutez -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"mutez" [] []
T
Untyped.TBool -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"bool" [] []
T
Untyped.TKeyHash -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"key_hash" [] []
T
Untyped.TBls12381Fr -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"bls12_381_fr" [] []
T
Untyped.TBls12381G1 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"bls12_381_g1" [] []
T
Untyped.TBls12381G2 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"bls12_381_g2" [] []
T
Untyped.TTimestamp -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"timestamp" [] []
T
Untyped.TAddress -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"address" [] []
T
Untyped.TChest -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"chest" [] []
T
Untyped.TChestKey -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"chest_key" [] []
T
Untyped.TNever -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"never" [] []
Untyped.TSaplingState Natural
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"sapling_state" [Natural -> Expression
forall i. Integral i => i -> Expression
integralToExpr Natural
n] []
Untyped.TSaplingTransaction Natural
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"sapling_transaction" [Natural -> Expression
forall i. Integral i => i -> Expression
integralToExpr Natural
n] []
where
addAnns :: Expression -> [Annotation] -> Expression
addAnns :: Expression -> [Annotation] -> Expression
addAnns Expression
e [Annotation]
anns =
Expression
e Expression -> (Expression -> Expression) -> Expression
forall a b. a -> (a -> b) -> b
& (MichelinePrimAp RegularExp
-> Identity (MichelinePrimAp RegularExp))
-> Expression -> Identity Expression
Prism' Expression (MichelinePrimAp RegularExp)
_ExpressionPrim ((MichelinePrimAp RegularExp
-> Identity (MichelinePrimAp RegularExp))
-> Expression -> Identity Expression)
-> (([Annotation] -> Identity [Annotation])
-> MichelinePrimAp RegularExp
-> Identity (MichelinePrimAp RegularExp))
-> ([Annotation] -> Identity [Annotation])
-> Expression
-> Identity Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp RegularExp
-> Identity (MichelinePrimAp RegularExp)
forall (x :: ExpExtensionDescriptorKind).
Lens' (MichelinePrimAp x) [Annotation]
mpaAnnotsL (([Annotation] -> Identity [Annotation])
-> Expression -> Identity Expression)
-> [Annotation] -> Expression -> Expression
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Annotation]
anns
rightCombedPairToList :: Untyped.T -> [Expression]
rightCombedPairToList :: T -> [Expression]
rightCombedPairToList T
t =
let go :: Ty -> (FieldAnn, VarAnn) -> [Expression]
go Ty
ty (FieldAnn
fa, VarAnn
va)
| Ty (Untyped.TPair FieldAnn
faL FieldAnn
faR VarAnn
vaL VarAnn
vaR Ty
l Ty
r) TypeAnn
ta <- Ty
ty
, TypeAnn
ta TypeAnn -> TypeAnn -> Bool
forall a. Eq a => a -> a -> Bool
== TypeAnn
forall {k} (a :: k). Annotation a
noAnn, FieldAnn
fa FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn
va VarAnn -> VarAnn -> Bool
forall a. Eq a => a -> a -> Bool
== VarAnn
forall {k} (a :: k). Annotation a
noAnn
= Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
l Expression -> [Annotation] -> Expression
`addAnns` [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
faL] [VarAnn
vaL] Expression -> [Expression] -> [Expression]
forall a. a -> [a] -> [a]
: Ty -> (FieldAnn, VarAnn) -> [Expression]
go Ty
r (FieldAnn
faR, VarAnn
vaR)
| Bool
otherwise
= OneItem [Expression] -> [Expression]
forall x. One x => OneItem x -> x
one (OneItem [Expression] -> [Expression])
-> OneItem [Expression] -> [Expression]
forall a b. (a -> b) -> a -> b
$ Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty Expression -> [Annotation] -> Expression
`addAnns` [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
in Ty -> (FieldAnn, VarAnn) -> [Expression]
go (T -> TypeAnn -> Ty
Ty T
t TypeAnn
forall {k} (a :: k). Annotation a
noAnn) (FieldAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn
forall {k} (a :: k). Annotation a
noAnn)
instance ToExpression Ty where
toExpression :: Ty -> Expression
toExpression (Ty T
t TypeAnn
ta) = Expression -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Expression
forall (x :: ExpExtensionDescriptorKind).
Exp x -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Exp x
addTrimmedAnns (T -> Expression
forall a. ToExpression a => a -> Expression
toExpression T
t) [TypeAnn
ta] [] []
instance (ToExpression a) => ToExpression [a] where
toExpression :: [a] -> Expression
toExpression [a]
xs = [Expression] -> Expression
expressionSeq ([Expression] -> Expression) -> [Expression] -> Expression
forall a b. (a -> b) -> a -> b
$ a -> Expression
forall a. ToExpression a => a -> Expression
toExpression (a -> Expression) -> [a] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
instance (ToExpression a) => ToExpression (NonEmpty a) where
toExpression :: NonEmpty a -> Expression
toExpression = [a] -> Expression
forall a. ToExpression a => a -> Expression
toExpression ([a] -> Expression)
-> (NonEmpty a -> [a]) -> NonEmpty a -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall t. Container t => t -> [Element t]
toList
instance ToExpression Expression where
toExpression :: Expression -> Expression
toExpression = Expression -> Expression
forall a. a -> a
id
instance ToExpression ExpandedOp where
toExpression :: ExpandedOp -> Expression
toExpression = \case
PrimEx ExpandedInstr
instr -> ExpandedInstr -> Expression
forall a. ToExpression a => a -> Expression
toExpression ExpandedInstr
instr
SeqEx [ExpandedOp]
s -> [Expression] -> Expression
expressionSeq ([Expression] -> Expression) -> [Expression] -> Expression
forall a b. (a -> b) -> a -> b
$ ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression (ExpandedOp -> Expression) -> [ExpandedOp] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExpandedOp]
s
WithSrcEx ErrorSrcPos
_ ExpandedOp
op -> ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression ExpandedOp
op
instance ToExpression ViewName where
toExpression :: ViewName -> Expression
toExpression (ViewName Text
s) = Text -> Expression
expressionString Text
s
instance ToExpression ExpandedInstr where
toExpression :: ExpandedInstr -> Expression
toExpression = \case
PUSH VarAnn
va Ty
ty Value
v -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"PUSH" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty, Value -> Expression
forall a. ToExpression a => a -> Expression
toExpression Value
v] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
ExpandedInstr
DROP -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DROP" [] []
DROPN Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DROP" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
DUP VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DUP" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
DUPN VarAnn
va Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DUP" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
ExpandedInstr
SWAP -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SWAP" [] []
DIG Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DIG" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
DUG Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DUG" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
SOME TypeAnn
ta VarAnn
va ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SOME" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
NONE TypeAnn
ta VarAnn
va Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NONE" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
UNIT TypeAnn
ta VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"UNIT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
IF_NONE [ExpandedOp]
ops1 [ExpandedOp]
ops2 ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"IF_NONE" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops1, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops2] []
PAIR TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"PAIR" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va]
UNPAIR VarAnn
va1 VarAnn
va2 FieldAnn
fa1 FieldAnn
fa2 -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"UNPAIR" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va1, VarAnn
va2]
PAIRN VarAnn
va Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"PAIR" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
UNPAIRN Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"UNPAIR" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] []
CAR VarAnn
va FieldAnn
fa -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CAR" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
CDR VarAnn
va FieldAnn
fa -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CDR" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
LEFT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LEFT" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va]
RIGHT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"RIGHT" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va]
IF_LEFT [ExpandedOp]
ops1 [ExpandedOp]
ops2 ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"IF_LEFT" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops1, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops2] []
NIL TypeAnn
ta VarAnn
va Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NIL" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
CONS VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CONS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
IF_CONS [ExpandedOp]
ops1 [ExpandedOp]
ops2 ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"IF_CONS" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops1, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops2] []
SIZE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SIZE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
EMPTY_SET TypeAnn
ta VarAnn
va Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"EMPTY_SET" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
EMPTY_MAP TypeAnn
ta VarAnn
va Ty
kty Ty
vty ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"EMPTY_MAP" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
kty, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
vty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
EMPTY_BIG_MAP TypeAnn
ta VarAnn
va Ty
kty Ty
vty ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"EMPTY_BIG_MAP" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
kty, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
vty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
MAP VarAnn
va [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"MAP" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
ITER [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ITER" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
MEM VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"MEM" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
GET VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"GET" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
GETN VarAnn
va Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"GET" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
UPDATE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"UPDATE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
UPDATEN VarAnn
va Word
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"UPDATE" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
GET_AND_UPDATE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"GET_AND_UPDATE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
IF [ExpandedOp]
ops1 [ExpandedOp]
ops2 ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"IF" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops1, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops2] []
LOOP [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LOOP" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
LOOP_LEFT [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LOOP_LEFT" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
LAMBDA VarAnn
va Ty
tyin Ty
tyout [ExpandedOp]
ops ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LAMBDA" [ Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
tyin
, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
tyout
, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops
] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
LAMBDA_REC VarAnn
va Ty
tyin Ty
tyout [ExpandedOp]
ops ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LAMBDA_REC" [ Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
tyin
, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
tyout
, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops
] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
EXEC VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"EXEC" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
APPLY VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"APPLY" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
DIP [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DIP" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
DIPN Word
n [ExpandedOp]
ops -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"DIP" [Word -> Expression
forall i. Integral i => i -> Expression
integralToExpr Word
n, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
ops] []
ExpandedInstr
FAILWITH -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"FAILWITH" [] []
CAST VarAnn
va Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CAST" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
RENAME VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"RENAME" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
PACK VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"PACK" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
UNPACK TypeAnn
ta VarAnn
va Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"UNPACK" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn
ta] [] [VarAnn
va]
CONCAT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CONCAT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SLICE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SLICE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
ISNAT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ISNAT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
ADD VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ADD" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SUB VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SUB" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SUB_MUTEZ VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SUB_MUTEZ" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
MUL VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"MUL" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
EDIV VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"EDIV" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
ABS VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ABS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
NEG VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NEG" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
LSL VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LSL" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
LSR VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LSR" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
OR VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"OR" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
AND VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"AND" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
XOR VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"XOR" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
NOT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NOT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
COMPARE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"COMPARE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
Untyped.EQ VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"EQ" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
NEQ VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NEQ" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
Untyped.LT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
Untyped.GT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"GT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
LE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
GE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"GE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
INT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"INT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
NAT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NAT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
BYTES VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"BYTES" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
VIEW VarAnn
va ViewName
n Ty
t -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"VIEW" [ViewName -> Expression
forall a. ToExpression a => a -> Expression
toExpression ViewName
n, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
t] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SELF VarAnn
va FieldAnn
fa -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SELF" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
CONTRACT VarAnn
va FieldAnn
fa Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CONTRACT" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
fa] [VarAnn
va]
TRANSFER_TOKENS VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"TRANSFER_TOKENS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SET_DELEGATE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SET_DELEGATE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
CREATE_CONTRACT VarAnn
va1 VarAnn
va2 Contract' ExpandedOp
c ->
Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CREATE_CONTRACT" [Contract' ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression Contract' ExpandedOp
c] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va1, VarAnn
va2]
IMPLICIT_ACCOUNT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"IMPLICIT_ACCOUNT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
NOW VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NOW" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
AMOUNT VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"AMOUNT" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
BALANCE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"BALANCE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
VOTING_POWER VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"VOTING_POWER" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
TOTAL_VOTING_POWER VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"TOTAL_VOTING_POWER" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$
[TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
CHECK_SIGNATURE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CHECK_SIGNATURE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SHA256 VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SHA256" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SHA512 VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SHA512" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
BLAKE2B VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"BLAKE2B" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SHA3 VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SHA3" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
KECCAK VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"KECCAK" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
HASH_KEY VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"HASH_KEY" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
PAIRING_CHECK VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"PAIRING_CHECK" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SOURCE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SOURCE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SENDER VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SENDER" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
ADDRESS VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"ADDRESS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
CHAIN_ID VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"CHAIN_ID" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
LEVEL VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"LEVEL" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SELF_ADDRESS VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SELF_ADDRESS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
TICKET VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"TICKET" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
TICKET_DEPRECATED VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"TICKET_DEPRECATED" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
READ_TICKET VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"READ_TICKET" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SPLIT_TICKET VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SPLIT_TICKET" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
JOIN_TICKETS VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"JOIN_TICKETS" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
OPEN_CHEST VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"OPEN_CHEST" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
ExpandedInstr
NEVER -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"NEVER" [] []
EXT ExtInstrAbstract ExpandedOp
_ -> [Expression] -> Expression
expressionSeq []
SAPLING_EMPTY_STATE VarAnn
va Natural
n -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SAPLING_EMPTY_STATE" [Natural -> Expression
forall i. Integral i => i -> Expression
integralToExpr Natural
n] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
SAPLING_VERIFY_UPDATE VarAnn
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"SAPLING_VERIFY_UPDATE" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [] [VarAnn
va]
MIN_BLOCK_TIME [AnyAnn]
va -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"MIN_BLOCK_TIME" [] ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [AnyAnn] -> [Annotation]
mkAnnsFromAny [AnyAnn]
va
EMIT VarAnn
va FieldAnn
tag Maybe Ty
ty -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"EMIT" (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Ty -> Expression) -> [Ty] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Ty -> [Ty]
forall a. Maybe a -> [a]
maybeToList Maybe Ty
ty) ([Annotation] -> Expression) -> [Annotation] -> Expression
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [] [FieldAnn
tag] [VarAnn
va]
instance ToExpression Untyped.Contract where
toExpression :: Contract' ExpandedOp -> Expression
toExpression Contract' ExpandedOp
contract
= [Expression] -> Expression
expressionSeq ([Expression] -> Expression) -> [Expression] -> Expression
forall a b. (a -> b) -> a -> b
$ Contract' ExpandedOp
-> (ParameterType -> Expression)
-> (Ty -> Expression)
-> ([ExpandedOp] -> Expression)
-> (View' ExpandedOp -> Expression)
-> [Expression]
forall op a.
Contract' op
-> (ParameterType -> a)
-> (Ty -> a)
-> ([op] -> a)
-> (View' op -> a)
-> [a]
Untyped.mapEntriesOrdered Contract' ExpandedOp
contract
(\(Untyped.ParameterType Ty
ty FieldAnn
rootAnn) -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"parameter"
[HasCallStack => Expression -> FieldAnn -> Expression
Expression -> FieldAnn -> Expression
insertRootAnn (Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
ty) FieldAnn
rootAnn] [])
(\Ty
storage -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"storage" [Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
storage] [])
(\[ExpandedOp]
code -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"code" [[ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
code] [])
(\Untyped.View{[ExpandedOp]
Ty
ViewName
viewCode :: forall op. View' op -> [op]
viewReturn :: forall op. View' op -> Ty
viewArgument :: forall op. View' op -> Ty
viewName :: forall op. View' op -> ViewName
viewCode :: [ExpandedOp]
viewReturn :: Ty
viewArgument :: Ty
viewName :: ViewName
..} -> Text -> [Expression] -> [Annotation] -> Expression
expressionPrim' Text
"view"
[ViewName -> Expression
forall a. ToExpression a => a -> Expression
toExpression ViewName
viewName, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
viewArgument, Ty -> Expression
forall a. ToExpression a => a -> Expression
toExpression Ty
viewReturn, [ExpandedOp] -> Expression
forall a. ToExpression a => a -> Expression
toExpression [ExpandedOp]
viewCode] []
)
instance ToExpression (Contract cp st) where
toExpression :: Contract cp st -> Expression
toExpression = Contract' ExpandedOp -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Contract' ExpandedOp -> Expression)
-> (Contract cp st -> Contract' ExpandedOp)
-> Contract cp st
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract cp st -> Contract' ExpandedOp
forall (param :: T) (store :: T).
Contract param store -> Contract' ExpandedOp
convertContract
data FromExpError x = FromExpError (Exp x) Text
deriving stock instance Show (Exp x) => Show (FromExpError x)
deriving stock instance Eq (Exp x) => Eq (FromExpError x)
type FromExpressionError = FromExpError RegularExp
instance Buildable FromExpressionError where
build :: FromExpressionError -> Builder
build (FromExpError Expression
expr Text
err) =
[Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"Failed to convert expression:"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Expression -> Builder
forall p. Buildable p => p -> Builder
build Expression
expr
, Builder
""
, Builder
"Error:"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
forall p. Buildable p => p -> Builder
build Text
err
]
instance Exception FromExpressionError where
displayException :: FromExpressionError -> String
displayException = FromExpressionError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty
class FromExp x a where
fromExp :: Exp x -> Either (FromExpError x) a
type FromExpression = FromExp RegularExp
fromExpression
:: FromExp RegularExp a
=> Expression -> Either FromExpressionError a
fromExpression :: forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression = Expression -> Either FromExpressionError a
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp
instance (FromExp x Untyped.Value, SingI t) => FromExp x (Value t) where
fromExp :: Exp x -> Either (FromExpError x) (Value t)
fromExp Exp x
expr =
case forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @_ @Untyped.Value Exp x
expr of
Right Value
uv -> case Value -> Either (TcError' ExpandedOp) (Value t)
forall {t :: T}.
SingI t =>
Value -> Either (TcError' ExpandedOp) (Value t)
typeCheck Value
uv of
Left TcError' ExpandedOp
tcErr -> FromExpError x -> Either (FromExpError x) (Value t)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Value t))
-> FromExpError x -> Either (FromExpError x) (Value t)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
expr (Text -> FromExpError x) -> Text -> FromExpError x
forall a b. (a -> b) -> a -> b
$
Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"Failed to typecheck expression as a value of type:"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ T -> Builder
forall p. Buildable p => p -> Builder
build (T -> Builder) -> T -> Builder
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @t
, Builder
""
, Builder
"Typechecker error:"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ TcError' ExpandedOp -> Builder
forall p. Buildable p => p -> Builder
build TcError' ExpandedOp
tcErr
]
Right Value t
tv -> Value t -> Either (FromExpError x) (Value t)
forall a b. b -> Either a b
Right Value t
tv
Left FromExpError x
e -> FromExpError x -> Either (FromExpError x) (Value t)
forall a b. a -> Either a b
Left FromExpError x
e
where
typeCheck :: Value -> Either (TcError' ExpandedOp) (Value t)
typeCheck Value
uv = TypeCheckOptions
-> TypeCheckResult ExpandedOp (Value t)
-> Either (TcError' ExpandedOp) (Value t)
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith (Bool -> Bool -> TypeCheckOptions
TypeCheckOptions Bool
False Bool
False) (TypeCheckResult ExpandedOp (Value t)
-> Either (TcError' ExpandedOp) (Value t))
-> TypeCheckResult ExpandedOp (Value t)
-> Either (TcError' ExpandedOp) (Value t)
forall a b. (a -> b) -> a -> b
$
Value -> TypeCheckResult ExpandedOp (Value t)
forall (t :: T).
SingI t =>
Value -> TypeCheckResult ExpandedOp (Value t)
typeCheckValue Value
uv
instance FromExp x op => FromExp x (Untyped.Value' op) where
fromExp :: Exp x -> Either (FromExpError x) (Value' op)
fromExp Exp x
e = case Exp x
e of
ExpInt XExpInt x
_ Integer
v -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' op -> Either (FromExpError x) (Value' op))
-> Value' op -> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$ Integer -> Value' op
forall op. Integer -> Value' op
Untyped.ValueInt Integer
v
ExpString XExpString x
_ Text
s -> (Text -> FromExpError x)
-> Either Text (Value' op) -> Either (FromExpError x) (Value' op)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e)
(MText -> Value' op
forall op. MText -> Value' op
Untyped.ValueString (MText -> Value' op)
-> Either Text MText -> Either Text (Value' op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text MText
mkMText Text
s)
ExpBytes XExpBytes x
_ ByteString
bs -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' op -> Either (FromExpError x) (Value' op))
-> Value' op -> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$ InternalByteString -> Value' op
forall op. InternalByteString -> Value' op
Untyped.ValueBytes (InternalByteString -> Value' op)
-> InternalByteString -> Value' op
forall a b. (a -> b) -> a -> b
$ ByteString -> InternalByteString
Untyped.InternalByteString ByteString
bs
ExpPrim' XExpPrim x
_ MichelinePrimitive
"Unit" [] [] -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' op
forall op. Value' op
Untyped.ValueUnit
ExpPrim' XExpPrim x
_ MichelinePrimitive
"True" [] [] -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' op
forall op. Value' op
Untyped.ValueTrue
ExpPrim' XExpPrim x
_ MichelinePrimitive
"False" [] [] -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' op
forall op. Value' op
Untyped.ValueFalse
ExpPrim' XExpPrim x
_ MichelinePrimitive
"Pair" [Exp x]
args [] ->
case [Exp x] -> Maybe (NonEmpty (Exp x))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Exp x]
args Maybe (NonEmpty (Exp x))
-> (NonEmpty (Exp x) -> Maybe (NonEmpty (Exp x)))
-> Maybe (NonEmpty (Exp x))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NonEmpty (Exp x) -> Maybe (NonEmpty (Exp x))
forall a. NonEmpty a -> Maybe (NonEmpty a)
forbidSingletonList of
Maybe (NonEmpty (Exp x))
Nothing -> FromExpError x -> Either (FromExpError x) (Value' op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Value' op))
-> FromExpError x -> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
Text
"Expected a pair with at least 2 arguments"
Just NonEmpty (Exp x)
args' -> do
NonEmpty (Value' op)
tys <- (Exp x -> Either (FromExpError x) (Value' op))
-> NonEmpty (Exp x)
-> Either (FromExpError x) (NonEmpty (Value' op))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp NonEmpty (Exp x)
args'
return $ (Value' op -> Value' op -> Value' op)
-> NonEmpty (Value' op) -> Value' op
forall a. (a -> a -> a) -> NonEmpty a -> a
foldr1 Value' op -> Value' op -> Value' op
forall op. Value' op -> Value' op -> Value' op
Untyped.ValuePair NonEmpty (Value' op)
tys
ExpPrim' XExpPrim x
_ MichelinePrimitive
"Left" [Exp x
arg] [] -> do
Value' op
arg' <- Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
pure $ Value' op -> Value' op
forall op. Value' op -> Value' op
Untyped.ValueLeft Value' op
arg'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"Right" [Exp x
arg] [] -> do
Value' op
arg' <- Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
pure $ Value' op -> Value' op
forall op. Value' op -> Value' op
Untyped.ValueRight Value' op
arg'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"Some" [Exp x
arg] [] -> do
Value' op
arg' <- Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
pure $ Value' op -> Value' op
forall op. Value' op -> Value' op
Untyped.ValueSome Value' op
arg'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"None" [] [] -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' op
forall op. Value' op
Untyped.ValueNone
ExpPrim' XExpPrim x
_ MichelinePrimitive
"Lambda_rec" [Exp x
args] [] -> (NonEmpty op -> Value' op)
-> Either (FromExpError x) (NonEmpty op)
-> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty op -> Value' op
forall op. NonEmpty op -> Value' op
Untyped.ValueLamRec (Either (FromExpError x) (NonEmpty op)
-> Either (FromExpError x) (Value' op))
-> Either (FromExpError x) (NonEmpty op)
-> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$
Exp x -> Either (FromExpError x) [op]
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
args Either (FromExpError x) [op]
-> ([op] -> Either (FromExpError x) (NonEmpty op))
-> Either (FromExpError x) (NonEmpty op)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FromExpError x
-> Maybe (NonEmpty op) -> Either (FromExpError x) (NonEmpty op)
forall l r. l -> Maybe r -> Either l r
maybeToRight (Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected at least one instruction") (Maybe (NonEmpty op) -> Either (FromExpError x) (NonEmpty op))
-> ([op] -> Maybe (NonEmpty op))
-> [op]
-> Either (FromExpError x) (NonEmpty op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [op] -> Maybe (NonEmpty op)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
ExpSeq XExpSeq x
_ [] -> Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' op
forall op. Value' op
Untyped.ValueNil
ExpSeq XExpSeq x
_ (Exp x
h : [Exp x]
t) ->
case forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @op Exp x
h of
Right op
op -> do
[op]
ops <- (Exp x -> Either (FromExpError x) op)
-> [Exp x] -> Either (FromExpError x) [op]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @op) [Exp x]
t
Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' op -> Either (FromExpError x) (Value' op))
-> (NonEmpty op -> Value' op)
-> NonEmpty op
-> Either (FromExpError x) (Value' op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty op -> Value' op
forall op. NonEmpty op -> Value' op
Untyped.ValueLambda (NonEmpty op -> Either (FromExpError x) (Value' op))
-> NonEmpty op -> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$ op
op op -> [op] -> NonEmpty op
forall a. a -> [a] -> NonEmpty a
:| [op]
ops
Left FromExpError x
_ -> case Exp x -> Either (FromExpError x) (Elt op)
exprToElt Exp x
h of
Right Elt op
elt -> do
[Elt op]
elts <- (Exp x -> Either (FromExpError x) (Elt op))
-> [Exp x] -> Either (FromExpError x) [Elt op]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Exp x -> Either (FromExpError x) (Elt op)
exprToElt [Exp x]
t
Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' op -> Either (FromExpError x) (Value' op))
-> ((NonEmpty $ Elt op) -> Value' op)
-> (NonEmpty $ Elt op)
-> Either (FromExpError x) (Value' op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty $ Elt op) -> Value' op
forall op. (NonEmpty $ Elt op) -> Value' op
Untyped.ValueMap ((NonEmpty $ Elt op) -> Either (FromExpError x) (Value' op))
-> (NonEmpty $ Elt op) -> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$ Elt op
elt Elt op -> [Elt op] -> NonEmpty $ Elt op
forall a. a -> [a] -> NonEmpty a
:| [Elt op]
elts
Left FromExpError x
_ -> case Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
h of
Left (FromExpError Exp x
err Text
_) -> FromExpError x -> Either (FromExpError x) (Value' op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Value' op))
-> FromExpError x -> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
err
Text
"Value, instruction or 'Elt' expression expected"
Right Value' op
h' -> do
[Value' op]
t' <- (Exp x -> Either (FromExpError x) (Value' op))
-> [Exp x] -> Either (FromExpError x) [Value' op]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp [Exp x]
t
Value' op -> Either (FromExpError x) (Value' op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' op -> Either (FromExpError x) (Value' op))
-> (NonEmpty (Value' op) -> Value' op)
-> NonEmpty (Value' op)
-> Either (FromExpError x) (Value' op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Value' op) -> Value' op
forall op. (NonEmpty $ Value' op) -> Value' op
Untyped.ValueSeq (NonEmpty (Value' op) -> Either (FromExpError x) (Value' op))
-> NonEmpty (Value' op) -> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$ Value' op
h' Value' op -> [Value' op] -> NonEmpty (Value' op)
forall a. a -> [a] -> NonEmpty a
:| [Value' op]
t'
Exp x
_ -> FromExpError x -> Either (FromExpError x) (Value' op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Value' op))
-> FromExpError x -> Either (FromExpError x) (Value' op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected a value"
where
exprToElt :: Exp x -> Either (FromExpError x) (Untyped.Elt op)
exprToElt :: Exp x -> Either (FromExpError x) (Elt op)
exprToElt Exp x
ex = case Exp x
ex of
ExpPrim' XExpPrim x
_ MichelinePrimitive
"Elt" [Exp x
l, Exp x
r] [] -> do
Value' op
l' <- Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
l
Value' op
r' <- Exp x -> Either (FromExpError x) (Value' op)
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
r
pure $ Value' op -> Value' op -> Elt op
forall op. Value' op -> Value' op -> Elt op
Untyped.Elt Value' op
l' Value' op
r'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"Elt" [Exp x]
_ [] -> FromExpError x -> Either (FromExpError x) (Elt op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Elt op))
-> FromExpError x -> Either (FromExpError x) (Elt op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
ex
Text
"Expected 'Elt' expression with exactly 2 elements"
ExpPrim' XExpPrim x
_ MichelinePrimitive
"Elt" [Exp x]
_ [Annotation]
_ -> FromExpError x -> Either (FromExpError x) (Elt op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Elt op))
-> FromExpError x -> Either (FromExpError x) (Elt op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
ex
Text
"Expected 'Elt' expression without annotations"
Exp x
_ -> FromExpError x -> Either (FromExpError x) (Elt op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Elt op))
-> FromExpError x -> Either (FromExpError x) (Elt op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
ex Text
"Expected 'Elt' expression"
instance FromExp x a => FromExp x [a] where
fromExp :: Exp x -> Either (FromExpError x) [a]
fromExp = \case
ExpSeq XExpSeq x
_ [Exp x]
exprs -> (Exp x -> Either (FromExpError x) a)
-> [Exp x] -> Either (FromExpError x) [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Exp x -> Either (FromExpError x) a
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp [Exp x]
exprs
Exp x
e -> FromExpError x -> Either (FromExpError x) [a]
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) [a])
-> FromExpError x -> Either (FromExpError x) [a]
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"'ExpressionSeq' expected"
instance FromExp RegularExp ExpandedOp where
fromExp :: Expression -> Either FromExpressionError ExpandedOp
fromExp = \case
ExpSeq XExpSeq RegularExp
_ [Expression]
s -> [ExpandedOp] -> ExpandedOp
SeqEx ([ExpandedOp] -> ExpandedOp)
-> Either FromExpressionError [ExpandedOp]
-> Either FromExpressionError ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expression -> Either FromExpressionError ExpandedOp)
-> [Expression] -> Either FromExpressionError [ExpandedOp]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expression -> Either FromExpressionError ExpandedOp
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp [Expression]
s
Expression
e -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp)
-> Either FromExpressionError ExpandedInstr
-> Either FromExpressionError ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> Either FromExpressionError ExpandedInstr
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Expression
e
instance FromExp x op =>
FromExp x (InstrAbstract op) where
fromExp :: Exp x -> Either (FromExpError x) (InstrAbstract op)
fromExp Exp x
e = let annSet :: AnnotationSet
annSet = Exp x -> AnnotationSet
forall (d :: ExpExtensionDescriptorKind). Exp d -> AnnotationSet
getAnnSet Exp x
e in case Exp x
e of
ExpPrim' XExpPrim x
_ MichelinePrimitive
"DROP" [Exp x
n] [] -> do
Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
pure $ Word -> InstrAbstract op
forall op. Word -> InstrAbstract op
DROPN Word
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"DROP" [] [Annotation]
_ -> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstrAbstract op -> Either (FromExpError x) (InstrAbstract op))
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall a b. (a -> b) -> a -> b
$ InstrAbstract op
forall op. InstrAbstract op
DROP
ExpPrim' XExpPrim x
_ MichelinePrimitive
"DUP" [Exp x
n] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
pure $ VarAnn -> Word -> InstrAbstract op
forall op. VarAnn -> Word -> InstrAbstract op
DUPN VarAnn
va Word
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"DUP" [] [Annotation]
_ ->
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
in Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
va
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SWAP" [] [] -> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstrAbstract op -> Either (FromExpError x) (InstrAbstract op))
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall a b. (a -> b) -> a -> b
$ InstrAbstract op
forall op. InstrAbstract op
SWAP
ExpPrim' XExpPrim x
_ MichelinePrimitive
"DIG" [Exp x
n] [] -> do
Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
pure $ Word -> InstrAbstract op
forall op. Word -> InstrAbstract op
DIG (Word -> InstrAbstract op) -> Word -> InstrAbstract op
forall a b. (a -> b) -> a -> b
$ Word
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"DUG" [Exp x
n] [] -> do
Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
pure $ Word -> InstrAbstract op
forall op. Word -> InstrAbstract op
DUG Word
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"PUSH" [Exp x
t, Exp x
v] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
Value' op
v' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @(Untyped.Value' op) Exp x
v
pure $ VarAnn -> Ty -> Value' op -> InstrAbstract op
forall op. VarAnn -> Ty -> Value' op -> InstrAbstract op
PUSH VarAnn
va Ty
t' Value' op
v'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SOME" [] [Annotation]
_ ->
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
in Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
0, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeAnn -> VarAnn -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> InstrAbstract op
SOME TypeAnn
ta VarAnn
va
ExpPrim' XExpPrim x
_ MichelinePrimitive
"NONE" [Exp x
t] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
pure $ TypeAnn -> VarAnn -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
NONE TypeAnn
ta VarAnn
va Ty
t'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"UNIT" [] [Annotation]
_ ->
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
in Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
0, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeAnn -> VarAnn -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> InstrAbstract op
UNIT TypeAnn
ta VarAnn
va
ExpPrim' XExpPrim x
_ MichelinePrimitive
"IF_NONE" [Exp x
ops1, Exp x
ops2] [] -> do
[op]
ops1' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops1
[op]
ops2' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops2
pure $ [op] -> [op] -> InstrAbstract op
forall op. [op] -> [op] -> InstrAbstract op
IF_NONE [op]
ops1' [op]
ops2'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"PAIR" [] [Annotation]
_ ->
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
fa1 :: FieldAnn
fa1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
in (Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
2, Int
1)) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2
ExpPrim' XExpPrim x
_ MichelinePrimitive
"UNPAIR" [] [Annotation]
_ ->
let va1 :: VarAnn
va1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
va2 :: VarAnn
va2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @VarTag AnnotationSet
annSet
fa1 :: FieldAnn
fa1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
in Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
2, Int
2) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
forall op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
UNPAIR VarAnn
va1 VarAnn
va2 FieldAnn
fa1 FieldAnn
fa2
ExpPrim' XExpPrim x
_ MichelinePrimitive
"PAIR" [Exp x
n] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
pure $ VarAnn -> Word -> InstrAbstract op
forall op. VarAnn -> Word -> InstrAbstract op
PAIRN VarAnn
va Word
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"UNPAIR" [Exp x
n] [] -> do
Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
pure $ Word -> InstrAbstract op
forall op. Word -> InstrAbstract op
UNPAIRN Word
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"CAR" [] [Annotation]
_ ->
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
in Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
1, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> FieldAnn -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
va FieldAnn
fa
ExpPrim' XExpPrim x
_ MichelinePrimitive
"CDR" [] [Annotation]
_ ->
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
in Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
1, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> FieldAnn -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
va FieldAnn
fa
ExpPrim' XExpPrim x
_ MichelinePrimitive
"LEFT" [Exp x
t] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
2, Int
1)
Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
let fa1 :: FieldAnn
fa1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
let fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
pure $ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract op
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract op
LEFT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
t'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"RIGHT" [Exp x
t] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
2, Int
1)
Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
let fa1 :: FieldAnn
fa1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
let fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet
pure $ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract op
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Ty -> InstrAbstract op
RIGHT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
t'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"IF_LEFT" [Exp x
ops1, Exp x
ops2] [] -> do
[op]
ops1' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops1
[op]
ops2' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops2
pure $ [op] -> [op] -> InstrAbstract op
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT [op]
ops1' [op]
ops2'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"NIL" [Exp x
t] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
pure $ TypeAnn -> VarAnn -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
NIL TypeAnn
ta VarAnn
va Ty
t'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"CONS" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
CONS [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"IF_CONS" [Exp x
ops1, Exp x
ops2] [] -> do
[op]
ops1' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops1
[op]
ops2' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops2
pure $ [op] -> [op] -> InstrAbstract op
forall op. [op] -> [op] -> InstrAbstract op
IF_CONS [op]
ops1' [op]
ops2'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SIZE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SIZE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"EMPTY_SET" [Exp x
t] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
pure $ TypeAnn -> VarAnn -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
EMPTY_SET TypeAnn
ta VarAnn
va Ty
t'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"EMPTY_MAP" [Exp x
kt, Exp x
vt] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
Ty
kt' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
kt
Ty
vt' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
vt
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
pure $ TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
EMPTY_MAP TypeAnn
ta VarAnn
va Ty
kt' Ty
vt'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"EMPTY_BIG_MAP" [Exp x
kt, Exp x
vt] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
Ty
kt' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
kt
Ty
vt' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
vt
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
pure $ TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
EMPTY_BIG_MAP TypeAnn
ta VarAnn
va Ty
kt' Ty
vt'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"MAP" [Exp x
ops] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
[op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
pure $ VarAnn -> [op] -> InstrAbstract op
forall op. VarAnn -> [op] -> InstrAbstract op
MAP VarAnn
va [op]
ops'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"ITER" [Exp x
ops] [] -> do
[op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
pure $ [op] -> InstrAbstract op
forall op. [op] -> InstrAbstract op
ITER [op]
ops'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"MEM" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
MEM [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"GET" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
GET [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"GET" [Exp x
n] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
pure $ VarAnn -> Word -> InstrAbstract op
forall op. VarAnn -> Word -> InstrAbstract op
GETN VarAnn
va Word
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"UPDATE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
UPDATE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"UPDATE" [Exp x
n] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
pure $ VarAnn -> Word -> InstrAbstract op
forall op. VarAnn -> Word -> InstrAbstract op
UPDATEN VarAnn
va Word
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"GET_AND_UPDATE" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
GET_AND_UPDATE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"IF" [Exp x
ops1, Exp x
ops2] [] -> do
[op]
ops1' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops1
[op]
ops2' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops2
pure $ [op] -> [op] -> InstrAbstract op
forall op. [op] -> [op] -> InstrAbstract op
IF [op]
ops1' [op]
ops2'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"LOOP" [Exp x
ops] [] -> do
[op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
pure $ [op] -> InstrAbstract op
forall op. [op] -> InstrAbstract op
LOOP [op]
ops'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"LOOP_LEFT" [Exp x
ops] [] -> do
[op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
pure $ [op] -> InstrAbstract op
forall op. [op] -> InstrAbstract op
LOOP_LEFT [op]
ops'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"LAMBDA" [Exp x
inp, Exp x
out, Exp x
ops] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
Ty
inp' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
inp
Ty
out' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
out
[op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
pure $ VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
forall op. VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
LAMBDA VarAnn
va Ty
inp' Ty
out' [op]
ops'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"LAMBDA_REC" [Exp x
inp, Exp x
out, Exp x
ops] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
Ty
inp' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
inp
Ty
out' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
out
[op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
pure $ VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
forall op. VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
LAMBDA_REC VarAnn
va Ty
inp' Ty
out' [op]
ops'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"EXEC" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
EXEC [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"APPLY" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
APPLY [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"DIP" [Exp x
ops] [] -> do
[op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
pure $ [op] -> InstrAbstract op
forall op. [op] -> InstrAbstract op
DIP [op]
ops'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"DIP" [Exp x
n, Exp x
ops] [] -> do
Word
n' <- Exp x -> Either (FromExpError x) Word
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
[op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
pure $ Word -> [op] -> InstrAbstract op
forall op. Word -> [op] -> InstrAbstract op
DIPN Word
n' [op]
ops'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"FAILWITH" [] [] -> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstrAbstract op
forall op. InstrAbstract op
FAILWITH
ExpPrim' XExpPrim x
_ MichelinePrimitive
"CAST" [Exp x
t] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
pure $ VarAnn -> Ty -> InstrAbstract op
forall op. VarAnn -> Ty -> InstrAbstract op
CAST VarAnn
va Ty
t'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"RENAME" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
RENAME [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"PACK" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
PACK [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"UNPACK" [Exp x
t] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
1, Int
0, Int
1)
Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
pure $ TypeAnn -> VarAnn -> Ty -> InstrAbstract op
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
UNPACK TypeAnn
ta VarAnn
va Ty
t'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"CONCAT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
CONCAT [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SLICE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SLICE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"ISNAT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
ISNAT [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"ADD" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
ADD [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SUB" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SUB [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SUB_MUTEZ" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SUB_MUTEZ [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"MUL" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
MUL [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"EDIV" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
EDIV [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"ABS" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
ABS [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"NEG" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
NEG [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"LSL" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
LSL [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"LSR" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
LSR [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"OR" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
OR [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"AND" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
AND [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"XOR" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
XOR [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"NOT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
NOT [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"COMPARE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
COMPARE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"EQ" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
Untyped.EQ [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"NEQ" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
NEQ [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"LT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
Untyped.LT [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"GT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
Untyped.GT [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"LE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
LE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"GE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
GE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"INT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
INT [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"NAT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
NAT [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"BYTES" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
BYTES [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"VIEW" [Exp x
name, Exp x
t] [Annotation]
_ -> do
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
ViewName
name' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @ViewName Exp x
name
Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> ViewName -> Ty -> InstrAbstract op
forall op. VarAnn -> ViewName -> Ty -> InstrAbstract op
VIEW VarAnn
va ViewName
name' Ty
t'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SELF" [] [Annotation]
_ ->
let fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
in Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
1, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> FieldAnn -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> InstrAbstract op
SELF VarAnn
va FieldAnn
fa
ExpPrim' XExpPrim x
_ MichelinePrimitive
"CONTRACT" [Exp x
t] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
1, Int
1)
Ty
t' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
t
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
let fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
pure $ VarAnn -> FieldAnn -> Ty -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> Ty -> InstrAbstract op
CONTRACT VarAnn
va FieldAnn
fa Ty
t'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"TRANSFER_TOKENS" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
TRANSFER_TOKENS [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SET_DELEGATE" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SET_DELEGATE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"CREATE_CONTRACT" [Exp x
c] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
2)
Contract' op
c' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @(Untyped.Contract' op) Exp x
c
let va1 :: VarAnn
va1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
let va2 :: VarAnn
va2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @VarTag AnnotationSet
annSet
pure $ VarAnn -> VarAnn -> Contract' op -> InstrAbstract op
forall op. VarAnn -> VarAnn -> Contract' op -> InstrAbstract op
CREATE_CONTRACT VarAnn
va1 VarAnn
va2 Contract' op
c'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"IMPLICIT_ACCOUNT" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
IMPLICIT_ACCOUNT [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"NOW" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
NOW [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"AMOUNT" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
AMOUNT [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"BALANCE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
BALANCE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"VOTING_POWER" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
VOTING_POWER [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"TOTAL_VOTING_POWER" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
TOTAL_VOTING_POWER [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"CHECK_SIGNATURE" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
CHECK_SIGNATURE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SHA256" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SHA256 [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SHA512" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SHA512 [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"BLAKE2B" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
BLAKE2B [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SHA3" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SHA3 [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"KECCAK" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
KECCAK [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"HASH_KEY" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
HASH_KEY [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"PAIRING_CHECK" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
PAIRING_CHECK [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SOURCE" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SOURCE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SENDER" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SENDER [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"ADDRESS" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
ADDRESS [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"CHAIN_ID" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
CHAIN_ID [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"LEVEL" [] [Annotation]
anns -> (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
LEVEL [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SELF_ADDRESS" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SELF_ADDRESS [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"NEVER" [] [] -> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstrAbstract op
forall op. InstrAbstract op
NEVER
ExpPrim' XExpPrim x
_ MichelinePrimitive
"TICKET_DEPRECATED" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
TICKET_DEPRECATED [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"TICKET" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
TICKET [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"READ_TICKET" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
READ_TICKET [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SPLIT_TICKET" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SPLIT_TICKET [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"JOIN_TICKETS" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
JOIN_TICKETS [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"OPEN_CHEST" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
OPEN_CHEST [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SAPLING_EMPTY_STATE" [Exp x
n] [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1)
Natural
n' <- Exp x -> Either (FromExpError x) Natural
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
pure $ VarAnn -> Natural -> InstrAbstract op
forall op. VarAnn -> Natural -> InstrAbstract op
SAPLING_EMPTY_STATE VarAnn
va Natural
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"SAPLING_VERIFY_UPDATE" [] [Annotation]
anns ->
(VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
forall op. VarAnn -> InstrAbstract op
SAPLING_VERIFY_UPDATE [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"MIN_BLOCK_TIME" [] [Annotation]
anns -> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstrAbstract op -> Either (FromExpError x) (InstrAbstract op))
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall a b. (a -> b) -> a -> b
$ ([AnyAnn] -> InstrAbstract op) -> [Annotation] -> InstrAbstract op
mkInstrWithAnyAnns [AnyAnn] -> InstrAbstract op
forall op. [AnyAnn] -> InstrAbstract op
MIN_BLOCK_TIME [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"EMIT" [Exp x]
mty [Annotation]
_ -> do
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
1, Int
1)
let tag :: FieldAnn
tag = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
Maybe Ty
ty' <- Either (FromExpError x) (Maybe Ty)
-> (Exp x -> Either (FromExpError x) (Maybe Ty))
-> Maybe (Exp x)
-> Either (FromExpError x) (Maybe Ty)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Ty -> Either (FromExpError x) (Maybe Ty)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Ty
forall a. Maybe a
Nothing) ((Ty -> Maybe Ty)
-> Either (FromExpError x) Ty -> Either (FromExpError x) (Maybe Ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ty -> Maybe Ty
forall a. a -> Maybe a
Just (Either (FromExpError x) Ty -> Either (FromExpError x) (Maybe Ty))
-> (Exp x -> Either (FromExpError x) Ty)
-> Exp x
-> Either (FromExpError x) (Maybe Ty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty) (Maybe (Exp x) -> Either (FromExpError x) (Maybe Ty))
-> Maybe (Exp x) -> Either (FromExpError x) (Maybe Ty)
forall a b. (a -> b) -> a -> b
$ [Exp x] -> Maybe (Exp x)
forall a. [a] -> Maybe a
listToMaybe [Exp x]
mty
pure $ VarAnn -> FieldAnn -> Maybe Ty -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> Maybe Ty -> InstrAbstract op
EMIT VarAnn
va FieldAnn
tag Maybe Ty
ty'
Exp x
_ -> FromExpError x -> Either (FromExpError x) (InstrAbstract op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (InstrAbstract op))
-> FromExpError x -> Either (FromExpError x) (InstrAbstract op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected an instruction"
where
mkInstrWithVarAnn
:: (VarAnn -> InstrAbstract op)
-> [Annotation]
-> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn :: (VarAnn -> InstrAbstract op)
-> [Annotation] -> Either (FromExpError x) (InstrAbstract op)
mkInstrWithVarAnn VarAnn -> InstrAbstract op
ctor [Annotation]
anns =
let annSet :: AnnotationSet
annSet = [Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns
va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
annSet
in Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet (Int
0, Int
0, Int
1) Either (FromExpError x) ()
-> InstrAbstract op -> Either (FromExpError x) (InstrAbstract op)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> VarAnn -> InstrAbstract op
ctor VarAnn
va
mkInstrWithAnyAnns
:: ([Untyped.AnyAnn] -> InstrAbstract op)
-> [Annotation]
-> InstrAbstract op
mkInstrWithAnyAnns :: ([AnyAnn] -> InstrAbstract op) -> [Annotation] -> InstrAbstract op
mkInstrWithAnyAnns [AnyAnn] -> InstrAbstract op
ctor [Annotation]
anns = [AnyAnn] -> InstrAbstract op
ctor ([AnyAnn] -> InstrAbstract op) -> [AnyAnn] -> InstrAbstract op
forall a b. (a -> b) -> a -> b
$ [Annotation]
anns [Annotation] -> (Annotation -> AnyAnn) -> [AnyAnn]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
AnnotationType TypeAnn
x -> TypeAnn -> AnyAnn
Untyped.AnyAnnType TypeAnn
x
AnnotationField FieldAnn
x -> FieldAnn -> AnyAnn
Untyped.AnyAnnField FieldAnn
x
AnnotationVariable VarAnn
x -> VarAnn -> AnyAnn
Untyped.AnyAnnVar VarAnn
x
getAnnSet :: Exp d -> AnnotationSet
getAnnSet :: forall (d :: ExpExtensionDescriptorKind). Exp d -> AnnotationSet
getAnnSet = \case
ExpPrim' XExpPrim d
_ MichelinePrimitive
_ [Exp d]
_ [Annotation]
anns -> [Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns
Exp d
_ -> AnnotationSet
emptyAnnSet
instance (FromExp x op) => FromExp x (Untyped.Contract' op) where
fromExp :: Exp x -> Either (FromExpError x) (Contract' op)
fromExp Exp x
blocks = case Exp x
blocks of
ExpSeq XExpSeq x
_ [Exp x]
bs -> do
[ContractBlock op]
bs' <- (Exp x -> Either (FromExpError x) (ContractBlock op))
-> [Exp x] -> Either (FromExpError x) [ContractBlock op]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Exp x -> Either (FromExpError x) (ContractBlock op)
exprToCB [Exp x]
bs
FromExpError x
-> Maybe (Contract' op) -> Either (FromExpError x) (Contract' op)
forall l r. l -> Maybe r -> Either l r
maybeToRight (Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
blocks Text
"Something's wrong with top-level contract blocks")
([ContractBlock op] -> Maybe (Contract' op)
forall op. [ContractBlock op] -> Maybe (Contract' op)
orderContractBlock [ContractBlock op]
bs')
Exp x
expr -> FromExpError x -> Either (FromExpError x) (Contract' op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (Contract' op))
-> FromExpError x -> Either (FromExpError x) (Contract' op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
expr Text
"Failed to parse contract, expected sequence"
where
exprToCB
:: Exp x
-> Either (FromExpError x) (ContractBlock op)
exprToCB :: Exp x -> Either (FromExpError x) (ContractBlock op)
exprToCB Exp x
e = case Exp x
e of
ExpPrim' XExpPrim x
_ MichelinePrimitive
"parameter" [Exp x]
args [Annotation]
anns -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCbParam Exp x
e [Exp x]
args [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"storage" [Exp x]
args [Annotation]
anns -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBStorage Exp x
e [Exp x]
args [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"code" [Exp x]
args [Annotation]
anns -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBCode Exp x
e [Exp x]
args [Annotation]
anns
ExpPrim' XExpPrim x
_ MichelinePrimitive
"view" [Exp x]
args [Annotation]
anns -> Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBView Exp x
e [Exp x]
args [Annotation]
anns
Exp x
_ ->
FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (ContractBlock op))
-> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Unexpected primitive at contract top-level"
mkCbParam
:: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCbParam :: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCbParam Exp x
e [Exp x]
args [Annotation]
anns = case ([Exp x]
args, [Annotation]
anns) of
([Exp x
p], []) -> do
let annSet :: AnnotationSet
annSet = [Annotation] -> AnnotationSet
toAnnSet (Exp x
p Exp x -> Getting [Annotation] (Exp x) [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. ((XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Getting [Annotation] (Exp x) [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> ([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind).
Lens' (MichelinePrimAp x) [Annotation]
mpaAnnotsL)
let rootAnn :: FieldAnn
rootAnn = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
annSet
Bool -> Either (FromExpError x) () -> Either (FromExpError x) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @FieldTag AnnotationSet
annSet FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
forall {k} (a :: k). Annotation a
noAnn) (Either (FromExpError x) () -> Either (FromExpError x) ())
-> Either (FromExpError x) () -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$
FromExpError x -> Either (FromExpError x) ()
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) ())
-> FromExpError x -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
p
Text
"Expected parameter with at most 1 root annotation"
Ty
p' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty
(Exp x
p Exp x -> (Exp x -> Exp x) -> Exp x
forall a b. a -> (a -> b) -> b
& ((XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Identity (Exp x)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Identity (Exp x))
-> (([Annotation] -> Identity [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> Exp x
-> Identity (Exp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Identity [Annotation])
-> MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp x -> Identity (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind).
Lens' (MichelinePrimAp x) [Annotation]
mpaAnnotsL (([Annotation] -> Identity [Annotation])
-> Exp x -> Identity (Exp x))
-> ([Annotation] -> [Annotation]) -> Exp x -> Exp x
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Annotation -> Bool) -> [Annotation] -> [Annotation]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
forall a. Boolean a => a -> a
not (Bool -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Bool
isAnnotationField))
pure $ ParameterType -> ContractBlock op
forall op. ParameterType -> ContractBlock op
CBParam (ParameterType -> ContractBlock op)
-> ParameterType -> ContractBlock op
forall a b. (a -> b) -> a -> b
$ Ty -> FieldAnn -> ParameterType
Untyped.ParameterType Ty
p' FieldAnn
rootAnn
([Exp x], [Annotation])
_ -> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (ContractBlock op))
-> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
Text
"Expected 'parameter' block without annotations and exactly 1 argument"
mkCBStorage
:: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBStorage :: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBStorage Exp x
e [Exp x]
args [Annotation]
anns = case ([Exp x]
args, [Annotation]
anns) of
([Exp x
s], []) -> do
Ty
s' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Ty Exp x
s
pure $ Ty -> ContractBlock op
forall op. Ty -> ContractBlock op
CBStorage Ty
s'
([Exp x], [Annotation])
_ -> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (ContractBlock op))
-> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
Text
"Expected 'storage' block without annotations and exactly 1 argument"
mkCBCode
:: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBCode :: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBCode Exp x
e [Exp x]
args [Annotation]
anns = case ([Exp x]
args, [Annotation]
anns) of
([Exp x
ops], []) -> do
[op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
pure $ [op] -> ContractBlock op
forall op. [op] -> ContractBlock op
CBCode [op]
ops'
([Exp x], [Annotation])
_ -> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (ContractBlock op))
-> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
Text
"Expected 'code' block without annotations"
mkCBView
:: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBView :: Exp x
-> [Exp x]
-> [Annotation]
-> Either (FromExpError x) (ContractBlock op)
mkCBView Exp x
e [Exp x]
args [Annotation]
anns = case ([Exp x]
args, [Annotation]
anns) of
([Exp x
name, Exp x
arg, Exp x
ret, Exp x
ops], []) -> do
ViewName
name' <- Exp x -> Either (FromExpError x) ViewName
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
name
Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
Ty
ret' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
ret
[op]
ops' <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @[op] Exp x
ops
pure $ View' op -> ContractBlock op
forall op. View' op -> ContractBlock op
CBView (View' op -> ContractBlock op) -> View' op -> ContractBlock op
forall a b. (a -> b) -> a -> b
$ ViewName -> Ty -> Ty -> [op] -> View' op
forall op. ViewName -> Ty -> Ty -> [op] -> View' op
Untyped.View ViewName
name' Ty
arg' Ty
ret' [op]
ops'
([Exp x]
_, Annotation
_ : [Annotation]
_) ->
FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (ContractBlock op))
-> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
Text
"Expected 'view' block without annotations"
([Exp x]
_, []) ->
FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (ContractBlock op))
-> FromExpError x -> Either (FromExpError x) (ContractBlock op)
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
Text
"Invalid 'view' block, expected 4 expressions in it"
instance FromExp x Untyped.T where
fromExp :: Exp x -> Either (FromExpError x) T
fromExp Exp x
e = case Exp x
e of
ExpPrim' XExpPrim x
_ MichelinePrimitive
"key" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TKey
ExpPrim' XExpPrim x
_ MichelinePrimitive
"unit" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TUnit
ExpPrim' XExpPrim x
_ MichelinePrimitive
"signature" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TSignature
ExpPrim' XExpPrim x
_ MichelinePrimitive
"chain_id" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TChainId
ExpPrim' XExpPrim x
_ MichelinePrimitive
"option" [Exp x
arg] [] -> do
Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
pure $ Ty -> T
Untyped.TOption Ty
arg'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"list" [Exp x
arg] [] -> do
Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
pure $ Ty -> T
Untyped.TList Ty
arg'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"set" [Exp x
arg] [] -> do
Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
pure $ Ty -> T
Untyped.TSet Ty
arg'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"operation" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TOperation
ExpPrim' XExpPrim x
_ MichelinePrimitive
"contract" [Exp x
arg] [] -> do
Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
pure $ Ty -> T
Untyped.TContract Ty
arg'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"ticket" [Exp x
arg] [] -> do
Ty
arg' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg
pure $ Ty -> T
Untyped.TTicket Ty
arg'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"or" [Exp x
arg1, Exp x
arg2] [] -> do
let as1 :: AnnotationSet
as1 = [Annotation] -> AnnotationSet
toAnnSet ([Annotation] -> AnnotationSet) -> [Annotation] -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ Exp x
arg1 Exp x -> Getting [Annotation] (Exp x) [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. ((XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Getting [Annotation] (Exp x) [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> ([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind).
Lens' (MichelinePrimAp x) [Annotation]
mpaAnnotsL
let as2 :: AnnotationSet
as2 = [Annotation] -> AnnotationSet
toAnnSet ([Annotation] -> AnnotationSet) -> [Annotation] -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ Exp x
arg2 Exp x -> Getting [Annotation] (Exp x) [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. ((XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Getting [Annotation] (Exp x) [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> ([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind).
Lens' (MichelinePrimAp x) [Annotation]
mpaAnnotsL
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
as1 (Int
1, Int
1, Int
0)
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
as2 (Int
1, Int
1, Int
0)
let fa1 :: FieldAnn
fa1 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
as1
let fa2 :: FieldAnn
fa2 = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
as2
Ty
l <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp (Exp x -> Either (FromExpError x) Ty)
-> Exp x -> Either (FromExpError x) Ty
forall a b. (a -> b) -> a -> b
$ Exp x -> (Annotation -> Bool) -> Exp x
removeAnns Exp x
arg1 Annotation -> Bool
isAnnotationField
Ty
r <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp (Exp x -> Either (FromExpError x) Ty)
-> Exp x -> Either (FromExpError x) Ty
forall a b. (a -> b) -> a -> b
$ Exp x -> (Annotation -> Bool) -> Exp x
removeAnns Exp x
arg2 Annotation -> Bool
isAnnotationField
pure $ FieldAnn -> FieldAnn -> Ty -> Ty -> T
Untyped.TOr FieldAnn
fa1 FieldAnn
fa2 Ty
l Ty
r
ExpPrim' XExpPrim x
_ MichelinePrimitive
"pair" [Exp x]
args [] -> do
NonEmpty (Exp x)
args2 <- case [Exp x] -> Maybe (NonEmpty (Exp x))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Exp x]
args Maybe (NonEmpty (Exp x))
-> (NonEmpty (Exp x) -> Maybe (NonEmpty (Exp x)))
-> Maybe (NonEmpty (Exp x))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NonEmpty (Exp x) -> Maybe (NonEmpty (Exp x))
forall a. NonEmpty a -> Maybe (NonEmpty a)
forbidSingletonList of
Maybe (NonEmpty (Exp x))
Nothing -> FromExpError x -> Either (FromExpError x) (NonEmpty (Exp x))
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) (NonEmpty (Exp x)))
-> FromExpError x -> Either (FromExpError x) (NonEmpty (Exp x))
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
Text
"Expected a pair with at least 2 arguments"
Just NonEmpty (Exp x)
as -> NonEmpty (Exp x) -> Either (FromExpError x) (NonEmpty (Exp x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty (Exp x)
as
NonEmpty (Ty, FieldAnn, VarAnn)
tyInfos <- NonEmpty (Exp x)
-> (Exp x -> Either (FromExpError x) (Ty, FieldAnn, VarAnn))
-> Either (FromExpError x) (NonEmpty (Ty, FieldAnn, VarAnn))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty (Exp x)
args2 \Exp x
arg -> do
let as :: AnnotationSet
as = [Annotation] -> AnnotationSet
toAnnSet ([Annotation] -> AnnotationSet) -> [Annotation] -> AnnotationSet
forall a b. (a -> b) -> a -> b
$ Exp x
arg Exp x -> Getting [Annotation] (Exp x) [Annotation] -> [Annotation]
forall s a. s -> Getting a s a -> a
^. ((XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Const [Annotation] (Exp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> Getting [Annotation] (Exp x) [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x))
-> ([Annotation] -> Const [Annotation] [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Const [Annotation] (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Const [Annotation] [Annotation])
-> MichelinePrimAp x -> Const [Annotation] (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind).
Lens' (MichelinePrimAp x) [Annotation]
mpaAnnotsL
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
as (Int
1, Int
1, Int
1)
let fa :: FieldAnn
fa = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @FieldTag AnnotationSet
as
let va :: VarAnn
va = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @VarTag AnnotationSet
as
Ty
ty <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp (Exp x -> Either (FromExpError x) Ty)
-> Exp x -> Either (FromExpError x) Ty
forall a b. (a -> b) -> a -> b
$ Exp x -> (Annotation -> Bool) -> Exp x
removeAnns Exp x
arg
(Annotation -> Bool
isAnnotationField (Annotation -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall a. Boolean a => a -> a -> a
|| Annotation -> Bool
isAnnotationVariable)
return (Ty
ty, FieldAnn
fa, VarAnn
va)
let combiner :: (Ty, FieldAnn, VarAnn)
-> (Ty, FieldAnn, VarAnn) -> (Ty, Annotation a, Annotation a)
combiner (Ty
ty1, FieldAnn
fa1, VarAnn
va1) (Ty
ty2, FieldAnn
fa2, VarAnn
va2) =
( T -> TypeAnn -> Ty
Ty (FieldAnn -> FieldAnn -> VarAnn -> VarAnn -> Ty -> Ty -> T
Untyped.TPair FieldAnn
fa1 FieldAnn
fa2 VarAnn
va1 VarAnn
va2 Ty
ty1 Ty
ty2) TypeAnn
forall {k} (a :: k). Annotation a
noAnn
, Annotation a
forall {k} (a :: k). Annotation a
noAnn
, Annotation a
forall {k} (a :: k). Annotation a
noAnn
)
let (Ty T
tRes TypeAnn
_, FieldAnn
_, VarAnn
_) = ((Ty, FieldAnn, VarAnn)
-> (Ty, FieldAnn, VarAnn) -> (Ty, FieldAnn, VarAnn))
-> NonEmpty (Ty, FieldAnn, VarAnn) -> (Ty, FieldAnn, VarAnn)
forall a. (a -> a -> a) -> NonEmpty a -> a
foldr1 (Ty, FieldAnn, VarAnn)
-> (Ty, FieldAnn, VarAnn) -> (Ty, FieldAnn, VarAnn)
forall {k} {k} {a :: k} {a :: k}.
(Ty, FieldAnn, VarAnn)
-> (Ty, FieldAnn, VarAnn) -> (Ty, Annotation a, Annotation a)
combiner NonEmpty (Ty, FieldAnn, VarAnn)
tyInfos
T -> Either (FromExpError x) T
forall (m :: * -> *) a. Monad m => a -> m a
return T
tRes
ExpPrim' XExpPrim x
_ MichelinePrimitive
"lambda" [Exp x]
args [] -> (Ty -> Ty -> T)
-> [Exp x] -> Exp x -> Text -> Either (FromExpError x) T
mkDoubleParamType Ty -> Ty -> T
Untyped.TLambda [Exp x]
args Exp x
e
Text
"Expected a lambda with input and output types"
ExpPrim' XExpPrim x
_ MichelinePrimitive
"map" [Exp x]
args [] -> (Ty -> Ty -> T)
-> [Exp x] -> Exp x -> Text -> Either (FromExpError x) T
mkDoubleParamType Ty -> Ty -> T
Untyped.TMap [Exp x]
args Exp x
e
Text
"Expected a map with key and value types"
ExpPrim' XExpPrim x
_ MichelinePrimitive
"big_map" [Exp x]
args [] -> (Ty -> Ty -> T)
-> [Exp x] -> Exp x -> Text -> Either (FromExpError x) T
mkDoubleParamType Ty -> Ty -> T
Untyped.TBigMap [Exp x]
args Exp x
e
Text
"Expected a big_map with key and value types"
ExpPrim' XExpPrim x
_ MichelinePrimitive
"int" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TInt
ExpPrim' XExpPrim x
_ MichelinePrimitive
"nat" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TNat
ExpPrim' XExpPrim x
_ MichelinePrimitive
"string" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TString
ExpPrim' XExpPrim x
_ MichelinePrimitive
"bytes" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBytes
ExpPrim' XExpPrim x
_ MichelinePrimitive
"mutez" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TMutez
ExpPrim' XExpPrim x
_ MichelinePrimitive
"bool" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBool
ExpPrim' XExpPrim x
_ MichelinePrimitive
"key_hash" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TKeyHash
ExpPrim' XExpPrim x
_ MichelinePrimitive
"bls12_381_fr" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBls12381Fr
ExpPrim' XExpPrim x
_ MichelinePrimitive
"bls12_381_g1" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBls12381G1
ExpPrim' XExpPrim x
_ MichelinePrimitive
"bls12_381_g2" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TBls12381G2
ExpPrim' XExpPrim x
_ MichelinePrimitive
"timestamp" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TTimestamp
ExpPrim' XExpPrim x
_ MichelinePrimitive
"address" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TAddress
ExpPrim' XExpPrim x
_ MichelinePrimitive
"chest" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TChest
ExpPrim' XExpPrim x
_ MichelinePrimitive
"chest_key" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TChestKey
ExpPrim' XExpPrim x
_ MichelinePrimitive
"tx_rollup_l2_address" [] [] ->
FromExpError x -> Either (FromExpError x) T
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) T)
-> FromExpError x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Transaction rollups are not supported"
ExpPrim' XExpPrim x
_ MichelinePrimitive
"never" [] [] -> T -> Either (FromExpError x) T
forall (f :: * -> *) a. Applicative f => a -> f a
pure T
Untyped.TNever
ExpPrim' XExpPrim x
_ MichelinePrimitive
"sapling_state" [Exp x
n] [] -> do
Natural
n' <- Exp x -> Either (FromExpError x) Natural
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
pure $ Natural -> T
Untyped.TSaplingState Natural
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"sapling_transaction" [Exp x
n] [] -> do
Natural
n' <- Exp x -> Either (FromExpError x) Natural
forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
n
pure $ Natural -> T
Untyped.TSaplingTransaction Natural
n'
ExpPrim' XExpPrim x
_ MichelinePrimitive
"sapling_transaction_deprecated" [Exp x]
_ [Annotation]
_ -> do
FromExpError x -> Either (FromExpError x) T
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) T)
-> FromExpError x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Use of deprecated type: sapling_transaction_deprecated"
Exp x
_ -> FromExpError x -> Either (FromExpError x) T
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) T)
-> FromExpError x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected a type"
where
mkDoubleParamType
:: (Ty -> Ty -> Untyped.T)
-> [Exp x]
-> Exp x
-> Text
-> Either (FromExpError x) Untyped.T
mkDoubleParamType :: (Ty -> Ty -> T)
-> [Exp x] -> Exp x -> Text -> Either (FromExpError x) T
mkDoubleParamType Ty -> Ty -> T
ctor [Exp x]
args Exp x
expr Text
msg = do
case [Exp x]
args of
[Exp x
arg1, Exp x
arg2] -> do
Ty
arg1' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg1
Ty
arg2' <- Exp x -> Either (FromExpError x) Ty
forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp Exp x
arg2
pure $ Ty -> Ty -> T
ctor Ty
arg1' Ty
arg2'
[Exp x]
_ -> FromExpError x -> Either (FromExpError x) T
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) T)
-> FromExpError x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
expr Text
msg
removeAnns :: Exp x -> (Annotation -> Bool) -> Exp x
removeAnns :: Exp x -> (Annotation -> Bool) -> Exp x
removeAnns Exp x
expr Annotation -> Bool
p =
Exp x
expr Exp x -> (Exp x -> Exp x) -> Exp x
forall a b. a -> (a -> b) -> b
& ((XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Identity (Exp x)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Identity (Exp x))
-> (([Annotation] -> Identity [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> Exp x
-> Identity (Exp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Identity [Annotation])
-> MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp x -> Identity (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind).
Lens' (MichelinePrimAp x) [Annotation]
mpaAnnotsL (([Annotation] -> Identity [Annotation])
-> Exp x -> Identity (Exp x))
-> ([Annotation] -> [Annotation]) -> Exp x -> Exp x
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Annotation -> Bool) -> [Annotation] -> [Annotation]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
forall a. Boolean a => a -> a
not (Bool -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Bool
p)
instance FromExp x Ty where
fromExp :: Exp x -> Either (FromExpError x) Ty
fromExp Exp x
e = case Exp x
e of
ExpPrim' XExpPrim x
ex MichelinePrimitive
primName [Exp x]
args [Annotation]
anns -> do
let annSet :: AnnotationSet
annSet = [Annotation] -> AnnotationSet
toAnnSet [Annotation]
anns
let ta :: TypeAnn
ta = forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
firstAnn @TypeTag AnnotationSet
annSet
Bool -> Either (FromExpError x) () -> Either (FromExpError x) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall tag. KnownAnnTag tag => AnnotationSet -> Annotation tag
secondAnn @TypeTag AnnotationSet
annSet TypeAnn -> TypeAnn -> Bool
forall a. Eq a => a -> a -> Bool
/= TypeAnn
forall {k} (a :: k). Annotation a
noAnn) (Either (FromExpError x) () -> Either (FromExpError x) ())
-> Either (FromExpError x) () -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$
FromExpError x -> Either (FromExpError x) ()
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) ())
-> FromExpError x -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e
Text
"Expected expression with at most 1 type annotation"
T
t <- forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Untyped.T (Exp x -> Either (FromExpError x) T)
-> Exp x -> Either (FromExpError x) T
forall a b. (a -> b) -> a -> b
$ XExpPrim x
-> MichelinePrimitive -> [Exp x] -> [Annotation] -> Exp x
forall (x :: ExpExtensionDescriptorKind).
XExpPrim x
-> MichelinePrimitive -> [Exp x] -> [Annotation] -> Exp x
ExpPrim' XExpPrim x
ex MichelinePrimitive
primName [Exp x]
args ([Annotation] -> Exp x) -> [Annotation] -> Exp x
forall a b. (a -> b) -> a -> b
$ (Annotation -> Bool) -> [Annotation] -> [Annotation]
forall a. (a -> Bool) -> [a] -> [a]
filter
(Bool -> Bool
forall a. Boolean a => a -> a
not (Bool -> Bool) -> (Annotation -> Bool) -> Annotation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> Bool
isAnnotationType) [Annotation]
anns
pure $ T -> TypeAnn -> Ty
Ty T
t TypeAnn
ta
Exp x
_ -> FromExpError x -> Either (FromExpError x) Ty
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) Ty)
-> FromExpError x -> Either (FromExpError x) Ty
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected a type"
instance FromExp x T where
fromExp :: Exp x -> Either (FromExpError x) T
fromExp =
(Ty -> T)
-> Either (FromExpError x) Ty -> Either (FromExpError x) T
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Ty -> T
fromUType (Either (FromExpError x) Ty -> Either (FromExpError x) T)
-> (Exp x -> Either (FromExpError x) Ty)
-> Exp x
-> Either (FromExpError x) T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: ExpExtensionDescriptorKind) a.
FromExp x a =>
Exp x -> Either (FromExpError x) a
fromExp @x @Untyped.Ty
instance (SingI inp, SingI out) => FromExp RegularExp (Instr '[inp] '[out]) where
fromExp :: Expression -> Either FromExpressionError (Instr '[inp] '[out])
fromExp Expression
expr =
forall a.
FromExp RegularExp a =>
Expression -> Either FromExpressionError a
fromExpression @(Value ('TLambda inp out)) Expression
expr Either FromExpressionError (Value ('TLambda inp out))
-> (Value ('TLambda inp out)
-> Either FromExpressionError (Instr '[inp] '[out]))
-> Either FromExpressionError (Instr '[inp] '[out])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
VLam (LambdaCode RemFail Instr '[inp] '[out]
instr) -> Instr '[inp] '[out]
-> Either FromExpressionError (Instr '[inp] '[out])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instr '[inp] '[out]
-> Either FromExpressionError (Instr '[inp] '[out]))
-> Instr '[inp] '[out]
-> Either FromExpressionError (Instr '[inp] '[out])
forall a b. (a -> b) -> a -> b
$ RemFail Instr '[inp] '[out] -> Instr '[inp] '[out]
forall {k} (instr :: k -> k -> *) (i :: k) (o :: k).
RemFail instr i o -> instr i o
rfAnyInstr RemFail Instr '[inp] '[out]
instr
VLam LambdaCodeRec{} -> FromExpressionError
-> Either FromExpressionError (Instr '[inp] '[out])
forall a b. a -> Either a b
Left (FromExpressionError
-> Either FromExpressionError (Instr '[inp] '[out]))
-> FromExpressionError
-> Either FromExpressionError (Instr '[inp] '[out])
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> FromExpressionError
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Expression
expr
Text
"Expected block of code, found Lambda_rec"
instance FromExp x ViewName where
fromExp :: Exp x -> Either (FromExpError x) ViewName
fromExp Exp x
e = case Exp x
e of
ExpString XExpString x
_ Text
s ->
(BadViewNameError -> FromExpError x)
-> Either BadViewNameError ViewName
-> Either (FromExpError x) ViewName
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e (Text -> FromExpError x)
-> (BadViewNameError -> Text) -> BadViewNameError -> FromExpError x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BadViewNameError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) (Either BadViewNameError ViewName
-> Either (FromExpError x) ViewName)
-> Either BadViewNameError ViewName
-> Either (FromExpError x) ViewName
forall a b. (a -> b) -> a -> b
$ Text -> Either BadViewNameError ViewName
mkViewName Text
s
Exp x
_ -> FromExpError x -> Either (FromExpError x) ViewName
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) ViewName)
-> FromExpError x -> Either (FromExpError x) ViewName
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected view name"
addTrimmedAnns
:: Exp x
-> [TypeAnn]
-> [FieldAnn]
-> [VarAnn]
-> Exp x
addTrimmedAnns :: forall (x :: ExpExtensionDescriptorKind).
Exp x -> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Exp x
addTrimmedAnns Exp x
e [TypeAnn]
tas [FieldAnn]
fas [VarAnn]
vas =
Exp x
e Exp x -> (Exp x -> Exp x) -> Exp x
forall a b. a -> (a -> b) -> b
& ((XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Identity (Exp x)
forall (d :: ExpExtensionDescriptorKind).
Prism' (Exp d) (XExpPrim d, MichelinePrimAp d)
_ExpPrim (((XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> Exp x -> Identity (Exp x))
-> (([Annotation] -> Identity [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> Exp x
-> Identity (Exp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x))
-> (([Annotation] -> Identity [Annotation])
-> MichelinePrimAp x -> Identity (MichelinePrimAp x))
-> ([Annotation] -> Identity [Annotation])
-> (XExpPrim x, MichelinePrimAp x)
-> Identity (XExpPrim x, MichelinePrimAp x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> Identity [Annotation])
-> MichelinePrimAp x -> Identity (MichelinePrimAp x)
forall (x :: ExpExtensionDescriptorKind).
Lens' (MichelinePrimAp x) [Annotation]
mpaAnnotsL (([Annotation] -> Identity [Annotation])
-> Exp x -> Identity (Exp x))
-> [Annotation] -> Exp x -> Exp x
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> [Annotation]
mkAnns [TypeAnn]
tas [FieldAnn]
fas [VarAnn]
vas
insertRootAnn :: HasCallStack => Expression -> RootAnn -> Expression
insertRootAnn :: HasCallStack => Expression -> FieldAnn -> Expression
insertRootAnn Expression
expr FieldAnn
rootAnn = case Expression
expr of
ExpPrim () MichelinePrimAp RegularExp
p
| FieldAnn
rootAnn FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldAnn
forall {k} (a :: k). Annotation a
noAnn -> MichelinePrimAp RegularExp -> Expression
expressionPrim MichelinePrimAp RegularExp
p
{ mpaAnnots :: [Annotation]
mpaAnnots = FieldAnn -> Annotation
AnnotationField FieldAnn
rootAnn Annotation -> [Annotation] -> [Annotation]
forall a. a -> [a] -> [a]
: MichelinePrimAp RegularExp -> [Annotation]
forall (x :: ExpExtensionDescriptorKind).
MichelinePrimAp x -> [Annotation]
mpaAnnots MichelinePrimAp RegularExp
p
}
| Bool
otherwise -> Expression
expr
Expression
_ -> Text -> Expression
forall a. HasCallStack => Text -> a
error (Text -> Expression) -> Text -> Expression
forall a b. (a -> b) -> a -> b
$ Text
"parameter is not a primitive: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expression
expr
checkAnnsCount
:: Exp x
-> AnnotationSet
-> (Int, Int, Int)
-> Either (FromExpError x) ()
checkAnnsCount :: forall (x :: ExpExtensionDescriptorKind).
Exp x
-> AnnotationSet -> (Int, Int, Int) -> Either (FromExpError x) ()
checkAnnsCount Exp x
e AnnotationSet
annSet maxCount :: (Int, Int, Int)
maxCount@(Int
maxTas, Int
maxFas, Int
maxVas) =
let actualCount :: (Int, Int, Int)
actualCount@(Int
tasCnt, Int
fasCnt, Int
vasCnt) = AnnotationSet -> (Int, Int, Int)
annsCount AnnotationSet
annSet
in Bool -> Either (FromExpError x) () -> Either (FromExpError x) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Int, Int, Int)
actualCount (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int, Int, Int)
maxCount) (Either (FromExpError x) () -> Either (FromExpError x) ())
-> Either (FromExpError x) () -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$
FromExpError x -> Either (FromExpError x) ()
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) ())
-> FromExpError x -> Either (FromExpError x) ()
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e (Text -> FromExpError x) -> Text -> FromExpError x
forall a b. (a -> b) -> a -> b
$ Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"Expected at most"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
maxTas Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" type annotations,"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
maxFas Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" field annotations,"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
maxVas Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" variable annotations"
, Builder
"but found:"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
tasCnt Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" type annotations,"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
fasCnt Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" field annotations,"
, Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall p. Buildable p => p -> Builder
build Int
vasCnt Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" variable annotations."
]
forbidSingletonList :: NonEmpty a -> Maybe (NonEmpty a)
forbidSingletonList :: forall a. NonEmpty a -> Maybe (NonEmpty a)
forbidSingletonList = \case
a
_ :| [] -> Maybe (NonEmpty a)
forall a. Maybe a
Nothing
NonEmpty a
x -> NonEmpty a -> Maybe (NonEmpty a)
forall a. a -> Maybe a
Just NonEmpty a
x
integralToExpr :: Integral i => i -> Expression
integralToExpr :: forall i. Integral i => i -> Expression
integralToExpr = Integer -> Expression
expressionInt (Integer -> Expression) -> (i -> Integer) -> i -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Integer
forall a. Integral a => a -> Integer
toInteger
integralFromExpr :: (Integral i, Bits i) => Exp x -> Either (FromExpError x) i
integralFromExpr :: forall i (x :: ExpExtensionDescriptorKind).
(Integral i, Bits i) =>
Exp x -> Either (FromExpError x) i
integralFromExpr Exp x
e = case Exp x
e of
ExpInt XExpInt x
_ Integer
v ->
FromExpError x -> Maybe i -> Either (FromExpError x) i
forall l r. l -> Maybe r -> Either l r
maybeToRight (Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Value is out of bounds")
(forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
fromIntegralMaybe @Integer Integer
v)
Exp x
_ -> FromExpError x -> Either (FromExpError x) i
forall a b. a -> Either a b
Left (FromExpError x -> Either (FromExpError x) i)
-> FromExpError x -> Either (FromExpError x) i
forall a b. (a -> b) -> a -> b
$ Exp x -> Text -> FromExpError x
forall (x :: ExpExtensionDescriptorKind).
Exp x -> Text -> FromExpError x
FromExpError Exp x
e Text
"Expected a number here"