morley-1.15.1: Developer tools for the Michelson Language
Safe HaskellNone
LanguageHaskell2010

Michelson.Typed.Arith

Contents

Description

Module, containing some boilerplate for support of arithmetic operations in Michelson language.

Synopsis

Documentation

class (Typeable n, Typeable m) => ArithOp aop (n :: T) (m :: T) where Source #

Class for binary arithmetic operation.

Takes binary operation marker as op parameter, types of left operand n and right operand m.

Typeable constraints in superclass are necessary for error messages.

Minimal complete definition

convergeArith, evalOp

Associated Types

type ArithRes aop n m :: T Source #

Type family ArithRes denotes the type resulting from computing operation op from operands of types n and m.

For instance, adding integer to natural produces integer, which is reflected in following instance of type family: ArithRes Add CNat CInt = CInt.

Methods

convergeArith :: proxy aop -> Notes n -> Notes m -> Either AnnConvergeError (Notes (ArithRes aop n m)) Source #

Converge the notes of given operands.

evalOp :: proxy aop -> Value' instr n -> Value' instr m -> Either (ArithError (Value' instr n) (Value' instr m)) (Value' instr (ArithRes aop n m)) Source #

Evaluate arithmetic operation on given operands.

commutativityProof :: Maybe $ Dict (ArithRes aop n m ~ ArithRes aop m n, ArithOp aop m n) Source #

An operation can marked as commutative, it does not affect its runtime behavior, but enables certain optimization in the optimizer. We conservatively consider operations non-commutative by default.

Note that there is one unusual case: AND works with int : nat but not with nat : int. That's how it's specified in Michelson.

Instances

Instances details
ArithOp Lsr 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Lsr 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Lsr -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Lsr 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Lsr -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Lsr 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Lsr 'TNat 'TNat ~ ArithRes Lsr 'TNat 'TNat, ArithOp Lsr 'TNat 'TNat) Source #

ArithOp Lsl 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Lsl 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Lsl -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Lsl 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Lsl -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Lsl 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Lsl 'TNat 'TNat ~ ArithRes Lsl 'TNat 'TNat, ArithOp Lsl 'TNat 'TNat) Source #

ArithOp Xor 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Xor 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Xor -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Xor 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Xor -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Xor 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Xor 'TNat 'TNat ~ ArithRes Xor 'TNat 'TNat, ArithOp Xor 'TNat 'TNat) Source #

ArithOp Xor 'TBool 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Xor 'TBool 'TBool :: T Source #

Methods

convergeArith :: proxy Xor -> Notes 'TBool -> Notes 'TBool -> Either AnnConvergeError (Notes (ArithRes Xor 'TBool 'TBool)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Xor -> Value' instr 'TBool -> Value' instr 'TBool -> Either (ArithError (Value' instr 'TBool) (Value' instr 'TBool)) (Value' instr (ArithRes Xor 'TBool 'TBool)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Xor 'TBool 'TBool ~ ArithRes Xor 'TBool 'TBool, ArithOp Xor 'TBool 'TBool) Source #

ArithOp And 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes And 'TInt 'TNat :: T Source #

Methods

convergeArith :: proxy And -> Notes 'TInt -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes And 'TInt 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy And -> Value' instr 'TInt -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TNat)) (Value' instr (ArithRes And 'TInt 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes And 'TInt 'TNat ~ ArithRes And 'TNat 'TInt, ArithOp And 'TNat 'TInt) Source #

ArithOp And 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes And 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy And -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes And 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy And -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes And 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes And 'TNat 'TNat ~ ArithRes And 'TNat 'TNat, ArithOp And 'TNat 'TNat) Source #

ArithOp And 'TBool 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes And 'TBool 'TBool :: T Source #

Methods

convergeArith :: proxy And -> Notes 'TBool -> Notes 'TBool -> Either AnnConvergeError (Notes (ArithRes And 'TBool 'TBool)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy And -> Value' instr 'TBool -> Value' instr 'TBool -> Either (ArithError (Value' instr 'TBool) (Value' instr 'TBool)) (Value' instr (ArithRes And 'TBool 'TBool)) Source #

commutativityProof :: Maybe $ Dict (ArithRes And 'TBool 'TBool ~ ArithRes And 'TBool 'TBool, ArithOp And 'TBool 'TBool) Source #

ArithOp Or 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Or 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Or -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Or 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Or -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Or 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Or 'TNat 'TNat ~ ArithRes Or 'TNat 'TNat, ArithOp Or 'TNat 'TNat) Source #

ArithOp Or 'TBool 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Or 'TBool 'TBool :: T Source #

Methods

convergeArith :: proxy Or -> Notes 'TBool -> Notes 'TBool -> Either AnnConvergeError (Notes (ArithRes Or 'TBool 'TBool)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Or -> Value' instr 'TBool -> Value' instr 'TBool -> Either (ArithError (Value' instr 'TBool) (Value' instr 'TBool)) (Value' instr (ArithRes Or 'TBool 'TBool)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Or 'TBool 'TBool ~ ArithRes Or 'TBool 'TBool, ArithOp Or 'TBool 'TBool) Source #

ArithOp Mul 'TInt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TInt 'TInt :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TInt -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Mul 'TInt 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TInt -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TInt)) (Value' instr (ArithRes Mul 'TInt 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TInt 'TInt ~ ArithRes Mul 'TInt 'TInt, ArithOp Mul 'TInt 'TInt) Source #

ArithOp Mul 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TInt 'TNat :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TInt -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Mul 'TInt 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TInt -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TNat)) (Value' instr (ArithRes Mul 'TInt 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TInt 'TNat ~ ArithRes Mul 'TNat 'TInt, ArithOp Mul 'TNat 'TInt) Source #

ArithOp Mul 'TInt 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TInt 'TBls12381Fr :: T Source #

ArithOp Mul 'TNat 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TNat 'TInt :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TNat -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Mul 'TNat 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TNat -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TInt)) (Value' instr (ArithRes Mul 'TNat 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TNat 'TInt ~ ArithRes Mul 'TInt 'TNat, ArithOp Mul 'TInt 'TNat) Source #

ArithOp Mul 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Mul 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Mul 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TNat 'TNat ~ ArithRes Mul 'TNat 'TNat, ArithOp Mul 'TNat 'TNat) Source #

ArithOp Mul 'TNat 'TMutez Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TNat 'TMutez :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TNat -> Notes 'TMutez -> Either AnnConvergeError (Notes (ArithRes Mul 'TNat 'TMutez)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TNat -> Value' instr 'TMutez -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TMutez)) (Value' instr (ArithRes Mul 'TNat 'TMutez)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TNat 'TMutez ~ ArithRes Mul 'TMutez 'TNat, ArithOp Mul 'TMutez 'TNat) Source #

ArithOp Mul 'TNat 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TNat 'TBls12381Fr :: T Source #

ArithOp Mul 'TMutez 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TMutez 'TNat :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TMutez -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Mul 'TMutez 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TMutez -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TMutez) (Value' instr 'TNat)) (Value' instr (ArithRes Mul 'TMutez 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TMutez 'TNat ~ ArithRes Mul 'TNat 'TMutez, ArithOp Mul 'TNat 'TMutez) Source #

ArithOp Mul 'TBls12381Fr 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381Fr 'TInt :: T Source #

ArithOp Mul 'TBls12381Fr 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381Fr 'TNat :: T Source #

ArithOp Mul 'TBls12381Fr 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381Fr 'TBls12381Fr :: T Source #

(Bls12381MulBadOrder Bls12381Fr Bls12381G1 :: Constraint) => ArithOp Mul 'TBls12381Fr 'TBls12381G1 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381Fr 'TBls12381G1 :: T Source #

(Bls12381MulBadOrder Bls12381Fr Bls12381G2 :: Constraint) => ArithOp Mul 'TBls12381Fr 'TBls12381G2 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381Fr 'TBls12381G2 :: T Source #

ArithOp Mul 'TBls12381G1 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381G1 'TBls12381Fr :: T Source #

ArithOp Mul 'TBls12381G2 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381G2 'TBls12381Fr :: T Source #

ArithOp Sub 'TInt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TInt 'TInt :: T Source #

Methods

convergeArith :: proxy Sub -> Notes 'TInt -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Sub 'TInt 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Sub -> Value' instr 'TInt -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TInt)) (Value' instr (ArithRes Sub 'TInt 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Sub 'TInt 'TInt ~ ArithRes Sub 'TInt 'TInt, ArithOp Sub 'TInt 'TInt) Source #

ArithOp Sub 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TInt 'TNat :: T Source #

Methods

convergeArith :: proxy Sub -> Notes 'TInt -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Sub 'TInt 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Sub -> Value' instr 'TInt -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TNat)) (Value' instr (ArithRes Sub 'TInt 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Sub 'TInt 'TNat ~ ArithRes Sub 'TNat 'TInt, ArithOp Sub 'TNat 'TInt) Source #

ArithOp Sub 'TNat 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TNat 'TInt :: T Source #

Methods

convergeArith :: proxy Sub -> Notes 'TNat -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Sub 'TNat 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Sub -> Value' instr 'TNat -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TInt)) (Value' instr (ArithRes Sub 'TNat 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Sub 'TNat 'TInt ~ ArithRes Sub 'TInt 'TNat, ArithOp Sub 'TInt 'TNat) Source #

ArithOp Sub 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Sub -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Sub 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Sub -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Sub 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Sub 'TNat 'TNat ~ ArithRes Sub 'TNat 'TNat, ArithOp Sub 'TNat 'TNat) Source #

ArithOp Sub 'TMutez 'TMutez Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TMutez 'TMutez :: T Source #

ArithOp Sub 'TTimestamp 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TTimestamp 'TInt :: T Source #

ArithOp Sub 'TTimestamp 'TTimestamp Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TTimestamp 'TTimestamp :: T Source #

ArithOp Add 'TInt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TInt 'TInt :: T Source #

Methods

convergeArith :: proxy Add -> Notes 'TInt -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Add 'TInt 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Add -> Value' instr 'TInt -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TInt)) (Value' instr (ArithRes Add 'TInt 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Add 'TInt 'TInt ~ ArithRes Add 'TInt 'TInt, ArithOp Add 'TInt 'TInt) Source #

ArithOp Add 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TInt 'TNat :: T Source #

Methods

convergeArith :: proxy Add -> Notes 'TInt -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Add 'TInt 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Add -> Value' instr 'TInt -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TNat)) (Value' instr (ArithRes Add 'TInt 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Add 'TInt 'TNat ~ ArithRes Add 'TNat 'TInt, ArithOp Add 'TNat 'TInt) Source #

ArithOp Add 'TInt 'TTimestamp Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TInt 'TTimestamp :: T Source #

ArithOp Add 'TNat 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TNat 'TInt :: T Source #

Methods

convergeArith :: proxy Add -> Notes 'TNat -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Add 'TNat 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Add -> Value' instr 'TNat -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TInt)) (Value' instr (ArithRes Add 'TNat 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Add 'TNat 'TInt ~ ArithRes Add 'TInt 'TNat, ArithOp Add 'TInt 'TNat) Source #

ArithOp Add 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Add -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Add 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Add -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Add 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Add 'TNat 'TNat ~ ArithRes Add 'TNat 'TNat, ArithOp Add 'TNat 'TNat) Source #

ArithOp Add 'TMutez 'TMutez Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TMutez 'TMutez :: T Source #

ArithOp Add 'TBls12381Fr 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TBls12381Fr 'TBls12381Fr :: T Source #

ArithOp Add 'TBls12381G1 'TBls12381G1 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TBls12381G1 'TBls12381G1 :: T Source #

ArithOp Add 'TBls12381G2 'TBls12381G2 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TBls12381G2 'TBls12381G2 :: T Source #

ArithOp Add 'TTimestamp 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TTimestamp 'TInt :: T Source #

class UnaryArithOp aop (n :: T) where Source #

Class for unary arithmetic operation.

Associated Types

type UnaryArithRes aop n :: T Source #

Methods

evalUnaryArithOp :: proxy aop -> Value' instr n -> Value' instr (UnaryArithRes aop n) Source #

Instances

Instances details
UnaryArithOp Ge 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Ge 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Ge -> Value' instr 'TInt -> Value' instr (UnaryArithRes Ge 'TInt) Source #

UnaryArithOp Le 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Le 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Le -> Value' instr 'TInt -> Value' instr (UnaryArithRes Le 'TInt) Source #

UnaryArithOp Gt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Gt 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Gt -> Value' instr 'TInt -> Value' instr (UnaryArithRes Gt 'TInt) Source #

UnaryArithOp Lt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Lt 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Lt -> Value' instr 'TInt -> Value' instr (UnaryArithRes Lt 'TInt) Source #

UnaryArithOp Neq 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neq 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neq -> Value' instr 'TInt -> Value' instr (UnaryArithRes Neq 'TInt) Source #

UnaryArithOp Eq' 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Eq' 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Eq' -> Value' instr 'TInt -> Value' instr (UnaryArithRes Eq' 'TInt) Source #

UnaryArithOp Not 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Not 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Not -> Value' instr 'TInt -> Value' instr (UnaryArithRes Not 'TInt) Source #

UnaryArithOp Not 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Not 'TNat :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Not -> Value' instr 'TNat -> Value' instr (UnaryArithRes Not 'TNat) Source #

UnaryArithOp Not 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Not 'TBool :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Not -> Value' instr 'TBool -> Value' instr (UnaryArithRes Not 'TBool) Source #

UnaryArithOp Neg 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neg 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neg -> Value' instr 'TInt -> Value' instr (UnaryArithRes Neg 'TInt) Source #

UnaryArithOp Neg 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neg 'TNat :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neg -> Value' instr 'TNat -> Value' instr (UnaryArithRes Neg 'TNat) Source #

UnaryArithOp Neg 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neg 'TBls12381Fr :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neg -> Value' instr 'TBls12381Fr -> Value' instr (UnaryArithRes Neg 'TBls12381Fr) Source #

UnaryArithOp Neg 'TBls12381G1 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neg 'TBls12381G1 :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neg -> Value' instr 'TBls12381G1 -> Value' instr (UnaryArithRes Neg 'TBls12381G1) Source #

UnaryArithOp Neg 'TBls12381G2 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neg 'TBls12381G2 :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neg -> Value' instr 'TBls12381G2 -> Value' instr (UnaryArithRes Neg 'TBls12381G2) Source #

UnaryArithOp Abs 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Abs 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Abs -> Value' instr 'TInt -> Value' instr (UnaryArithRes Abs 'TInt) Source #

class ToIntArithOp (n :: T) where Source #

Class for conversions to an integer value.

Methods

evalToIntOp :: Value' instr n -> Value' instr 'TInt Source #

Instances

Instances details
ToIntArithOp 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Methods

evalToIntOp :: forall (instr :: [T] -> [T] -> Type). Value' instr 'TNat -> Value' instr 'TInt Source #

ToIntArithOp 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Methods

evalToIntOp :: forall (instr :: [T] -> [T] -> Type). Value' instr 'TBls12381Fr -> Value' instr 'TInt Source #

data ArithError n m Source #

Represents an arithmetic error of the operation.

Instances

Instances details
(Eq n, Eq m) => Eq (ArithError n m) Source # 
Instance details

Defined in Michelson.Typed.Arith

Methods

(==) :: ArithError n m -> ArithError n m -> Bool #

(/=) :: ArithError n m -> ArithError n m -> Bool #

(Ord n, Ord m) => Ord (ArithError n m) Source # 
Instance details

Defined in Michelson.Typed.Arith

Methods

compare :: ArithError n m -> ArithError n m -> Ordering #

(<) :: ArithError n m -> ArithError n m -> Bool #

(<=) :: ArithError n m -> ArithError n m -> Bool #

(>) :: ArithError n m -> ArithError n m -> Bool #

(>=) :: ArithError n m -> ArithError n m -> Bool #

max :: ArithError n m -> ArithError n m -> ArithError n m #

min :: ArithError n m -> ArithError n m -> ArithError n m #

(Show n, Show m) => Show (ArithError n m) Source # 
Instance details

Defined in Michelson.Typed.Arith

Methods

showsPrec :: Int -> ArithError n m -> ShowS #

show :: ArithError n m -> String #

showList :: [ArithError n m] -> ShowS #

Generic (ArithError n m) Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type Rep (ArithError n m) :: Type -> Type #

Methods

from :: ArithError n m -> Rep (ArithError n m) x #

to :: Rep (ArithError n m) x -> ArithError n m #

(NFData n, NFData m) => NFData (ArithError n m) Source # 
Instance details

Defined in Michelson.Typed.Arith

Methods

rnf :: ArithError n m -> () #

(Show n, Show m) => Buildable (ArithError n m) Source # 
Instance details

Defined in Michelson.Typed.Arith

Methods

build :: ArithError n m -> Builder #

type Rep (ArithError n m) Source # 
Instance details

Defined in Michelson.Typed.Arith

data ShiftArithErrorType Source #

Denotes the error type occurred in the arithmetic shift operation.

Constructors

LslOverflow 
LsrUnderflow 

Instances

Instances details
Eq ShiftArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

Ord ShiftArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

Show ShiftArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

Generic ShiftArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type Rep ShiftArithErrorType :: Type -> Type #

NFData ShiftArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

Methods

rnf :: ShiftArithErrorType -> () #

Buildable ShiftArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

type Rep ShiftArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

type Rep ShiftArithErrorType = D1 ('MetaData "ShiftArithErrorType" "Michelson.Typed.Arith" "morley-1.15.1-inplace" 'False) (C1 ('MetaCons "LslOverflow" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "LsrUnderflow" 'PrefixI 'False) (U1 :: Type -> Type))

data MutezArithErrorType Source #

Denotes the error type occurred in the arithmetic operation involving mutez.

Instances

Instances details
Eq MutezArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

Ord MutezArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

Show MutezArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

Generic MutezArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type Rep MutezArithErrorType :: Type -> Type #

NFData MutezArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

Methods

rnf :: MutezArithErrorType -> () #

Buildable MutezArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

type Rep MutezArithErrorType Source # 
Instance details

Defined in Michelson.Typed.Arith

type Rep MutezArithErrorType = D1 ('MetaData "MutezArithErrorType" "Michelson.Typed.Arith" "morley-1.15.1-inplace" 'False) (C1 ('MetaCons "AddOverflow" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MulOverflow" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SubUnderflow" 'PrefixI 'False) (U1 :: Type -> Type)))

data Add Source #

Instances

Instances details
ArithOp Add 'TInt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TInt 'TInt :: T Source #

Methods

convergeArith :: proxy Add -> Notes 'TInt -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Add 'TInt 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Add -> Value' instr 'TInt -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TInt)) (Value' instr (ArithRes Add 'TInt 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Add 'TInt 'TInt ~ ArithRes Add 'TInt 'TInt, ArithOp Add 'TInt 'TInt) Source #

ArithOp Add 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TInt 'TNat :: T Source #

Methods

convergeArith :: proxy Add -> Notes 'TInt -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Add 'TInt 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Add -> Value' instr 'TInt -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TNat)) (Value' instr (ArithRes Add 'TInt 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Add 'TInt 'TNat ~ ArithRes Add 'TNat 'TInt, ArithOp Add 'TNat 'TInt) Source #

ArithOp Add 'TInt 'TTimestamp Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TInt 'TTimestamp :: T Source #

ArithOp Add 'TNat 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TNat 'TInt :: T Source #

Methods

convergeArith :: proxy Add -> Notes 'TNat -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Add 'TNat 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Add -> Value' instr 'TNat -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TInt)) (Value' instr (ArithRes Add 'TNat 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Add 'TNat 'TInt ~ ArithRes Add 'TInt 'TNat, ArithOp Add 'TInt 'TNat) Source #

ArithOp Add 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Add -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Add 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Add -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Add 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Add 'TNat 'TNat ~ ArithRes Add 'TNat 'TNat, ArithOp Add 'TNat 'TNat) Source #

ArithOp Add 'TMutez 'TMutez Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TMutez 'TMutez :: T Source #

ArithOp Add 'TBls12381Fr 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TBls12381Fr 'TBls12381Fr :: T Source #

ArithOp Add 'TBls12381G1 'TBls12381G1 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TBls12381G1 'TBls12381G1 :: T Source #

ArithOp Add 'TBls12381G2 'TBls12381G2 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TBls12381G2 'TBls12381G2 :: T Source #

ArithOp Add 'TTimestamp 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Add 'TTimestamp 'TInt :: T Source #

type ArithRes Add 'TInt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Add 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Add 'TInt 'TTimestamp Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Add 'TNat 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Add 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Add 'TMutez 'TMutez Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Add 'TBls12381Fr 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Add 'TBls12381G1 'TBls12381G1 Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Add 'TBls12381G2 'TBls12381G2 Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Add 'TTimestamp 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

data Sub Source #

Instances

Instances details
ArithOp Sub 'TInt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TInt 'TInt :: T Source #

Methods

convergeArith :: proxy Sub -> Notes 'TInt -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Sub 'TInt 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Sub -> Value' instr 'TInt -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TInt)) (Value' instr (ArithRes Sub 'TInt 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Sub 'TInt 'TInt ~ ArithRes Sub 'TInt 'TInt, ArithOp Sub 'TInt 'TInt) Source #

ArithOp Sub 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TInt 'TNat :: T Source #

Methods

convergeArith :: proxy Sub -> Notes 'TInt -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Sub 'TInt 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Sub -> Value' instr 'TInt -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TNat)) (Value' instr (ArithRes Sub 'TInt 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Sub 'TInt 'TNat ~ ArithRes Sub 'TNat 'TInt, ArithOp Sub 'TNat 'TInt) Source #

ArithOp Sub 'TNat 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TNat 'TInt :: T Source #

Methods

convergeArith :: proxy Sub -> Notes 'TNat -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Sub 'TNat 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Sub -> Value' instr 'TNat -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TInt)) (Value' instr (ArithRes Sub 'TNat 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Sub 'TNat 'TInt ~ ArithRes Sub 'TInt 'TNat, ArithOp Sub 'TInt 'TNat) Source #

ArithOp Sub 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Sub -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Sub 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Sub -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Sub 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Sub 'TNat 'TNat ~ ArithRes Sub 'TNat 'TNat, ArithOp Sub 'TNat 'TNat) Source #

ArithOp Sub 'TMutez 'TMutez Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TMutez 'TMutez :: T Source #

ArithOp Sub 'TTimestamp 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TTimestamp 'TInt :: T Source #

ArithOp Sub 'TTimestamp 'TTimestamp Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Sub 'TTimestamp 'TTimestamp :: T Source #

type ArithRes Sub 'TInt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Sub 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Sub 'TNat 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Sub 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Sub 'TMutez 'TMutez Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Sub 'TTimestamp 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Sub 'TTimestamp 'TTimestamp Source # 
Instance details

Defined in Michelson.Typed.Arith

data Mul Source #

Instances

Instances details
ArithOp Mul 'TInt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TInt 'TInt :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TInt -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Mul 'TInt 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TInt -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TInt)) (Value' instr (ArithRes Mul 'TInt 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TInt 'TInt ~ ArithRes Mul 'TInt 'TInt, ArithOp Mul 'TInt 'TInt) Source #

ArithOp Mul 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TInt 'TNat :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TInt -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Mul 'TInt 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TInt -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TNat)) (Value' instr (ArithRes Mul 'TInt 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TInt 'TNat ~ ArithRes Mul 'TNat 'TInt, ArithOp Mul 'TNat 'TInt) Source #

ArithOp Mul 'TInt 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TInt 'TBls12381Fr :: T Source #

ArithOp Mul 'TNat 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TNat 'TInt :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TNat -> Notes 'TInt -> Either AnnConvergeError (Notes (ArithRes Mul 'TNat 'TInt)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TNat -> Value' instr 'TInt -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TInt)) (Value' instr (ArithRes Mul 'TNat 'TInt)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TNat 'TInt ~ ArithRes Mul 'TInt 'TNat, ArithOp Mul 'TInt 'TNat) Source #

ArithOp Mul 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Mul 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Mul 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TNat 'TNat ~ ArithRes Mul 'TNat 'TNat, ArithOp Mul 'TNat 'TNat) Source #

ArithOp Mul 'TNat 'TMutez Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TNat 'TMutez :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TNat -> Notes 'TMutez -> Either AnnConvergeError (Notes (ArithRes Mul 'TNat 'TMutez)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TNat -> Value' instr 'TMutez -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TMutez)) (Value' instr (ArithRes Mul 'TNat 'TMutez)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TNat 'TMutez ~ ArithRes Mul 'TMutez 'TNat, ArithOp Mul 'TMutez 'TNat) Source #

ArithOp Mul 'TNat 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TNat 'TBls12381Fr :: T Source #

ArithOp Mul 'TMutez 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TMutez 'TNat :: T Source #

Methods

convergeArith :: proxy Mul -> Notes 'TMutez -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Mul 'TMutez 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Mul -> Value' instr 'TMutez -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TMutez) (Value' instr 'TNat)) (Value' instr (ArithRes Mul 'TMutez 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Mul 'TMutez 'TNat ~ ArithRes Mul 'TNat 'TMutez, ArithOp Mul 'TNat 'TMutez) Source #

ArithOp Mul 'TBls12381Fr 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381Fr 'TInt :: T Source #

ArithOp Mul 'TBls12381Fr 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381Fr 'TNat :: T Source #

ArithOp Mul 'TBls12381Fr 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381Fr 'TBls12381Fr :: T Source #

(Bls12381MulBadOrder Bls12381Fr Bls12381G1 :: Constraint) => ArithOp Mul 'TBls12381Fr 'TBls12381G1 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381Fr 'TBls12381G1 :: T Source #

(Bls12381MulBadOrder Bls12381Fr Bls12381G2 :: Constraint) => ArithOp Mul 'TBls12381Fr 'TBls12381G2 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381Fr 'TBls12381G2 :: T Source #

ArithOp Mul 'TBls12381G1 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381G1 'TBls12381Fr :: T Source #

ArithOp Mul 'TBls12381G2 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Mul 'TBls12381G2 'TBls12381Fr :: T Source #

type ArithRes Mul 'TInt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TInt 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TNat 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TNat 'TMutez Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TNat 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TMutez 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TBls12381Fr 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TBls12381Fr 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TBls12381Fr 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TBls12381Fr 'TBls12381G1 Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TBls12381Fr 'TBls12381G2 Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TBls12381G1 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Mul 'TBls12381G2 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

data Abs Source #

Instances

Instances details
UnaryArithOp Abs 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Abs 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Abs -> Value' instr 'TInt -> Value' instr (UnaryArithRes Abs 'TInt) Source #

type UnaryArithRes Abs 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

data Neg Source #

Instances

Instances details
UnaryArithOp Neg 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neg 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neg -> Value' instr 'TInt -> Value' instr (UnaryArithRes Neg 'TInt) Source #

UnaryArithOp Neg 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neg 'TNat :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neg -> Value' instr 'TNat -> Value' instr (UnaryArithRes Neg 'TNat) Source #

UnaryArithOp Neg 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neg 'TBls12381Fr :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neg -> Value' instr 'TBls12381Fr -> Value' instr (UnaryArithRes Neg 'TBls12381Fr) Source #

UnaryArithOp Neg 'TBls12381G1 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neg 'TBls12381G1 :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neg -> Value' instr 'TBls12381G1 -> Value' instr (UnaryArithRes Neg 'TBls12381G1) Source #

UnaryArithOp Neg 'TBls12381G2 Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neg 'TBls12381G2 :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neg -> Value' instr 'TBls12381G2 -> Value' instr (UnaryArithRes Neg 'TBls12381G2) Source #

type UnaryArithRes Neg 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

type UnaryArithRes Neg 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type UnaryArithRes Neg 'TBls12381Fr Source # 
Instance details

Defined in Michelson.Typed.Arith

type UnaryArithRes Neg 'TBls12381G1 Source # 
Instance details

Defined in Michelson.Typed.Arith

type UnaryArithRes Neg 'TBls12381G2 Source # 
Instance details

Defined in Michelson.Typed.Arith

data Or Source #

Instances

Instances details
ArithOp Or 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Or 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Or -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Or 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Or -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Or 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Or 'TNat 'TNat ~ ArithRes Or 'TNat 'TNat, ArithOp Or 'TNat 'TNat) Source #

ArithOp Or 'TBool 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Or 'TBool 'TBool :: T Source #

Methods

convergeArith :: proxy Or -> Notes 'TBool -> Notes 'TBool -> Either AnnConvergeError (Notes (ArithRes Or 'TBool 'TBool)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Or -> Value' instr 'TBool -> Value' instr 'TBool -> Either (ArithError (Value' instr 'TBool) (Value' instr 'TBool)) (Value' instr (ArithRes Or 'TBool 'TBool)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Or 'TBool 'TBool ~ ArithRes Or 'TBool 'TBool, ArithOp Or 'TBool 'TBool) Source #

type ArithRes Or 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Or 'TBool 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

data And Source #

Instances

Instances details
ArithOp And 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes And 'TInt 'TNat :: T Source #

Methods

convergeArith :: proxy And -> Notes 'TInt -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes And 'TInt 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy And -> Value' instr 'TInt -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TInt) (Value' instr 'TNat)) (Value' instr (ArithRes And 'TInt 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes And 'TInt 'TNat ~ ArithRes And 'TNat 'TInt, ArithOp And 'TNat 'TInt) Source #

ArithOp And 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes And 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy And -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes And 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy And -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes And 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes And 'TNat 'TNat ~ ArithRes And 'TNat 'TNat, ArithOp And 'TNat 'TNat) Source #

ArithOp And 'TBool 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes And 'TBool 'TBool :: T Source #

Methods

convergeArith :: proxy And -> Notes 'TBool -> Notes 'TBool -> Either AnnConvergeError (Notes (ArithRes And 'TBool 'TBool)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy And -> Value' instr 'TBool -> Value' instr 'TBool -> Either (ArithError (Value' instr 'TBool) (Value' instr 'TBool)) (Value' instr (ArithRes And 'TBool 'TBool)) Source #

commutativityProof :: Maybe $ Dict (ArithRes And 'TBool 'TBool ~ ArithRes And 'TBool 'TBool, ArithOp And 'TBool 'TBool) Source #

type ArithRes And 'TInt 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes And 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes And 'TBool 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

data Xor Source #

Instances

Instances details
ArithOp Xor 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Xor 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Xor -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Xor 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Xor -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Xor 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Xor 'TNat 'TNat ~ ArithRes Xor 'TNat 'TNat, ArithOp Xor 'TNat 'TNat) Source #

ArithOp Xor 'TBool 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Xor 'TBool 'TBool :: T Source #

Methods

convergeArith :: proxy Xor -> Notes 'TBool -> Notes 'TBool -> Either AnnConvergeError (Notes (ArithRes Xor 'TBool 'TBool)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Xor -> Value' instr 'TBool -> Value' instr 'TBool -> Either (ArithError (Value' instr 'TBool) (Value' instr 'TBool)) (Value' instr (ArithRes Xor 'TBool 'TBool)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Xor 'TBool 'TBool ~ ArithRes Xor 'TBool 'TBool, ArithOp Xor 'TBool 'TBool) Source #

type ArithRes Xor 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type ArithRes Xor 'TBool 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

data Not Source #

Instances

Instances details
UnaryArithOp Not 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Not 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Not -> Value' instr 'TInt -> Value' instr (UnaryArithRes Not 'TInt) Source #

UnaryArithOp Not 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Not 'TNat :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Not -> Value' instr 'TNat -> Value' instr (UnaryArithRes Not 'TNat) Source #

UnaryArithOp Not 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Not 'TBool :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Not -> Value' instr 'TBool -> Value' instr (UnaryArithRes Not 'TBool) Source #

type UnaryArithRes Not 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

type UnaryArithRes Not 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

type UnaryArithRes Not 'TBool Source # 
Instance details

Defined in Michelson.Typed.Arith

data Lsl Source #

Instances

Instances details
ArithOp Lsl 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Lsl 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Lsl -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Lsl 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Lsl -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Lsl 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Lsl 'TNat 'TNat ~ ArithRes Lsl 'TNat 'TNat, ArithOp Lsl 'TNat 'TNat) Source #

type ArithRes Lsl 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

data Lsr Source #

Instances

Instances details
ArithOp Lsr 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type ArithRes Lsr 'TNat 'TNat :: T Source #

Methods

convergeArith :: proxy Lsr -> Notes 'TNat -> Notes 'TNat -> Either AnnConvergeError (Notes (ArithRes Lsr 'TNat 'TNat)) Source #

evalOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Lsr -> Value' instr 'TNat -> Value' instr 'TNat -> Either (ArithError (Value' instr 'TNat) (Value' instr 'TNat)) (Value' instr (ArithRes Lsr 'TNat 'TNat)) Source #

commutativityProof :: Maybe $ Dict (ArithRes Lsr 'TNat 'TNat ~ ArithRes Lsr 'TNat 'TNat, ArithOp Lsr 'TNat 'TNat) Source #

type ArithRes Lsr 'TNat 'TNat Source # 
Instance details

Defined in Michelson.Typed.Arith

data Eq' Source #

Instances

Instances details
UnaryArithOp Eq' 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Eq' 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Eq' -> Value' instr 'TInt -> Value' instr (UnaryArithRes Eq' 'TInt) Source #

type UnaryArithRes Eq' 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

data Neq Source #

Instances

Instances details
UnaryArithOp Neq 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Neq 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Neq -> Value' instr 'TInt -> Value' instr (UnaryArithRes Neq 'TInt) Source #

type UnaryArithRes Neq 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

data Lt Source #

Instances

Instances details
UnaryArithOp Lt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Lt 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Lt -> Value' instr 'TInt -> Value' instr (UnaryArithRes Lt 'TInt) Source #

type UnaryArithRes Lt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

data Gt Source #

Instances

Instances details
UnaryArithOp Gt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Gt 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Gt -> Value' instr 'TInt -> Value' instr (UnaryArithRes Gt 'TInt) Source #

type UnaryArithRes Gt 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

data Le Source #

Instances

Instances details
UnaryArithOp Le 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Le 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Le -> Value' instr 'TInt -> Value' instr (UnaryArithRes Le 'TInt) Source #

type UnaryArithRes Le 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

data Ge Source #

Instances

Instances details
UnaryArithOp Ge 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

Associated Types

type UnaryArithRes Ge 'TInt :: T Source #

Methods

evalUnaryArithOp :: forall proxy (instr :: [T] -> [T] -> Type). proxy Ge -> Value' instr 'TInt -> Value' instr (UnaryArithRes Ge 'TInt) Source #

type UnaryArithRes Ge 'TInt Source # 
Instance details

Defined in Michelson.Typed.Arith

compareOp :: Comparable t => Value' i t -> Value' i t -> Integer Source #

Implementation for COMPARE instruction.

Misc

type family Bls12381MulBadOrder a1 a2 where ... Source #

Equations

Bls12381MulBadOrder a1 a2 = TypeError (((('Text "Multiplication of " :<>: 'ShowType a2) :<>: 'Text " and ") :<>: 'ShowType a1) :<>: 'Text " works only other way around")