From 6b00a609867ca09b94ecda75cb02dce93ee1a199 Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Mon, 27 Apr 2020 16:15:26 +0200 Subject: [PATCH 1/6] done --- src/passes/10-interpreter/interpreter.ml | 54 +++++++++---------- src/passes/12-compiler/compiler_program.ml | 8 +-- src/passes/12-compiler/uncompiler.ml | 14 ++--- .../2-concrete_to_imperative/cameligo.ml | 6 +-- .../2-concrete_to_imperative/pascaligo.ml | 8 +-- .../tezos_type_annotation.ml | 2 +- src/stages/1-ast_imperative/combinators.ml | 12 +++-- src/stages/1-ast_imperative/combinators.mli | 4 ++ src/stages/2-ast_sugar/combinators.mli | 8 +-- src/stages/3-ast_core/combinators.mli | 8 +-- src/stages/4-ast_typed/PP.ml | 8 +-- src/stages/4-ast_typed/PP_generic.ml | 4 +- src/stages/4-ast_typed/combinators.mli | 16 +++--- .../4-ast_typed/combinators_environment.mli | 6 +-- src/stages/4-ast_typed/types.ml | 8 +-- src/stages/4-ast_typed/types_utils.ml | 1 + src/stages/5-mini_c/PP.ml | 8 +-- src/stages/5-mini_c/combinators.mli | 8 +-- src/stages/5-mini_c/types.ml | 8 +-- src/stages/common/PP.ml | 8 +-- src/stages/common/types.ml | 8 +-- src/stages/ligo_interpreter/PP.ml | 6 +-- src/stages/ligo_interpreter/types.ml | 8 +-- src/test/typer_tests.ml | 10 ++-- src/test/vote_tests.ml | 2 +- 25 files changed, 118 insertions(+), 115 deletions(-) diff --git a/src/passes/10-interpreter/interpreter.ml b/src/passes/10-interpreter/interpreter.ml index 537e1b1ca..5b15b414c 100644 --- a/src/passes/10-interpreter/interpreter.ml +++ b/src/passes/10-interpreter/interpreter.ml @@ -13,8 +13,8 @@ let apply_comparison : Ast_typed.constant' -> value list -> value result = | ( comp , [ V_Ct (C_mutez a' ) ; V_Ct (C_mutez b' ) ] ) | ( comp , [ V_Ct (C_timestamp a') ; V_Ct (C_timestamp b') ] ) -> let f_op = match comp with - | C_EQ -> Int.equal - | C_NEQ -> fun a b -> not (Int.equal a b) + | C_EQ -> Z.equal + | C_NEQ -> fun a b -> not (Z.equal a b) | C_LT -> (<) | C_LE -> (<=) | C_GT -> (>) @@ -68,17 +68,17 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result = raise (Temporary_hack a') (*TODO This raise is here until we properly implement effects*) - | ( C_SIZE , [(V_Set l | V_List l)] ) -> return_ct @@ C_nat (List.length l) - | ( C_SIZE , [ V_Map l ] ) -> return_ct @@ C_nat (List.length l) - | ( C_SIZE , [ V_Ct (C_string s ) ] ) -> return_ct @@ C_nat (String.length s) - | ( C_SIZE , [ V_Ct (C_bytes b ) ] ) -> return_ct @@ C_nat (Bytes.length b) + | ( C_SIZE , [(V_Set l | V_List l)] ) -> return_ct @@ C_nat (Z.of_int @@ List.length l) + | ( C_SIZE , [ V_Map l ] ) -> return_ct @@ C_nat (Z.of_int @@ List.length l) + | ( C_SIZE , [ V_Ct (C_string s ) ] ) -> return_ct @@ C_nat (Z.of_int @@ String.length s) + | ( C_SIZE , [ V_Ct (C_bytes b ) ] ) -> return_ct @@ C_nat (Z.of_int @@ Bytes.length b) | ( C_NOT , [ V_Ct (C_bool a' ) ] ) -> return_ct @@ C_bool (not a') | ( C_INT , [ V_Ct (C_nat a') ] ) -> return_ct @@ C_int a' - | ( C_ABS , [ V_Ct (C_int a') ] ) -> return_ct @@ C_int (abs a') - | ( C_NEG , [ V_Ct (C_int a') ] ) -> return_ct @@ C_int (-a') + | ( C_ABS , [ V_Ct (C_int a') ] ) -> return_ct @@ C_int (Z.abs a') + | ( C_NEG , [ V_Ct (C_int a') ] ) -> return_ct @@ C_int (Z.neg a') | ( C_SOME , [ v ] ) -> return_some v | ( C_IS_NAT , [ V_Ct (C_int a') ] ) -> - if a' > 0 then return_some @@ V_Ct (C_nat a') + if a' > Z.zero then return_some @@ V_Ct (C_nat a') else return_none () | ( C_FOLD_CONTINUE , [ v ] ) -> ok @@ v_pair (v_bool true , v) | ( C_FOLD_STOP , [ v ] ) -> ok @@ v_pair (v_bool false , v) @@ -96,24 +96,24 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result = ) (* binary *) | ( (C_EQ | C_NEQ | C_LT | C_LE | C_GT | C_GE) , _ ) -> apply_comparison c operands - | ( C_SUB , [ V_Ct (C_int a' | C_nat a') ; V_Ct (C_int b' | C_nat b') ] ) -> return_ct @@ C_int (a' - b') + | ( C_SUB , [ V_Ct (C_int a' | C_nat a') ; V_Ct (C_int b' | C_nat b') ] ) -> return_ct @@ C_int (Z.sub a' b') | ( C_CONS , [ v ; V_List vl ] ) -> ok @@ V_List (v::vl) - | ( C_ADD , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (a' + b') - | ( C_ADD , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (a' + b') - | ( C_ADD , [ V_Ct (C_nat a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (a' + b') - | ( C_ADD , [ V_Ct (C_int a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_int (a' + b') - | ( C_MUL , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (a' * b') - | ( C_MUL , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (a' * b') - | ( C_MUL , [ V_Ct (C_nat a' ) ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_mutez (a' * b') - | ( C_MUL , [ V_Ct (C_mutez a') ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_mutez (a' * b') - | ( C_DIV , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (a' / b') - | ( C_DIV , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (a' / b') - | ( C_DIV , [ V_Ct (C_mutez a') ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_mutez (a' / b') - | ( C_DIV , [ V_Ct (C_mutez a') ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_nat (a' / b') - | ( C_MOD , [ V_Ct (C_int a') ; V_Ct (C_int b') ] ) -> return_ct @@ C_nat (a' mod b') - | ( C_MOD , [ V_Ct (C_nat a') ; V_Ct (C_nat b') ] ) -> return_ct @@ C_nat (a' mod b') - | ( C_MOD , [ V_Ct (C_nat a') ; V_Ct (C_int b') ] ) -> return_ct @@ C_nat (a' mod b') - | ( C_MOD , [ V_Ct (C_int a') ; V_Ct (C_nat b') ] ) -> return_ct @@ C_nat (a' mod b') + | ( C_ADD , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (Z.add a' b') + | ( C_ADD , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (Z.add a' b') + | ( C_ADD , [ V_Ct (C_nat a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (Z.add a' b') + | ( C_ADD , [ V_Ct (C_int a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_int (Z.add a' b') + | ( C_MUL , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (Z.mul a' b') + | ( C_MUL , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (Z.mul a' b') + | ( C_MUL , [ V_Ct (C_nat a' ) ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_mutez (Z.mul a' b') + | ( C_MUL , [ V_Ct (C_mutez a') ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_mutez (Z.mul a' b') + | ( C_DIV , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (Z.div a' b') + | ( C_DIV , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (Z.div a' b') + | ( C_DIV , [ V_Ct (C_mutez a') ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_mutez (Z.div a' b') + | ( C_DIV , [ V_Ct (C_mutez a') ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_nat (Z.div a' b') + | ( C_MOD , [ V_Ct (C_int a') ; V_Ct (C_int b') ] ) -> return_ct @@ C_nat (Z.rem a' b') + | ( C_MOD , [ V_Ct (C_nat a') ; V_Ct (C_nat b') ] ) -> return_ct @@ C_nat (Z.rem a' b') + | ( C_MOD , [ V_Ct (C_nat a') ; V_Ct (C_int b') ] ) -> return_ct @@ C_nat (Z.rem a' b') + | ( C_MOD , [ V_Ct (C_int a') ; V_Ct (C_nat b') ] ) -> return_ct @@ C_nat (Z.rem a' b') | ( C_CONCAT , [ V_Ct (C_string a') ; V_Ct (C_string b') ] ) -> return_ct @@ C_string (a' ^ b') | ( C_CONCAT , [ V_Ct (C_bytes a' ) ; V_Ct (C_bytes b' ) ] ) -> return_ct @@ C_bytes (Bytes.cat a' b') | ( C_OR , [ V_Ct (C_bool a' ) ; V_Ct (C_bool b' ) ] ) -> return_ct @@ C_bool (a' || b') @@ -161,7 +161,7 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result = (* tertiary *) | ( C_SLICE , [ V_Ct (C_nat st) ; V_Ct (C_nat ed) ; V_Ct (C_string s) ] ) -> generic_try (simple_error "bad slice") @@ (fun () -> - V_Ct (C_string (String.sub s st ed)) + V_Ct (C_string (String.sub s (Z.to_int st) (Z.to_int ed))) ) | ( C_LIST_FOLD , [ V_Func_val (arg_name, body, env) ; V_List elts ; init ] ) -> bind_fold_list diff --git a/src/passes/12-compiler/compiler_program.ml b/src/passes/12-compiler/compiler_program.ml index 200bd0cf9..84ca34de8 100644 --- a/src/passes/12-compiler/compiler_program.ml +++ b/src/passes/12-compiler/compiler_program.ml @@ -170,10 +170,10 @@ let rec get_operator : constant' -> type_value -> expression list -> predicate r and translate_value (v:value) ty : michelson result = match v with | D_bool b -> ok @@ prim (if b then D_True else D_False) - | D_int n -> ok @@ int (Z.of_int n) - | D_nat n -> ok @@ int (Z.of_int n) - | D_timestamp n -> ok @@ int (Z.of_int n) - | D_mutez n -> ok @@ int (Z.of_int n) + | D_int n -> ok @@ int n + | D_nat n -> ok @@ int n + | D_timestamp n -> ok @@ int n + | D_mutez n -> ok @@ int n | D_string s -> ok @@ string s | D_bytes s -> ok @@ bytes s | D_unit -> ok @@ prim D_Unit diff --git a/src/passes/12-compiler/uncompiler.ml b/src/passes/12-compiler/uncompiler.ml index c3d5a0bc4..86e1a8cc9 100644 --- a/src/passes/12-compiler/uncompiler.ml +++ b/src/passes/12-compiler/uncompiler.ml @@ -22,14 +22,10 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result = ok @@ D_right b ) | (Int_t _), n -> - let%bind n = - trace_option (simple_error "too big to fit an int") @@ - Alpha_context.Script_int.to_int n in + let n = Alpha_context.Script_int.to_zint n in ok @@ D_int n | (Nat_t _), n -> - let%bind n = - trace_option (simple_error "too big to fit an int") @@ - Alpha_context.Script_int.to_int n in + let n = Alpha_context.Script_int.to_zint n in ok @@ D_nat n | (Chain_id_t _), id -> let str = Tezos_crypto.Base58.simple_encode @@ -43,14 +39,12 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result = | (Signature_t _ ), n -> ok @@ D_string (Signature.to_b58check n) | (Timestamp_t _), n -> - let n = - Z.to_int @@ - Alpha_context.Script_timestamp.to_zint n in + let n = Alpha_context.Script_timestamp.to_zint n in ok @@ D_timestamp n | (Mutez_t _), n -> let%bind n = generic_try (simple_error "too big to fit an int") @@ - (fun () -> Int64.to_int @@ Alpha_context.Tez.to_mutez n) in + (fun () -> Z.of_int64 @@ Alpha_context.Tez.to_mutez n) in ok @@ D_mutez n | (Bool_t _), b -> ok @@ D_bool b diff --git a/src/passes/2-concrete_to_imperative/cameligo.ml b/src/passes/2-concrete_to_imperative/cameligo.ml index c294e5eb8..2134526bc 100644 --- a/src/passes/2-concrete_to_imperative/cameligo.ml +++ b/src/passes/2-concrete_to_imperative/cameligo.ml @@ -565,17 +565,17 @@ let rec compile_expression : compile_binop "MOD" c | EArith (Int n) -> ( let (n , loc) = r_split n in - let n = Z.to_int @@ snd @@ n in + let n = snd @@ n in return @@ e_literal ~loc (Literal_int n) ) | EArith (Nat n) -> ( let (n , loc) = r_split n in - let n = Z.to_int @@ snd @@ n in + let n = snd @@ n in return @@ e_literal ~loc (Literal_nat n) ) | EArith (Mutez n) -> ( let (n , loc) = r_split n in - let n = Z.to_int @@ snd @@ n in + let n = snd @@ n in return @@ e_literal ~loc (Literal_mutez n) ) | EArith (Neg e) -> compile_unop "NEG" e diff --git a/src/passes/2-concrete_to_imperative/pascaligo.ml b/src/passes/2-concrete_to_imperative/pascaligo.ml index ec0a7256a..759295bc7 100644 --- a/src/passes/2-concrete_to_imperative/pascaligo.ml +++ b/src/passes/2-concrete_to_imperative/pascaligo.ml @@ -364,17 +364,17 @@ let rec compile_expression (t:Raw.expr) : expr result = compile_binop "MOD" c | EArith (Int n) -> ( let (n , loc) = r_split n in - let n = Z.to_int @@ snd n in + let n = snd n in return @@ e_literal ~loc (Literal_int n) ) | EArith (Nat n) -> ( let (n , loc) = r_split n in - let n = Z.to_int @@ snd @@ n in + let n = snd @@ n in return @@ e_literal ~loc (Literal_nat n) ) | EArith (Mutez n) -> ( let (n , loc) = r_split n in - let n = Z.to_int @@ snd @@ n in + let n = snd @@ n in return @@ e_literal ~loc (Literal_mutez n) ) | EArith (Neg e) -> compile_unop "NEG" e @@ -818,7 +818,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res let%bind start = compile_expression fi.assign.value.expr in let%bind bound = compile_expression fi.bound in let%bind step = match fi.step with - | None -> ok @@ e_int 1 + | None -> ok @@ e_int_z Z.one | Some step -> compile_expression step in let%bind body = compile_block fi.block.value in let%bind body = body @@ None in diff --git a/src/passes/3-self_ast_imperative/tezos_type_annotation.ml b/src/passes/3-self_ast_imperative/tezos_type_annotation.ml index 19118f125..133cdd9a6 100644 --- a/src/passes/3-self_ast_imperative/tezos_type_annotation.ml +++ b/src/passes/3-self_ast_imperative/tezos_type_annotation.ml @@ -25,7 +25,7 @@ let peephole_expression : expression -> expression result = fun e -> let%bind time = trace_option (bad_string_timestamp str e'.location) @@ Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation str in - let itime = Int64.to_int @@ Tezos_utils.Time.Protocol.to_seconds time in + let itime = Z.of_int64 @@ Tezos_utils.Time.Protocol.to_seconds time in return @@ E_literal (Literal_timestamp itime) | (E_literal (Literal_string str) , T_constant (TC_address)) -> return @@ E_literal (Literal_address str) | (E_literal (Literal_string str) , T_constant (TC_bytes)) -> ( diff --git a/src/stages/1-ast_imperative/combinators.ml b/src/stages/1-ast_imperative/combinators.ml index a7bb20945..61002aa34 100644 --- a/src/stages/1-ast_imperative/combinators.ml +++ b/src/stages/1-ast_imperative/combinators.ml @@ -82,13 +82,17 @@ let make_e ?(loc = Location.generated) expression_content = let e_literal ?loc l : expression = make_e ?loc @@ E_literal l let e_unit ?loc () : expression = make_e ?loc @@ E_literal (Literal_unit) -let e_int ?loc n : expression = make_e ?loc @@ E_literal (Literal_int n) -let e_nat ?loc n : expression = make_e ?loc @@ E_literal (Literal_nat n) -let e_timestamp ?loc n : expression = make_e ?loc @@ E_literal (Literal_timestamp n) +let e_int_z ?loc n : expression = make_e ?loc @@ E_literal (Literal_int n) +let e_int ?loc n : expression = e_int_z ?loc @@ Z.of_int n +let e_nat_z ?loc n : expression = make_e ?loc @@ E_literal (Literal_nat n) +let e_nat ?loc n : expression = e_nat_z ?loc @@ Z.of_int n +let e_timestamp_z ?loc n : expression = make_e ?loc @@ E_literal (Literal_timestamp n) +let e_timestamp ?loc n : expression = e_timestamp_z ?loc @@ Z.of_int n let e_bool ?loc b : expression = make_e ?loc @@ E_literal (Literal_bool b) let e_string ?loc s : expression = make_e ?loc @@ E_literal (Literal_string s) let e_address ?loc s : expression = make_e ?loc @@ E_literal (Literal_address s) -let e_mutez ?loc s : expression = make_e ?loc @@ E_literal (Literal_mutez s) +let e_mutez_z ?loc s : expression = make_e ?loc @@ E_literal (Literal_mutez s) +let e_mutez ?loc s : expression = e_mutez_z ?loc @@ Z.of_int s let e_signature ?loc s : expression = make_e ?loc @@ E_literal (Literal_signature s) let e_key ?loc s : expression = make_e ?loc @@ E_literal (Literal_key s) let e_key_hash ?loc s : expression = make_e ?loc @@ E_literal (Literal_key_hash s) diff --git a/src/stages/1-ast_imperative/combinators.mli b/src/stages/1-ast_imperative/combinators.mli index 50105895a..a35375610 100644 --- a/src/stages/1-ast_imperative/combinators.mli +++ b/src/stages/1-ast_imperative/combinators.mli @@ -54,6 +54,9 @@ val make_e : ?loc:Location.t -> expression_content -> expression val e_literal : ?loc:Location.t -> literal -> expression val e_unit : ?loc:Location.t -> unit -> expression +val e_int_z : ?loc:Location.t -> Z.t -> expression +val e_nat_z : ?loc:Location.t -> Z.t -> expression +val e_timestamp_z : ?loc:Location.t -> Z.t -> expression val e_int : ?loc:Location.t -> int -> expression val e_nat : ?loc:Location.t -> int -> expression val e_timestamp : ?loc:Location.t -> int -> expression @@ -64,6 +67,7 @@ val e_signature : ?loc:Location.t -> string -> expression val e_key : ?loc:Location.t -> string -> expression val e_key_hash : ?loc:Location.t -> string -> expression val e_chain_id : ?loc:Location.t -> string -> expression +val e_mutez_z : ?loc:Location.t -> Z.t -> expression val e_mutez : ?loc:Location.t -> int -> expression val e'_bytes : string -> expression_content result val e_bytes_hex : ?loc:Location.t -> string -> expression result diff --git a/src/stages/2-ast_sugar/combinators.mli b/src/stages/2-ast_sugar/combinators.mli index 7cd4b7921..95e937fab 100644 --- a/src/stages/2-ast_sugar/combinators.mli +++ b/src/stages/2-ast_sugar/combinators.mli @@ -49,9 +49,9 @@ val t_set : ?loc:Location.t -> type_expression -> type_expression val make_e : ?loc:Location.t -> expression_content -> expression val e_literal : ?loc:Location.t -> literal -> expression val e_unit : ?loc:Location.t -> unit -> expression -val e_int : ?loc:Location.t -> int -> expression -val e_nat : ?loc:Location.t -> int -> expression -val e_timestamp : ?loc:Location.t -> int -> expression +val e_int : ?loc:Location.t -> Z.t -> expression +val e_nat : ?loc:Location.t -> Z.t -> expression +val e_timestamp : ?loc:Location.t -> Z.t -> expression val e_bool : ?loc:Location.t -> bool -> expression val e_string : ?loc:Location.t -> string -> expression val e_address : ?loc:Location.t -> string -> expression @@ -59,7 +59,7 @@ val e_signature : ?loc:Location.t -> string -> expression val e_key : ?loc:Location.t -> string -> expression val e_key_hash : ?loc:Location.t -> string -> expression val e_chain_id : ?loc:Location.t -> string -> expression -val e_mutez : ?loc:Location.t -> int -> expression +val e_mutez : ?loc:Location.t -> Z.t -> expression val e'_bytes : string -> expression_content result val e_bytes_hex : ?loc:Location.t -> string -> expression result val e_bytes_raw : ?loc:Location.t -> bytes -> expression diff --git a/src/stages/3-ast_core/combinators.mli b/src/stages/3-ast_core/combinators.mli index 9a857b0f7..1a7ec2efa 100644 --- a/src/stages/3-ast_core/combinators.mli +++ b/src/stages/3-ast_core/combinators.mli @@ -50,9 +50,9 @@ val make_e : ?loc:Location.t -> expression_content -> expression val e_var : ?loc:Location.t -> string -> expression val e_literal : ?loc:Location.t -> literal -> expression val e_unit : ?loc:Location.t -> unit -> expression -val e_int : ?loc:Location.t -> int -> expression -val e_nat : ?loc:Location.t -> int -> expression -val e_timestamp : ?loc:Location.t -> int -> expression +val e_int : ?loc:Location.t -> Z.t -> expression +val e_nat : ?loc:Location.t -> Z.t -> expression +val e_timestamp : ?loc:Location.t -> Z.t -> expression val e_bool : ?loc:Location.t -> bool -> expression val e_string : ?loc:Location.t -> string -> expression val e_address : ?loc:Location.t -> string -> expression @@ -60,7 +60,7 @@ val e_signature : ?loc:Location.t -> string -> expression val e_key : ?loc:Location.t -> string -> expression val e_key_hash : ?loc:Location.t -> string -> expression val e_chain_id : ?loc:Location.t -> string -> expression -val e_mutez : ?loc:Location.t -> int -> expression +val e_mutez : ?loc:Location.t -> Z.t -> expression val e'_bytes : string -> expression_content result val e_bytes_hex : ?loc:Location.t -> string -> expression result val e_bytes_raw : ?loc:Location.t -> bytes -> expression diff --git a/src/stages/4-ast_typed/PP.ml b/src/stages/4-ast_typed/PP.ml index 25905b310..a615096e8 100644 --- a/src/stages/4-ast_typed/PP.ml +++ b/src/stages/4-ast_typed/PP.ml @@ -181,10 +181,10 @@ let literal ppf (l : literal) = | Literal_unit -> fprintf ppf "unit" | Literal_void -> fprintf ppf "void" | Literal_bool b -> fprintf ppf "%b" b - | Literal_int n -> fprintf ppf "%d" n - | Literal_nat n -> fprintf ppf "+%d" n - | Literal_timestamp n -> fprintf ppf "+%d" n - | Literal_mutez n -> fprintf ppf "%dmutez" n + | Literal_int z -> fprintf ppf "%a" Z.pp_print z + | Literal_nat z -> fprintf ppf "+%a" Z.pp_print z + | Literal_timestamp z -> fprintf ppf "+%a" Z.pp_print z + | Literal_mutez z -> fprintf ppf "%amutez" Z.pp_print z | Literal_string s -> fprintf ppf "%S" s | Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b) | Literal_address s -> fprintf ppf "@%S" s diff --git a/src/stages/4-ast_typed/PP_generic.ml b/src/stages/4-ast_typed/PP_generic.ml index 47f4f2551..d698c70e7 100644 --- a/src/stages/4-ast_typed/PP_generic.ml +++ b/src/stages/4-ast_typed/PP_generic.ml @@ -12,7 +12,7 @@ let needs_parens = { ); type_variable = (fun _ _ _ -> false) ; bool = (fun _ _ _ -> false) ; - int = (fun _ _ _ -> false) ; + z = (fun _ _ _ -> false) ; string = (fun _ _ _ -> false) ; bytes = (fun _ _ _ -> false) ; packed_internal_operation = (fun _ _ _ -> false) ; @@ -46,7 +46,7 @@ let op ppf = { ); type_variable = (fun _visitor () type_variable -> fprintf ppf "%a" Var.pp type_variable) ; bool = (fun _visitor () b -> fprintf ppf "%s" (if b then "true" else "false")) ; - int = (fun _visitor () i -> fprintf ppf "%d" i) ; + z = (fun _visitor () i -> fprintf ppf "%a" Z.pp_print i) ; string = (fun _visitor () str -> fprintf ppf "\"%s\"" str) ; bytes = (fun _visitor () _bytes -> fprintf ppf "bytes...") ; packed_internal_operation = (fun _visitor () _op -> fprintf ppf "Operation(...bytes)") ; diff --git a/src/stages/4-ast_typed/combinators.mli b/src/stages/4-ast_typed/combinators.mli index 9c7523e9e..6d842c16c 100644 --- a/src/stages/4-ast_typed/combinators.mli +++ b/src/stages/4-ast_typed/combinators.mli @@ -111,13 +111,13 @@ val ez_e_record : ( string * expression ) list -> expression val e_some : expression -> expression_content val e_none : unit -> expression_content val e_unit : unit -> expression_content -val e_int : int -> expression_content -val e_nat : int -> expression_content -val e_mutez : int -> expression_content +val e_int : Z.t -> expression_content +val e_nat : Z.t -> expression_content +val e_mutez : Z.t -> expression_content val e_bool : bool -> expression_content val e_string : string -> expression_content val e_bytes : bytes -> expression_content -val e_timestamp : int -> expression_content +val e_timestamp : Z.t -> expression_content val e_address : string -> expression_content val e_signature : string -> expression_content val e_key : string -> expression_content @@ -131,9 +131,9 @@ val e_variable : expression_variable -> expression_content val e_let_in : expression_variable -> inline -> expression -> expression -> expression_content val e_a_unit : full_environment -> expression -val e_a_int : int -> full_environment -> expression -val e_a_nat : int -> full_environment -> expression -val e_a_mutez : int -> full_environment -> expression +val e_a_int : Z.t -> full_environment -> expression +val e_a_nat : Z.t -> full_environment -> expression +val e_a_mutez : Z.t -> full_environment -> expression val e_a_bool : bool -> full_environment -> expression val e_a_string : string -> full_environment -> expression val e_a_address : string -> full_environment -> expression @@ -147,7 +147,7 @@ val e_a_variable : expression_variable -> type_expression -> full_environment -> val ez_e_a_record : ( label * expression ) list -> full_environment -> expression val e_a_let_in : expression_variable -> bool -> expression -> expression -> full_environment -> expression -val get_a_int : expression -> int result +val get_a_int : expression -> Z.t result val get_a_unit : expression -> unit result val get_a_bool : expression -> bool result val get_a_record_accessor : expression -> (expression * label) result diff --git a/src/stages/4-ast_typed/combinators_environment.mli b/src/stages/4-ast_typed/combinators_environment.mli index 783b1d6a6..55c345b47 100644 --- a/src/stages/4-ast_typed/combinators_environment.mli +++ b/src/stages/4-ast_typed/combinators_environment.mli @@ -3,9 +3,9 @@ open Types val make_a_e_empty : expression_content -> type_expression -> expression val e_a_empty_unit : expression -val e_a_empty_int : int -> expression -val e_a_empty_nat : int -> expression -val e_a_empty_mutez : int -> expression +val e_a_empty_int : Z.t -> expression +val e_a_empty_nat : Z.t -> expression +val e_a_empty_mutez : Z.t -> expression val e_a_empty_bool : bool -> expression val e_a_empty_string : string -> expression val e_a_empty_address : string -> expression diff --git a/src/stages/4-ast_typed/types.ml b/src/stages/4-ast_typed/types.ml index a25734369..cbf9bbd1b 100644 --- a/src/stages/4-ast_typed/types.ml +++ b/src/stages/4-ast_typed/types.ml @@ -78,10 +78,10 @@ and type_expression = { type literal = | Literal_unit | Literal_bool of bool - | Literal_int of int - | Literal_nat of int - | Literal_timestamp of int - | Literal_mutez of int + | Literal_int of z + | Literal_nat of z + | Literal_timestamp of z + | Literal_mutez of z | Literal_string of string | Literal_bytes of bytes | Literal_address of string diff --git a/src/stages/4-ast_typed/types_utils.ml b/src/stages/4-ast_typed/types_utils.ml index ffb1b683d..34e7c5668 100644 --- a/src/stages/4-ast_typed/types_utils.ml +++ b/src/stages/4-ast_typed/types_utils.ml @@ -10,6 +10,7 @@ type expression_ = Stage_common.Types.expression_ type expression_variable = Stage_common.Types.expression_variable type type_ = Stage_common.Types.type_ type type_variable = Stage_common.Types.type_variable +type z = Z.t type constructor' = | Constructor of string diff --git a/src/stages/5-mini_c/PP.ml b/src/stages/5-mini_c/PP.ml index ffaa52960..2543fd675 100644 --- a/src/stages/5-mini_c/PP.ml +++ b/src/stages/5-mini_c/PP.ml @@ -52,10 +52,10 @@ and type_constant ppf (tc:type_constant) : unit = let rec value ppf : value -> unit = function | D_bool b -> fprintf ppf "%b" b | D_operation _ -> fprintf ppf "operation[...bytes]" - | D_int n -> fprintf ppf "%d" n - | D_nat n -> fprintf ppf "+%d" n - | D_timestamp n -> fprintf ppf "+%d" n - | D_mutez n -> fprintf ppf "%dmutez" n + | D_int n -> fprintf ppf "%a" Z.pp_print n + | D_nat n -> fprintf ppf "+%a" Z.pp_print n + | D_timestamp n -> fprintf ppf "+%a" Z.pp_print n + | D_mutez n -> fprintf ppf "%amutez" Z.pp_print n | D_unit -> fprintf ppf "unit" | D_string s -> fprintf ppf "\"%s\"" s | D_bytes x -> diff --git a/src/stages/5-mini_c/combinators.mli b/src/stages/5-mini_c/combinators.mli index d61620589..bb8d31545 100644 --- a/src/stages/5-mini_c/combinators.mli +++ b/src/stages/5-mini_c/combinators.mli @@ -17,10 +17,10 @@ module Expression : sig end val get_bool : value ->bool result -val get_int : value -> int result -val get_nat : value -> int result -val get_mutez : value -> int result -val get_timestamp : value -> int result +val get_int : value -> Z.t result +val get_nat : value -> Z.t result +val get_mutez : value -> Z.t result +val get_timestamp : value -> Z.t result val get_string : value -> string result val get_bytes : value -> bytes result val get_unit : value -> unit result diff --git a/src/stages/5-mini_c/types.ml b/src/stages/5-mini_c/types.ml index 05e961573..646c34913 100644 --- a/src/stages/5-mini_c/types.ml +++ b/src/stages/5-mini_c/types.ml @@ -32,10 +32,10 @@ type inline = bool type value = | D_unit | D_bool of bool - | D_nat of int - | D_timestamp of int - | D_mutez of int - | D_int of int + | D_nat of Z.t + | D_timestamp of Z.t + | D_mutez of Z.t + | D_int of Z.t | D_string of string | D_bytes of bytes | D_pair of value * value diff --git a/src/stages/common/PP.ml b/src/stages/common/PP.ml index 2d784057d..93e46b96d 100644 --- a/src/stages/common/PP.ml +++ b/src/stages/common/PP.ml @@ -131,10 +131,10 @@ let literal ppf (l : literal) = | Literal_unit -> fprintf ppf "unit" | Literal_void -> fprintf ppf "void" | Literal_bool b -> fprintf ppf "%b" b - | Literal_int n -> fprintf ppf "%d" n - | Literal_nat n -> fprintf ppf "+%d" n - | Literal_timestamp n -> fprintf ppf "+%d" n - | Literal_mutez n -> fprintf ppf "%dmutez" n + | Literal_int z -> fprintf ppf "%a" Z.pp_print z + | Literal_nat z -> fprintf ppf "+%a" Z.pp_print z + | Literal_timestamp z -> fprintf ppf "+%a" Z.pp_print z + | Literal_mutez z -> fprintf ppf "%amutez" Z.pp_print z | Literal_string s -> fprintf ppf "%S" s | Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b) | Literal_address s -> fprintf ppf "@%S" s diff --git a/src/stages/common/types.ml b/src/stages/common/types.ml index c2f7fba56..8974eb905 100644 --- a/src/stages/common/types.ml +++ b/src/stages/common/types.ml @@ -163,10 +163,10 @@ end type literal = | Literal_unit | Literal_bool of bool - | Literal_int of int - | Literal_nat of int - | Literal_timestamp of int - | Literal_mutez of int + | Literal_int of Z.t + | Literal_nat of Z.t + | Literal_timestamp of Z.t + | Literal_mutez of Z.t | Literal_string of string | Literal_bytes of bytes | Literal_address of string diff --git a/src/stages/ligo_interpreter/PP.ml b/src/stages/ligo_interpreter/PP.ml index d0e419136..feb4a2054 100644 --- a/src/stages/ligo_interpreter/PP.ml +++ b/src/stages/ligo_interpreter/PP.ml @@ -1,14 +1,14 @@ open Types let rec pp_value : value -> string = function - | V_Ct (C_int i) -> Format.asprintf "%i : int" i - | V_Ct (C_nat n) -> Format.asprintf "%i : nat" n + | V_Ct (C_int i) -> Format.asprintf "%a : int" Z.pp_print i + | V_Ct (C_nat n) -> Format.asprintf "%a : nat" Z.pp_print n | V_Ct (C_string s) -> Format.asprintf "\"%s\" : string" s | V_Ct (C_unit) -> Format.asprintf "unit" | V_Ct (C_bool true) -> Format.asprintf "true" | V_Ct (C_bool false) -> Format.asprintf "false" | V_Ct (C_bytes b) -> Format.asprintf "0x%a : bytes" Hex.pp (Hex.of_bytes b) - | V_Ct (C_mutez i) -> Format.asprintf "%i : mutez" i + | V_Ct (C_mutez i) -> Format.asprintf "%a : mutez" Z.pp_print i | V_Ct (C_address s) -> Format.asprintf "\"%s\" : address" s | V_Ct _ -> Format.asprintf "PP, TODO" | V_Failure s -> Format.asprintf "\"%s\" : failure " s diff --git a/src/stages/ligo_interpreter/types.ml b/src/stages/ligo_interpreter/types.ml index 57c65adb9..eeb7ec1c3 100644 --- a/src/stages/ligo_interpreter/types.ml +++ b/src/stages/ligo_interpreter/types.ml @@ -16,10 +16,10 @@ type env = value Env.t and constant_val = | C_unit | C_bool of bool - | C_int of int - | C_nat of int - | C_timestamp of int - | C_mutez of int + | C_int of Z.t + | C_nat of Z.t + | C_timestamp of Z.t + | C_mutez of Z.t | C_string of string | C_bytes of bytes | C_address of string diff --git a/src/test/typer_tests.ml b/src/test/typer_tests.ml index 7dd3f1f42..0d33e2da4 100644 --- a/src/test/typer_tests.ml +++ b/src/test/typer_tests.ml @@ -8,7 +8,7 @@ module Simplified = Ast_core let int () : unit result = let open Combinators in - let pre = e_int 32 in + let pre = e_int (Z.of_int 32) in let open Typer in let e = Environment.full_empty in let state = Typer.Solver.initial_state in @@ -37,7 +37,7 @@ module TestExpressions = struct module E = O let unit () : unit result = test_expression I.(e_unit ()) O.(t_unit ()) - let int () : unit result = test_expression I.(e_int 32) O.(t_int ()) + let int () : unit result = test_expression I.(e_int (Z.of_int 32)) O.(t_int ()) let bool () : unit result = test_expression I.(e_bool true) O.(t_bool ()) let string () : unit result = test_expression I.(e_string "s") O.(t_string ()) let bytes () : unit result = @@ -51,7 +51,7 @@ module TestExpressions = struct let tuple () : unit result = test_expression - I.(e_record @@ LMap.of_list [(Label "0",e_int 32); (Label "1",e_string "foo")]) + I.(e_record @@ LMap.of_list [(Label "0",e_int (Z.of_int 32)); (Label "1",e_string "foo")]) O.(make_t_ez_record [("0",t_int ()); ("1",t_string ())]) let constructor () : unit result = @@ -60,12 +60,12 @@ module TestExpressions = struct (Typed.Constructor "bar", {ctor_type = Typed.t_string () ; michelson_annotation = None}) ] in test_expression ~env:(E.env_sum_type variant_foo_bar) - I.(e_constructor "foo" (e_int 32)) + I.(e_constructor "foo" (e_int (Z.of_int 32))) O.(make_t_ez_sum variant_foo_bar) let record () : unit result = test_expression - I.(e_record @@ LMap.of_list [(Label "foo", e_int 32); (Label "bar", e_string "foo")]) + I.(e_record @@ LMap.of_list [(Label "foo", e_int (Z.of_int 32)); (Label "bar", e_string "foo")]) O.(make_t_ez_record [("foo", t_int ()); ("bar", t_string ())]) diff --git a/src/test/vote_tests.ml b/src/test/vote_tests.ml index 5b1cb80a9..24cce7663 100644 --- a/src/test/vote_tests.ml +++ b/src/test/vote_tests.ml @@ -45,7 +45,7 @@ let init_vote () = (* let votes = List.assoc (Label "voters") storage' in let%bind votes' = extract_map votes in *) let yea = List.assoc (Label "yea") storage' in - let%bind () = Ast_core.Misc.assert_value_eq (yea, Ast_core.e_nat 1) in + let%bind () = Ast_core.Misc.assert_value_eq (yea, Ast_core.e_nat Z.one) in ok () let main = test_suite "Vote" [ From 0895467f748a4d92dcd800b9ea178cda362742fa Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Sat, 11 Jan 2020 19:37:38 -0600 Subject: [PATCH 2/6] Less dippy application --- src/bin/expect_tests/contract_tests.ml | 13 ++++++++----- src/passes/12-compiler/compiler_program.ml | 5 +++-- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index af6a644d7..cb8491ee3 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -10,10 +10,10 @@ let%expect_test _ = [%expect {| 1874 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ; - [%expect {| 1163 bytes |}] ; + [%expect {| 1169 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ; - [%expect {| 2867 bytes |}] ; + [%expect {| 2862 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ; [%expect {| 617 bytes |}] ; @@ -431,9 +431,10 @@ let%expect_test _ = DIP { DUP } ; SWAP ; DIP { DROP 4 } } ; - DIP { DUP } ; - SWAP ; UNIT ; + DIP 2 { DUP } ; + DIG 2 ; + SWAP ; EXEC ; DIP { DUP } ; PAIR ; @@ -621,7 +622,9 @@ let%expect_test _ = CDR ; CAR ; CDR ; - DIP { DIP 12 { DUP } ; DIG 12 } ; + DIP 13 { DUP } ; + DIG 13 ; + SWAP ; EXEC ; DIP { DUP } ; SWAP ; diff --git a/src/passes/12-compiler/compiler_program.ml b/src/passes/12-compiler/compiler_program.ml index 200bd0cf9..e19e2075e 100644 --- a/src/passes/12-compiler/compiler_program.ml +++ b/src/passes/12-compiler/compiler_program.ml @@ -251,11 +251,12 @@ and translate_expression (expr:expression) (env:environment) : michelson result ) | E_application (f , arg) -> ( trace (simple_error "Compiling quote application") @@ - let%bind f = translate_expression f env in + let%bind f = translate_expression f (Environment.add (Var.fresh (), arg.type_value) env) in let%bind arg = translate_expression arg env in return @@ seq [ arg ; - dip f ; + f ; + i_swap ; prim I_EXEC ; ] ) From 710f1699a629c8a90322396390c20c1e51be10eb Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Sat, 11 Jan 2020 19:44:10 -0600 Subject: [PATCH 3/6] Less dippy constants --- src/bin/expect_tests/contract_tests.ml | 1135 +++++++++++--------- src/passes/12-compiler/compiler_program.ml | 11 +- 2 files changed, 656 insertions(+), 490 deletions(-) diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index cb8491ee3..228211513 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -7,16 +7,16 @@ let bad_contract basename = let%expect_test _ = run_ligo_good [ "measure-contract" ; contract "coase.ligo" ; "main" ] ; - [%expect {| 1874 bytes |}] ; + [%expect {| 1842 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ; - [%expect {| 1169 bytes |}] ; + [%expect {| 1145 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ; - [%expect {| 2862 bytes |}] ; + [%expect {| 2795 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ; - [%expect {| 617 bytes |}] ; + [%expect {| 626 bytes |}] ; run_ligo_good [ "compile-parameter" ; contract "coase.ligo" ; "main" ; "Buy_single (record card_to_buy = 1n end)" ] ; [%expect {| (Left (Left 1)) |}] ; @@ -59,190 +59,121 @@ let%expect_test _ = let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "coase.ligo" ; "main" ] ; [%expect {| - { parameter - (or (or (nat %buy_single) (nat %sell_single)) - (pair %transfer_single (nat %card_to_transfer) (address %destination))) ; - storage - (pair (pair (map %card_patterns nat (pair (mutez %coefficient) (nat %quantity))) - (map %cards nat (pair (address %card_owner) (nat %card_pattern)))) - (nat %next_id)) ; - code { DUP ; - CDR ; - DIP { DUP } ; - SWAP ; - CAR ; +{ parameter + (or (or (nat %buy_single) (nat %sell_single)) + (pair %transfer_single (nat %card_to_transfer) (address %destination))) ; + storage + (pair (pair (map %card_patterns nat (pair (mutez %coefficient) (nat %quantity))) + (map %cards nat (pair (address %card_owner) (nat %card_pattern)))) + (nat %next_id)) ; + code { DUP ; + CDR ; + DIP { DUP } ; + SWAP ; + CAR ; + IF_LEFT + { DUP ; IF_LEFT - { DUP ; - IF_LEFT - { DUP ; - DIP { DIP 2 { DUP } ; DIG 2 } ; - PAIR ; - DUP ; - CAR ; - DIP { DUP } ; - SWAP ; - CDR ; - DIP { DUP } ; - SWAP ; - DIP { DUP ; CAR ; CAR } ; - GET ; - IF_NONE - { PUSH string "buy_single: No card pattern." ; FAILWITH } - { DUP ; DIP { DROP } } ; - DUP ; - CAR ; - DIP { DUP ; CDR ; PUSH nat 1 ; ADD } ; - MUL ; - DUP ; - AMOUNT ; - SWAP ; - COMPARE ; - GT ; - IF { PUSH string "Not enough money" ; FAILWITH } { PUSH unit Unit } ; - DIP 2 { DUP } ; - DIG 2 ; - DIP 3 { DUP } ; - DIG 3 ; - CDR ; - PUSH nat 1 ; - ADD ; - SWAP ; - CAR ; - PAIR ; - DIP 4 { DUP } ; - DIG 4 ; - DIP 6 { DUP } ; - DIG 6 ; - DIP { DIP { DUP } ; - SWAP ; - SOME ; - DIP { DIP 5 { DUP } ; DIG 5 ; CAR ; CAR } } ; - UPDATE ; - DIP { DUP ; CDR ; SWAP ; CAR ; CDR } ; - PAIR ; - PAIR ; - DUP ; - CDR ; - DIP { DIP 6 { DUP } ; - DIG 6 ; - SENDER ; - PAIR ; - SOME ; - DIP { DUP ; CAR ; CDR } } ; - UPDATE ; - DIP { DUP } ; - SWAP ; - DIP { DUP } ; - SWAP ; - DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; - SWAP ; - PAIR ; - PAIR ; - DUP ; - DIP { DUP } ; - SWAP ; - CDR ; - PUSH nat 1 ; - ADD ; - SWAP ; - CAR ; - PAIR ; - DUP ; - NIL operation ; - PAIR ; - DIP { DROP 12 } } - { DUP ; - DIP { DIP 2 { DUP } ; DIG 2 } ; - PAIR ; - DUP ; - CAR ; - DIP { DUP } ; - SWAP ; - CDR ; - DIP { DUP } ; - SWAP ; - DIP { DUP ; CAR ; CDR } ; - GET ; - IF_NONE - { PUSH string "sell_single: No card." ; FAILWITH } - { DUP ; DIP { DROP } } ; - DUP ; - CAR ; - SENDER ; - SWAP ; - COMPARE ; - NEQ ; - IF { PUSH string "This card doesn't belong to you" ; FAILWITH } - { PUSH unit Unit } ; - DIP { DUP } ; - SWAP ; - CDR ; - DIP { DIP 2 { DUP } ; DIG 2 ; CAR ; CAR } ; - GET ; - IF_NONE - { PUSH string "sell_single: No card pattern." ; FAILWITH } - { DUP ; DIP { DROP } } ; - DUP ; - DIP { DUP } ; - SWAP ; - CDR ; - PUSH nat 1 ; - SWAP ; - SUB ; - ABS ; - SWAP ; - CAR ; - PAIR ; - DIP 4 { DUP } ; - DIG 4 ; - DIP 4 { DUP } ; - DIG 4 ; - CDR ; - DIP { DIP { DUP } ; - SWAP ; - SOME ; - DIP { DIP 5 { DUP } ; DIG 5 ; CAR ; CAR } } ; - UPDATE ; - DIP { DUP ; CDR ; SWAP ; CAR ; CDR } ; - PAIR ; - PAIR ; - DIP 6 { DUP } ; - DIG 6 ; - DIP { DUP ; CAR ; CDR ; NONE (pair (address %card_owner) (nat %card_pattern)) } ; - UPDATE ; - DIP 2 { DUP } ; - DIG 2 ; - CAR ; - DIP { DIP 2 { DUP } ; DIG 2 ; CDR } ; - MUL ; - SENDER ; - CONTRACT unit ; - IF_NONE - { PUSH string "sell_single: No contract." ; FAILWITH } - { DUP ; DIP { DROP } } ; - DIP { DUP } ; - SWAP ; - DIP { DUP } ; - UNIT ; - TRANSFER_TOKENS ; - DUP ; - NIL operation ; - SWAP ; - CONS ; - DUP ; - DIP { DIP 5 { DUP } ; - DIG 5 ; - DIP 5 { DUP } ; - DIG 5 ; - DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; - SWAP ; - PAIR ; - PAIR } ; - PAIR ; - DIP { DROP 14 } } ; - DIP { DROP } } - { DUP ; - DIP { DIP { DUP } ; SWAP } ; + { DIP 2 { DUP } ; + DIG 2 ; + DIP { DUP } ; + SWAP ; + PAIR ; + DUP ; + CAR ; + DIP { DUP } ; + SWAP ; + CDR ; + DUP ; + CAR ; + CAR ; + DIP 2 { DUP } ; + DIG 2 ; + GET ; + IF_NONE + { PUSH string "buy_single: No card pattern." ; FAILWITH } + { DUP ; DIP { DROP } } ; + DUP ; + PUSH nat 1 ; + SWAP ; + CDR ; + ADD ; + DIP { DUP } ; + SWAP ; + CAR ; + MUL ; + DUP ; + AMOUNT ; + SWAP ; + COMPARE ; + GT ; + IF { PUSH string "Not enough money" ; FAILWITH } { PUSH unit Unit } ; + DIP 2 { DUP } ; + DIG 2 ; + PUSH nat 1 ; + DIP 4 { DUP } ; + DIG 4 ; + CDR ; + ADD ; + SWAP ; + CAR ; + PAIR ; + DIP 4 { DUP } ; + DIG 4 ; + DIP 5 { DUP } ; + DIG 5 ; + CAR ; + CAR ; + DIP 2 { DUP } ; + DIG 2 ; + DIP 8 { DUP } ; + DIG 8 ; + SWAP ; + SOME ; + SWAP ; + UPDATE ; + DIP { DUP ; CDR ; SWAP ; CAR ; CDR } ; + PAIR ; + PAIR ; + DUP ; + CAR ; + CDR ; + DIP 7 { DUP } ; + DIG 7 ; + SENDER ; + PAIR ; + DIP 2 { DUP } ; + DIG 2 ; + CDR ; + SWAP ; + SOME ; + SWAP ; + UPDATE ; + DIP { DUP } ; + SWAP ; + DIP { DUP } ; + SWAP ; + DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; + SWAP ; + PAIR ; + PAIR ; + DUP ; + PUSH nat 1 ; + DIP 2 { DUP } ; + DIG 2 ; + CDR ; + ADD ; + SWAP ; + CAR ; + PAIR ; + DUP ; + NIL operation ; + PAIR ; + DIP { DROP 12 } } + { DIP 2 { DUP } ; + DIG 2 ; + DIP { DUP } ; + SWAP ; PAIR ; DUP ; CAR ; @@ -254,191 +185,325 @@ let%expect_test _ = CDR ; DIP 2 { DUP } ; DIG 2 ; - CAR ; - DIP { DUP } ; GET ; IF_NONE - { PUSH string "transfer_single: No card." ; FAILWITH } + { PUSH string "sell_single: No card." ; FAILWITH } { DUP ; DIP { DROP } } ; DUP ; - CAR ; SENDER ; SWAP ; + CAR ; COMPARE ; NEQ ; IF { PUSH string "This card doesn't belong to you" ; FAILWITH } { PUSH unit Unit } ; - DIP 3 { DUP } ; - DIG 3 ; + DIP 2 { DUP } ; + DIG 2 ; + CAR ; + CAR ; + DIP 2 { DUP } ; + DIG 2 ; + CDR ; + GET ; + IF_NONE + { PUSH string "sell_single: No card pattern." ; FAILWITH } + { DUP ; DIP { DROP } } ; + DUP ; + PUSH nat 1 ; + DIP 2 { DUP } ; + DIG 2 ; + CDR ; + SUB ; + ABS ; + SWAP ; + CAR ; + PAIR ; + DIP 4 { DUP } ; + DIG 4 ; DIP 5 { DUP } ; DIG 5 ; CAR ; - DIP { DIP 2 { DUP } ; - DIG 2 ; - DIP 6 { DUP } ; - DIG 6 ; - CDR ; - SWAP ; - CDR ; - SWAP ; - PAIR ; - SOME ; - DIP { DIP 3 { DUP } ; DIG 3 } } ; + CAR ; + DIP 2 { DUP } ; + DIG 2 ; + DIP 6 { DUP } ; + DIG 6 ; + CDR ; + SWAP ; + SOME ; + SWAP ; UPDATE ; + DIP { DUP ; CDR ; SWAP ; CAR ; CDR } ; + PAIR ; + PAIR ; + DUP ; + CAR ; + CDR ; + DIP 7 { DUP } ; + DIG 7 ; + NONE (pair (address %card_owner) (nat %card_pattern)) ; + SWAP ; + UPDATE ; + DIP 2 { DUP } ; + DIG 2 ; + CDR ; + DIP 3 { DUP } ; + DIG 3 ; + CAR ; + MUL ; + SENDER ; + CONTRACT unit ; + IF_NONE + { PUSH string "sell_single: No contract." ; FAILWITH } + { DUP ; DIP { DROP } } ; + DUP ; + DIP 2 { DUP } ; + DIG 2 ; + UNIT ; + TRANSFER_TOKENS ; + DUP ; + NIL operation ; + SWAP ; + CONS ; + DIP 5 { DUP } ; + DIG 5 ; + DIP 5 { DUP } ; + DIG 5 ; DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; SWAP ; PAIR ; PAIR ; - NIL operation ; + DIP { DUP } ; + SWAP ; PAIR ; - DIP { DROP 7 } } ; - DIP { DROP 2 } } } |} ] + DIP { DROP 14 } } ; + DIP { DROP } } + { DIP { DUP } ; + SWAP ; + DIP { DUP } ; + SWAP ; + PAIR ; + DUP ; + CAR ; + DIP { DUP } ; + SWAP ; + CDR ; + DUP ; + CAR ; + CDR ; + DUP ; + DIP 3 { DUP } ; + DIG 3 ; + CAR ; + GET ; + IF_NONE + { PUSH string "transfer_single: No card." ; FAILWITH } + { DUP ; DIP { DROP } } ; + DUP ; + SENDER ; + SWAP ; + CAR ; + COMPARE ; + NEQ ; + IF { PUSH string "This card doesn't belong to you" ; FAILWITH } + { PUSH unit Unit } ; + DIP 3 { DUP } ; + DIG 3 ; + DIP 3 { DUP } ; + DIG 3 ; + DIP 3 { DUP } ; + DIG 3 ; + DIP 7 { DUP } ; + DIG 7 ; + CDR ; + SWAP ; + CDR ; + SWAP ; + PAIR ; + DIP 7 { DUP } ; + DIG 7 ; + CAR ; + SWAP ; + SOME ; + SWAP ; + UPDATE ; + DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; + SWAP ; + PAIR ; + PAIR ; + NIL operation ; + PAIR ; + DIP { DROP 7 } } ; + DIP { DROP 2 } } } |} ] let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "multisig.ligo" ; "main" ] ; [%expect {| - { parameter - (pair (pair (nat %counter) (lambda %message unit (list operation))) - (list %signatures (pair key_hash signature))) ; - storage - (pair (pair (list %auth key) (nat %counter)) (pair (string %id) (nat %threshold))) ; - code { DUP ; - CAR ; - DIP { DUP } ; - SWAP ; - CDR ; - DIP { DUP } ; - SWAP ; - CAR ; - CDR ; - DIP 2 { DUP } ; - DIG 2 ; - CAR ; - CAR ; - DIP { DIP { DUP } ; SWAP ; CAR ; CDR } ; - COMPARE ; - NEQ ; - IF { PUSH string "Counters does not match" ; FAILWITH } - { DUP ; - DIP { DIP 2 { DUP } ; DIG 2 ; CAR ; CAR } ; - PAIR ; - DIP { DIP { DUP } ; SWAP ; CDR ; CAR ; CHAIN_ID ; SWAP ; PAIR } ; - PAIR ; - PACK ; - DIP 3 { DUP } ; - DIG 3 ; - CDR ; - DIP { DIP 2 { DUP } ; DIG 2 ; CAR ; CAR ; PUSH nat 0 ; SWAP ; PAIR } ; - ITER { SWAP ; - PAIR ; - DUP ; +{ parameter + (pair (pair (nat %counter) (lambda %message unit (list operation))) + (list %signatures (pair key_hash signature))) ; + storage + (pair (pair (list %auth key) (nat %counter)) (pair (string %id) (nat %threshold))) ; + code { DUP ; + CAR ; + DIP { DUP } ; + SWAP ; + CDR ; + DIP { DUP } ; + SWAP ; + CAR ; + CDR ; + DIP { DUP } ; + SWAP ; + CAR ; + CDR ; + DIP 3 { DUP } ; + DIG 3 ; + CAR ; + CAR ; + COMPARE ; + NEQ ; + IF { PUSH string "Counters does not match" ; FAILWITH } + { CHAIN_ID ; + DIP 2 { DUP } ; + DIG 2 ; + CDR ; + CAR ; + PAIR ; + DIP 3 { DUP } ; + DIG 3 ; + CAR ; + CAR ; + DIP 2 { DUP } ; + DIG 2 ; + PAIR ; + PAIR ; + PACK ; + DIP 3 { DUP } ; + DIG 3 ; + CDR ; + DIP { PUSH nat 0 ; DIP 3 { DUP } ; DIG 3 ; CAR ; CAR ; PAIR } ; + ITER { SWAP ; + PAIR ; + DUP ; + CAR ; + CDR ; + DIP { DUP } ; + SWAP ; + CAR ; + CAR ; + DIP 2 { DUP } ; + DIG 2 ; + CDR ; + DIP 2 { DUP } ; + DIG 2 ; + DIP 2 { DUP } ; + DIG 2 ; + PAIR ; + DIP 2 { DUP } ; + DIG 2 ; + IF_CONS + { DUP ; + HASH_KEY ; + DIP 4 { DUP } ; + DIG 4 ; CAR ; - CDR ; - DIP { DUP } ; - SWAP ; - CAR ; - CAR ; - DIP 2 { DUP } ; - DIG 2 ; - CDR ; - DIP { DUP } ; - SWAP ; - DIP { DIP 2 { DUP } ; DIG 2 } ; - PAIR ; - DIP 2 { DUP } ; - DIG 2 ; - IF_CONS - { DIP 3 { DUP } ; - DIG 3 ; - CAR ; - DIP { DUP ; HASH_KEY } ; - COMPARE ; - EQ ; - IF { DUP ; - DIP { DIP 3 { DUP } ; DIG 3 ; CDR ; DIP { DIP 7 { DUP } ; DIG 7 } } ; - CHECK_SIGNATURE ; - IF { DIP 5 { DUP } ; - DIG 5 ; - PUSH nat 1 ; - ADD ; - DIP 6 { DUP } ; - DIG 6 ; - DIP { DUP } ; - SWAP ; - DIP { DROP 2 } } - { PUSH string "Invalid signature" ; FAILWITH } ; - DIP 6 { DUP } ; - DIG 6 ; - DIP { DUP } ; - SWAP ; - DIP { DROP 2 } } - { DIP 5 { DUP } ; DIG 5 } ; - DIP 3 { DUP } ; - DIG 3 ; - DIP 3 { DUP } ; - DIG 3 ; - SWAP ; - CDR ; - SWAP ; - PAIR ; - CAR ; - DIP { DUP } ; - PAIR ; - DIP { DROP 3 } } - { DUP } ; - DIP 5 { DUP } ; - DIG 5 ; - DIP { DUP } ; - SWAP ; - CAR ; - DIP { DUP ; CDR ; SWAP ; CAR ; CDR } ; - PAIR ; - PAIR ; - DIP { DUP } ; + COMPARE ; + EQ ; + IF { DIP 7 { DUP } ; + DIG 7 ; + DIP 4 { DUP } ; + DIG 4 ; + CDR ; + DIP 2 { DUP } ; + DIG 2 ; + CHECK_SIGNATURE ; + IF { PUSH nat 1 ; + DIP 6 { DUP } ; + DIG 6 ; + ADD ; + DIP 6 { DUP } ; + DIG 6 ; + DIP { DUP } ; + SWAP ; + DIP { DROP 2 } } + { PUSH string "Invalid signature" ; FAILWITH } ; + DIP 6 { DUP } ; + DIG 6 ; + DIP { DUP } ; + SWAP ; + DIP { DROP 2 } } + { DIP 5 { DUP } ; DIG 5 } ; + DIP 3 { DUP } ; + DIG 3 ; + DIP 3 { DUP } ; + DIG 3 ; SWAP ; CDR ; - DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; SWAP ; PAIR ; - PAIR ; CAR ; - DIP { DROP 6 } } ; - DUP ; - CDR ; - DIP { DIP 3 { DUP } ; DIG 3 ; CDR ; CDR } ; - COMPARE ; - LT ; - IF { PUSH string "Not enough signatures passed the check" ; FAILWITH } - { DIP 3 { DUP } ; - DIG 3 ; - DIP 4 { DUP } ; - DIG 4 ; - CAR ; - CDR ; - PUSH nat 1 ; - ADD ; - DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; - SWAP ; - PAIR ; - PAIR ; - DIP 4 { DUP } ; - DIG 4 ; - DIP { DUP } ; - SWAP ; - DIP { DROP 2 } } ; - DIP 4 { DUP } ; - DIG 4 ; - DIP { DUP } ; - SWAP ; - DIP { DROP 4 } } ; - UNIT ; - DIP 2 { DUP } ; - DIG 2 ; - SWAP ; - EXEC ; - DIP { DUP } ; - PAIR ; - DIP { DROP 5 } } } |} ] + DIP { DUP } ; + PAIR ; + DIP { DROP 3 } } + { DUP } ; + DIP 5 { DUP } ; + DIG 5 ; + DIP { DUP } ; + SWAP ; + CAR ; + DIP { DUP ; CDR ; SWAP ; CAR ; CDR } ; + PAIR ; + PAIR ; + DIP { DUP } ; + SWAP ; + CDR ; + DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; + SWAP ; + PAIR ; + PAIR ; + CAR ; + DIP { DROP 6 } } ; + DIP 3 { DUP } ; + DIG 3 ; + CDR ; + CDR ; + DIP { DUP } ; + SWAP ; + CDR ; + COMPARE ; + LT ; + IF { PUSH string "Not enough signatures passed the check" ; FAILWITH } + { DIP 3 { DUP } ; + DIG 3 ; + PUSH nat 1 ; + DIP 5 { DUP } ; + DIG 5 ; + CAR ; + CDR ; + ADD ; + DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; + SWAP ; + PAIR ; + PAIR ; + DIP 4 { DUP } ; + DIG 4 ; + DIP { DUP } ; + SWAP ; + DIP { DROP 2 } } ; + DIP 4 { DUP } ; + DIG 4 ; + DIP { DUP } ; + SWAP ; + DIP { DROP 4 } } ; + DUP ; + UNIT ; + DIP 3 { DUP } ; + DIG 3 ; + SWAP ; + EXEC ; + PAIR ; + DIP { DROP 5 } } } |} ] let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "multisig-v2.ligo" ; "main" ] ; @@ -460,8 +525,10 @@ let%expect_test _ = { DUP ; IF_LEFT { DIP 2 { DUP } ; DIG 2 ; NIL operation ; PAIR ; DIP { DROP } } - { DUP ; - DIP { DIP 2 { DUP } ; DIG 2 } ; + { DIP 2 { DUP } ; + DIG 2 ; + DIP { DUP } ; + SWAP ; PAIR ; DUP ; CDR ; @@ -478,20 +545,31 @@ let%expect_test _ = CAR ; DUP ; PACK ; - DUP ; + DIP 3 { DUP } ; + DIG 3 ; + CAR ; + CAR ; + CDR ; + DIP { DUP } ; + SWAP ; SIZE ; - DIP { DIP 3 { DUP } ; DIG 3 ; CAR ; CAR ; CDR } ; COMPARE ; GT ; IF { PUSH string "Message size exceed maximum limit" ; FAILWITH } { PUSH unit Unit } ; EMPTY_SET address ; - DUP ; - DIP { DIP 5 { DUP } ; DIG 5 } ; + DIP 5 { DUP } ; + DIG 5 ; + DIP { DUP } ; + SWAP ; PAIR ; - DIP 3 { DUP } ; - DIG 3 ; - DIP { DIP 6 { DUP } ; DIG 6 ; CAR ; CDR ; CDR } ; + DIP 6 { DUP } ; + DIG 6 ; + CAR ; + CDR ; + CDR ; + DIP 4 { DUP } ; + DIG 4 ; GET ; IF_NONE { DIP 6 { DUP } ; @@ -501,13 +579,17 @@ let%expect_test _ = CDR ; CAR ; CAR ; + PUSH nat 1 ; + DIP 9 { DUP } ; + DIG 9 ; + CDR ; + CAR ; + CAR ; SENDER ; GET ; IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; - PUSH nat 1 ; ADD ; SOME ; - DIP { DIP 7 { DUP } ; DIG 7 ; CDR ; CAR ; CAR } ; SENDER ; UPDATE ; DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; @@ -542,13 +624,17 @@ let%expect_test _ = CDR ; CAR ; CAR ; + PUSH nat 1 ; + DIP 10 { DUP } ; + DIG 10 ; + CDR ; + CAR ; + CAR ; SENDER ; GET ; IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; - PUSH nat 1 ; ADD ; SOME ; - DIP { DIP 8 { DUP } ; DIG 8 ; CDR ; CAR ; CAR } ; SENDER ; UPDATE ; DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; @@ -590,27 +676,43 @@ let%expect_test _ = SENDER ; GET ; IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; - DUP ; - DIP { DIP { DUP } ; SWAP ; CAR ; CDR ; CAR } ; + DIP { DUP } ; + SWAP ; + CAR ; + CDR ; + CAR ; + DIP { DUP } ; + SWAP ; COMPARE ; GT ; IF { PUSH string "Maximum number of proposal reached" ; FAILWITH } { PUSH unit Unit } ; NIL operation ; - DUP ; - DIP { DIP 3 { DUP } ; DIG 3 } ; + DIP 3 { DUP } ; + DIG 3 ; + DIP { DUP } ; + SWAP ; PAIR ; - DIP 5 { DUP } ; - DIG 5 ; + DIP 4 { DUP } ; + DIG 4 ; + CDR ; + CDR ; + DIP 6 { DUP } ; + DIG 6 ; SIZE ; - DIP { DIP 4 { DUP } ; DIG 4 ; CDR ; CDR } ; COMPARE ; GE ; IF { DIP 4 { DUP } ; DIG 4 ; - DIP 11 { DUP } ; - DIG 11 ; - DIP { DIP 5 { DUP } ; DIG 5 ; CAR ; CDR ; CDR ; NONE (set address) } ; + DIP 5 { DUP } ; + DIG 5 ; + CAR ; + CDR ; + CDR ; + DIP 12 { DUP } ; + DIG 12 ; + NONE (set address) ; + SWAP ; UPDATE ; DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; SWAP ; @@ -628,12 +730,13 @@ let%expect_test _ = EXEC ; DIP { DUP } ; SWAP ; - DIP 2 { DUP } ; - DIG 2 ; + DIP 13 { DUP } ; + DIG 13 ; + DIP 3 { DUP } ; + DIG 3 ; CDR ; CAR ; CDR ; - DIP { DIP 13 { DUP } ; DIG 13 } ; CONCAT ; SHA256 ; DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CAR } ; @@ -655,23 +758,30 @@ let%expect_test _ = SWAP ; CDR ; CAR ; - DUP ; - DIP { DIP 11 { DUP } ; DIG 11 } ; + DIP 11 { DUP } ; + DIG 11 ; + DIP { DUP } ; + SWAP ; MEM ; IF { DIP { DUP } ; SWAP ; - DIP { DUP } ; + DIP 2 { DUP } ; + DIG 2 ; + CDR ; + CAR ; + CAR ; + PUSH nat 1 ; + DIP 5 { DUP } ; + DIG 5 ; + CDR ; + CDR ; + SUB ; + ABS ; + DIP 3 { DUP } ; + DIG 3 ; + SWAP ; + SOME ; SWAP ; - DIP { DIP 3 { DUP } ; - DIG 3 ; - CDR ; - CDR ; - PUSH nat 1 ; - SWAP ; - SUB ; - ABS ; - SOME ; - DIP { DIP 2 { DUP } ; DIG 2 ; CDR ; CAR ; CAR } } ; UPDATE ; DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; PAIR ; @@ -717,12 +827,18 @@ let%expect_test _ = { DUP ; DIP 5 { DUP } ; DIG 5 ; - DIP 12 { DUP } ; - DIG 12 ; - DIP { DIP 7 { DUP } ; - DIG 7 ; - SOME ; - DIP { DIP 6 { DUP } ; DIG 6 ; CAR ; CDR ; CDR } } ; + DIP 6 { DUP } ; + DIG 6 ; + CAR ; + CDR ; + CDR ; + DIP 8 { DUP } ; + DIG 8 ; + DIP 14 { DUP } ; + DIG 14 ; + SWAP ; + SOME ; + SWAP ; UPDATE ; DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; SWAP ; @@ -736,8 +852,10 @@ let%expect_test _ = DUP ; DIP { DROP 17 } } ; DIP { DROP } } - { DUP ; - DIP { DIP { DUP } ; SWAP } ; + { DIP { DUP } ; + SWAP ; + DIP { DUP } ; + SWAP ; PAIR ; DUP ; CDR ; @@ -745,8 +863,13 @@ let%expect_test _ = SWAP ; CAR ; PACK ; - DUP ; - DIP { DIP { DUP } ; SWAP ; CAR ; CDR ; CDR } ; + DIP { DUP } ; + SWAP ; + CAR ; + CDR ; + CDR ; + DIP { DUP } ; + SWAP ; GET ; IF_NONE { DIP { DUP } ; SWAP } @@ -754,10 +877,11 @@ let%expect_test _ = PUSH bool False ; SENDER ; UPDATE ; - DIP { DUP } ; - SWAP ; + DUP ; + SIZE ; + DIP 2 { DUP } ; + DIG 2 ; SIZE ; - DIP { DUP ; SIZE } ; COMPARE ; NEQ ; IF { DIP 3 { DUP } ; @@ -767,15 +891,18 @@ let%expect_test _ = CDR ; CAR ; CAR ; + PUSH nat 1 ; + DIP 6 { DUP } ; + DIG 6 ; + CDR ; + CAR ; + CAR ; SENDER ; GET ; IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; - PUSH nat 1 ; - SWAP ; SUB ; ABS ; SOME ; - DIP { DIP 4 { DUP } ; DIG 4 ; CDR ; CAR ; CAR } ; SENDER ; UPDATE ; DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; @@ -789,17 +916,22 @@ let%expect_test _ = SWAP ; DIP { DROP 2 } } { DIP 3 { DUP } ; DIG 3 } ; - DIP { DUP } ; - SWAP ; - SIZE ; PUSH nat 0 ; - SWAP ; + DIP 2 { DUP } ; + DIG 2 ; + SIZE ; COMPARE ; EQ ; IF { DUP ; - DIP 4 { DUP } ; - DIG 4 ; - DIP { DIP { DUP } ; SWAP ; CAR ; CDR ; CDR ; NONE (set address) } ; + DIP { DUP } ; + SWAP ; + CAR ; + CDR ; + CDR ; + DIP 5 { DUP } ; + DIG 5 ; + NONE (set address) ; + SWAP ; UPDATE ; DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; SWAP ; @@ -815,12 +947,18 @@ let%expect_test _ = { DUP ; DIP { DUP } ; SWAP ; - DIP 5 { DUP } ; - DIG 5 ; - DIP { DIP 3 { DUP } ; - DIG 3 ; - SOME ; - DIP { DIP 2 { DUP } ; DIG 2 ; CAR ; CDR ; CDR } } ; + DIP 2 { DUP } ; + DIG 2 ; + CAR ; + CDR ; + CDR ; + DIP 4 { DUP } ; + DIG 4 ; + DIP 7 { DUP } ; + DIG 7 ; + SWAP ; + SOME ; + SWAP ; UPDATE ; DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; SWAP ; @@ -845,82 +983,99 @@ let%expect_test _ = let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "vote.mligo" ; "main" ] ; [%expect {| - { parameter - (or (pair %reset (pair (timestamp %finish_time) (timestamp %start_time)) (string %title)) - (or %vote (unit %nay) (unit %yea))) ; - storage - (pair (pair (pair (timestamp %finish_time) (nat %nay)) - (pair (timestamp %start_time) (string %title))) - (pair (set %voters address) (nat %yea))) ; - code { DUP ; +{ parameter + (or (pair %reset (pair (timestamp %finish_time) (timestamp %start_time)) (string %title)) + (or %vote (unit %nay) (unit %yea))) ; + storage + (pair (pair (pair (timestamp %finish_time) (nat %nay)) + (pair (timestamp %start_time) (string %title))) + (pair (set %voters address) (nat %yea))) ; + code { DUP ; + CAR ; + IF_LEFT + { PUSH nat 0 ; + EMPTY_SET address ; + PAIR ; + DIP { DUP } ; + SWAP ; + CDR ; + DIP 2 { DUP } ; + DIG 2 ; + CAR ; + CDR ; + PAIR ; + PUSH nat 0 ; + DIP 3 { DUP } ; + DIG 3 ; + CAR ; + CAR ; + PAIR ; + PAIR ; + PAIR ; + NIL operation ; + PAIR ; + DIP { DROP } } + { DIP { DUP } ; + SWAP ; + CDR ; + DIP { DUP } ; + SWAP ; + PAIR ; + DUP ; + CDR ; + NOW ; + SENDER ; + DIP 3 { DUP } ; + DIG 3 ; CAR ; IF_LEFT - { DUP ; + { DIP 3 { DUP } ; + DIG 3 ; + PUSH nat 1 ; + DIP 5 { DUP } ; + DIG 5 ; CAR ; CAR ; - PUSH nat 0 ; + CDR ; + ADD ; + DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CDR ; SWAP ; CAR ; CAR } ; SWAP ; PAIR ; - DIP { DUP ; CAR ; CDR ; DIP { DUP ; CDR } ; PAIR } ; PAIR ; - DIP { PUSH nat 0 ; EMPTY_SET address ; PAIR } ; - PAIR ; - NIL operation ; PAIR ; DIP { DROP } } - { DUP ; - DIP { DIP { DUP } ; SWAP ; CDR } ; - PAIR ; - DUP ; - CDR ; - NOW ; - SENDER ; - DIP 3 { DUP } ; + { DIP 3 { DUP } ; DIG 3 ; - CAR ; - IF_LEFT - { DIP 3 { DUP } ; - DIG 3 ; - DIP 4 { DUP } ; - DIG 4 ; - CAR ; - CAR ; - CDR ; - PUSH nat 1 ; - ADD ; - DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CDR ; SWAP ; CAR ; CAR } ; - SWAP ; - PAIR ; - PAIR ; - PAIR ; - DIP { DROP } } - { DIP 3 { DUP } ; - DIG 3 ; - DIP 4 { DUP } ; - DIG 4 ; - CDR ; - CDR ; - PUSH nat 1 ; - ADD ; - DIP { DUP ; CAR ; SWAP ; CDR ; CAR } ; - SWAP ; - PAIR ; - SWAP ; - PAIR ; - DIP { DROP } } ; - DUP ; - DIP 2 { DUP } ; - DIG 2 ; - DIP { DIP { DUP } ; SWAP ; CDR ; CAR ; PUSH bool True } ; - UPDATE ; - DIP { DUP ; CAR ; SWAP ; CDR ; CDR } ; + PUSH nat 1 ; + DIP 5 { DUP } ; + DIG 5 ; + CDR ; + CDR ; + ADD ; + DIP { DUP ; CAR ; SWAP ; CDR ; CAR } ; + SWAP ; PAIR ; SWAP ; PAIR ; - NIL operation ; - PAIR ; - DIP { DROP 6 } } ; - DIP { DROP } } } |}] + DIP { DROP } } ; + DUP ; + DIP { DUP } ; + SWAP ; + CDR ; + CAR ; + DIP 3 { DUP } ; + DIG 3 ; + PUSH bool True ; + SWAP ; + UPDATE ; + DIP { DUP ; CAR ; SWAP ; CDR ; CDR } ; + PAIR ; + SWAP ; + PAIR ; + NIL operation ; + PAIR ; + DIP { DROP 6 } } ; + DIP { DROP } } } |}] let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "implicit.mligo" ; "main" ] ; @@ -1134,12 +1289,14 @@ ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, char storage string ; code { PUSH string "one" ; NIL operation ; PAIR ; DIP { DROP } } } ; PAIR ; - DUP ; - CAR ; - NIL operation ; + DIP { DUP } ; SWAP ; + CDR ; + NIL operation ; + DIP 2 { DUP } ; + DIG 2 ; + CAR ; CONS ; - DIP { DIP { DUP } ; SWAP ; CDR } ; PAIR ; DIP { DROP 2 } } } |}]; @@ -1147,10 +1304,12 @@ ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, char [%expect {| { parameter int ; storage (pair (pair int string) (pair nat bool)) ; - code { PUSH string "2" ; + code { PUSH bool False ; + PUSH nat 2 ; + PAIR ; + PUSH string "2" ; PUSH int 2 ; PAIR ; - DIP { PUSH bool False ; PUSH nat 2 ; PAIR } ; PAIR ; NIL operation ; PAIR ; @@ -1232,11 +1391,13 @@ let%expect_test _ = PUSH mutez 300000000 ; PUSH int 2 ; TRANSFER_TOKENS ; - DUP ; + DIP 2 { DUP } ; + DIG 2 ; + CDR ; NIL operation ; - SWAP ; + DIP 2 { DUP } ; + DIG 2 ; CONS ; - DIP { DIP 2 { DUP } ; DIG 2 ; CDR } ; PAIR ; DIP { DROP 3 } } } |}] ; @@ -1249,11 +1410,13 @@ let%expect_test _ = PUSH mutez 300000000 ; PUSH int 2 ; TRANSFER_TOKENS ; - DUP ; + DIP 2 { DUP } ; + DIG 2 ; + CDR ; NIL operation ; - SWAP ; + DIP 2 { DUP } ; + DIG 2 ; CONS ; - DIP { DIP 2 { DUP } ; DIG 2 ; CDR } ; PAIR ; DIP { DROP 3 } } } |}] ; diff --git a/src/passes/12-compiler/compiler_program.ml b/src/passes/12-compiler/compiler_program.ml index e19e2075e..ae4cf3f83 100644 --- a/src/passes/12-compiler/compiler_program.ml +++ b/src/passes/12-compiler/compiler_program.ml @@ -274,15 +274,18 @@ and translate_expression (expr:expression) (env:environment) : michelson result ) | E_constant{cons_name=str;arguments= lst} -> let module L = Logger.Stateful() in - let%bind pre_code = - let aux code expr = + let%bind (pre_code, _env) = + let aux (code, env) expr = let%bind expr_code = translate_expression expr env in L.log @@ Format.asprintf "\n%a -> %a in %a\n" PP.expression expr Michelson.pp expr_code PP.environment env ; - ok (seq [ expr_code ; dip code ]) in - bind_fold_right_list aux (seq []) lst in + let env = Environment.add (Var.fresh (), expr.type_value) env in + let code = code @ [expr_code] in + ok (code, env) in + bind_fold_right_list aux ([], env) lst in + let pre_code = seq pre_code in let%bind predicate = get_operator str ty lst in let%bind code = match (predicate, List.length lst) with | Constant c, 0 -> ok @@ seq [ From b05e7ef6139fcaf852804eb818005600d159dd47 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Sat, 11 Jan 2020 19:52:05 -0600 Subject: [PATCH 4/6] Less dippy fold --- src/bin/expect_tests/contract_tests.ml | 176 +-------------------- src/passes/12-compiler/compiler_program.ml | 7 +- 2 files changed, 9 insertions(+), 174 deletions(-) diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 228211513..0de81c536 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -10,10 +10,10 @@ let%expect_test _ = [%expect {| 1842 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ; - [%expect {| 1145 bytes |}] ; + [%expect {| 1138 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ; - [%expect {| 2795 bytes |}] ; + [%expect {| 2797 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ; [%expect {| 626 bytes |}] ; @@ -336,175 +336,6 @@ let%expect_test _ = DIP { DROP 7 } } ; DIP { DROP 2 } } } |} ] -let%expect_test _ = - run_ligo_good [ "compile-contract" ; contract "multisig.ligo" ; "main" ] ; - [%expect {| -{ parameter - (pair (pair (nat %counter) (lambda %message unit (list operation))) - (list %signatures (pair key_hash signature))) ; - storage - (pair (pair (list %auth key) (nat %counter)) (pair (string %id) (nat %threshold))) ; - code { DUP ; - CAR ; - DIP { DUP } ; - SWAP ; - CDR ; - DIP { DUP } ; - SWAP ; - CAR ; - CDR ; - DIP { DUP } ; - SWAP ; - CAR ; - CDR ; - DIP 3 { DUP } ; - DIG 3 ; - CAR ; - CAR ; - COMPARE ; - NEQ ; - IF { PUSH string "Counters does not match" ; FAILWITH } - { CHAIN_ID ; - DIP 2 { DUP } ; - DIG 2 ; - CDR ; - CAR ; - PAIR ; - DIP 3 { DUP } ; - DIG 3 ; - CAR ; - CAR ; - DIP 2 { DUP } ; - DIG 2 ; - PAIR ; - PAIR ; - PACK ; - DIP 3 { DUP } ; - DIG 3 ; - CDR ; - DIP { PUSH nat 0 ; DIP 3 { DUP } ; DIG 3 ; CAR ; CAR ; PAIR } ; - ITER { SWAP ; - PAIR ; - DUP ; - CAR ; - CDR ; - DIP { DUP } ; - SWAP ; - CAR ; - CAR ; - DIP 2 { DUP } ; - DIG 2 ; - CDR ; - DIP 2 { DUP } ; - DIG 2 ; - DIP 2 { DUP } ; - DIG 2 ; - PAIR ; - DIP 2 { DUP } ; - DIG 2 ; - IF_CONS - { DUP ; - HASH_KEY ; - DIP 4 { DUP } ; - DIG 4 ; - CAR ; - COMPARE ; - EQ ; - IF { DIP 7 { DUP } ; - DIG 7 ; - DIP 4 { DUP } ; - DIG 4 ; - CDR ; - DIP 2 { DUP } ; - DIG 2 ; - CHECK_SIGNATURE ; - IF { PUSH nat 1 ; - DIP 6 { DUP } ; - DIG 6 ; - ADD ; - DIP 6 { DUP } ; - DIG 6 ; - DIP { DUP } ; - SWAP ; - DIP { DROP 2 } } - { PUSH string "Invalid signature" ; FAILWITH } ; - DIP 6 { DUP } ; - DIG 6 ; - DIP { DUP } ; - SWAP ; - DIP { DROP 2 } } - { DIP 5 { DUP } ; DIG 5 } ; - DIP 3 { DUP } ; - DIG 3 ; - DIP 3 { DUP } ; - DIG 3 ; - SWAP ; - CDR ; - SWAP ; - PAIR ; - CAR ; - DIP { DUP } ; - PAIR ; - DIP { DROP 3 } } - { DUP } ; - DIP 5 { DUP } ; - DIG 5 ; - DIP { DUP } ; - SWAP ; - CAR ; - DIP { DUP ; CDR ; SWAP ; CAR ; CDR } ; - PAIR ; - PAIR ; - DIP { DUP } ; - SWAP ; - CDR ; - DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; - SWAP ; - PAIR ; - PAIR ; - CAR ; - DIP { DROP 6 } } ; - DIP 3 { DUP } ; - DIG 3 ; - CDR ; - CDR ; - DIP { DUP } ; - SWAP ; - CDR ; - COMPARE ; - LT ; - IF { PUSH string "Not enough signatures passed the check" ; FAILWITH } - { DIP 3 { DUP } ; - DIG 3 ; - PUSH nat 1 ; - DIP 5 { DUP } ; - DIG 5 ; - CAR ; - CDR ; - ADD ; - DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; - SWAP ; - PAIR ; - PAIR ; - DIP 4 { DUP } ; - DIG 4 ; - DIP { DUP } ; - SWAP ; - DIP { DROP 2 } } ; - DIP 4 { DUP } ; - DIG 4 ; - DIP { DUP } ; - SWAP ; - DIP { DROP 4 } } ; - DUP ; - UNIT ; - DIP 3 { DUP } ; - DIG 3 ; - SWAP ; - EXEC ; - PAIR ; - DIP { DROP 5 } } } |} ] - let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "multisig-v2.ligo" ; "main" ] ; [%expect {| @@ -746,10 +577,11 @@ let%expect_test _ = SWAP ; PAIR ; DUP ; + DIP { DUP } ; + SWAP ; CDR ; CAR ; CAR ; - DIP { DUP } ; ITER { SWAP ; PAIR ; DUP ; diff --git a/src/passes/12-compiler/compiler_program.ml b/src/passes/12-compiler/compiler_program.ml index ae4cf3f83..be42521db 100644 --- a/src/passes/12-compiler/compiler_program.ml +++ b/src/passes/12-compiler/compiler_program.ml @@ -430,12 +430,15 @@ and translate_expression (expr:expression) (env:environment) : michelson result ) ) | E_fold ((v , body) , collection , initial) -> ( - let%bind collection' = translate_expression collection env in + let%bind collection' = + translate_expression + collection + (Environment.add (Var.fresh (), initial.type_value) env) in let%bind initial' = translate_expression initial env in let%bind body' = translate_expression body (Environment.add v env) in let code = seq [ + initial' ; collection' ; - dip initial' ; i_iter (seq [ i_swap ; i_pair ; body' ; dip i_drop ; From 94c35e15dddb95d0c47f80a423399cc2f49bf7c8 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Mon, 3 Feb 2020 17:33:47 -0600 Subject: [PATCH 5/6] Don't dip for vars after the second --- src/bin/expect_tests/contract_tests.ml | 1057 +++++++++-------- .../12-compiler/compiler_environment.ml | 3 +- 2 files changed, 579 insertions(+), 481 deletions(-) diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 0de81c536..98b286f3a 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -7,16 +7,16 @@ let bad_contract basename = let%expect_test _ = run_ligo_good [ "measure-contract" ; contract "coase.ligo" ; "main" ] ; - [%expect {| 1842 bytes |}] ; + [%expect {| 1682 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ; - [%expect {| 1138 bytes |}] ; + [%expect {| 1003 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ; - [%expect {| 2797 bytes |}] ; + [%expect {| 2522 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ; - [%expect {| 626 bytes |}] ; + [%expect {| 586 bytes |}] ; run_ligo_good [ "compile-parameter" ; contract "coase.ligo" ; "main" ; "Buy_single (record card_to_buy = 1n end)" ] ; [%expect {| (Left (Left 1)) |}] ; @@ -74,8 +74,9 @@ let%expect_test _ = IF_LEFT { DUP ; IF_LEFT - { DIP 2 { DUP } ; - DIG 2 ; + { DIG 2 ; + DUP ; + DUG 3 ; DIP { DUP } ; SWAP ; PAIR ; @@ -87,8 +88,9 @@ let%expect_test _ = DUP ; CAR ; CAR ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; GET ; IF_NONE { PUSH string "buy_single: No card pattern." ; FAILWITH } @@ -108,26 +110,32 @@ let%expect_test _ = COMPARE ; GT ; IF { PUSH string "Not enough money" ; FAILWITH } { PUSH unit Unit } ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; PUSH nat 1 ; - DIP 4 { DUP } ; DIG 4 ; + DUP ; + DUG 5 ; CDR ; ADD ; SWAP ; CAR ; PAIR ; - DIP 4 { DUP } ; DIG 4 ; - DIP 5 { DUP } ; + DUP ; + DUG 5 ; DIG 5 ; + DUP ; + DUG 6 ; CAR ; CAR ; - DIP 2 { DUP } ; DIG 2 ; - DIP 8 { DUP } ; + DUP ; + DUG 3 ; DIG 8 ; + DUP ; + DUG 9 ; SWAP ; SOME ; SWAP ; @@ -138,12 +146,14 @@ let%expect_test _ = DUP ; CAR ; CDR ; - DIP 7 { DUP } ; DIG 7 ; + DUP ; + DUG 8 ; SENDER ; PAIR ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CDR ; SWAP ; SOME ; @@ -159,8 +169,9 @@ let%expect_test _ = PAIR ; DUP ; PUSH nat 1 ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CDR ; ADD ; SWAP ; @@ -170,8 +181,9 @@ let%expect_test _ = NIL operation ; PAIR ; DIP { DROP 12 } } - { DIP 2 { DUP } ; - DIG 2 ; + { DIG 2 ; + DUP ; + DUG 3 ; DIP { DUP } ; SWAP ; PAIR ; @@ -183,8 +195,9 @@ let%expect_test _ = DUP ; CAR ; CDR ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; GET ; IF_NONE { PUSH string "sell_single: No card." ; FAILWITH } @@ -197,12 +210,14 @@ let%expect_test _ = NEQ ; IF { PUSH string "This card doesn't belong to you" ; FAILWITH } { PUSH unit Unit } ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CAR ; CAR ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CDR ; GET ; IF_NONE @@ -210,24 +225,29 @@ let%expect_test _ = { DUP ; DIP { DROP } } ; DUP ; PUSH nat 1 ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CDR ; SUB ; ABS ; SWAP ; CAR ; PAIR ; - DIP 4 { DUP } ; DIG 4 ; - DIP 5 { DUP } ; + DUP ; + DUG 5 ; DIG 5 ; + DUP ; + DUG 6 ; CAR ; CAR ; - DIP 2 { DUP } ; DIG 2 ; - DIP 6 { DUP } ; + DUP ; + DUG 3 ; DIG 6 ; + DUP ; + DUG 7 ; CDR ; SWAP ; SOME ; @@ -239,16 +259,19 @@ let%expect_test _ = DUP ; CAR ; CDR ; - DIP 7 { DUP } ; DIG 7 ; + DUP ; + DUG 8 ; NONE (pair (address %card_owner) (nat %card_pattern)) ; SWAP ; UPDATE ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CDR ; - DIP 3 { DUP } ; DIG 3 ; + DUP ; + DUG 4 ; CAR ; MUL ; SENDER ; @@ -257,18 +280,21 @@ let%expect_test _ = { PUSH string "sell_single: No contract." ; FAILWITH } { DUP ; DIP { DROP } } ; DUP ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; UNIT ; TRANSFER_TOKENS ; DUP ; NIL operation ; SWAP ; CONS ; - DIP 5 { DUP } ; DIG 5 ; - DIP 5 { DUP } ; + DUP ; + DUG 6 ; DIG 5 ; + DUP ; + DUG 6 ; DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; SWAP ; PAIR ; @@ -292,8 +318,9 @@ let%expect_test _ = CAR ; CDR ; DUP ; - DIP 3 { DUP } ; DIG 3 ; + DUP ; + DUG 4 ; CAR ; GET ; IF_NONE @@ -307,21 +334,26 @@ let%expect_test _ = NEQ ; IF { PUSH string "This card doesn't belong to you" ; FAILWITH } { PUSH unit Unit } ; - DIP 3 { DUP } ; DIG 3 ; - DIP 3 { DUP } ; + DUP ; + DUG 4 ; DIG 3 ; - DIP 3 { DUP } ; + DUP ; + DUG 4 ; DIG 3 ; - DIP 7 { DUP } ; + DUP ; + DUG 4 ; DIG 7 ; + DUP ; + DUG 8 ; CDR ; SWAP ; CDR ; SWAP ; PAIR ; - DIP 7 { DUP } ; DIG 7 ; + DUP ; + DUG 8 ; CAR ; SWAP ; SOME ; @@ -339,401 +371,146 @@ let%expect_test _ = let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "multisig-v2.ligo" ; "main" ] ; [%expect {| - { parameter - (or (or (unit %default) (lambda %send bytes (list operation))) - (lambda %withdraw bytes (list operation))) ; - storage - (pair (pair (pair (set %authorized_addresses address) (nat %max_message_size)) - (pair (nat %max_proposal) (map %message_store bytes (set address)))) - (pair (pair (map %proposal_counters address nat) (bytes %state_hash)) - (nat %threshold))) ; - code { DUP ; - CDR ; - DIP { DUP } ; - SWAP ; - CAR ; +{ parameter + (or (or (unit %default) (lambda %send bytes (list operation))) + (lambda %withdraw bytes (list operation))) ; + storage + (pair (pair (pair (set %authorized_addresses address) (nat %max_message_size)) + (pair (nat %max_proposal) (map %message_store bytes (set address)))) + (pair (pair (map %proposal_counters address nat) (bytes %state_hash)) + (nat %threshold))) ; + code { DUP ; + CDR ; + DIP { DUP } ; + SWAP ; + CAR ; + IF_LEFT + { DUP ; IF_LEFT - { DUP ; - IF_LEFT - { DIP 2 { DUP } ; DIG 2 ; NIL operation ; PAIR ; DIP { DROP } } - { DIP 2 { DUP } ; - DIG 2 ; - DIP { DUP } ; - SWAP ; - PAIR ; + { DIG 2 ; DUP ; DUG 3 ; NIL operation ; PAIR ; DIP { DROP } } + { DIG 2 ; + DUP ; + DUG 3 ; + DIP { DUP } ; + SWAP ; + PAIR ; + DUP ; + CDR ; + DUP ; + CAR ; + CAR ; + CAR ; + SENDER ; + MEM ; + NOT ; + IF { PUSH string "Unauthorized address" ; FAILWITH } { PUSH unit Unit } ; + DIG 2 ; + DUP ; + DUG 3 ; + CAR ; + DUP ; + PACK ; + DIG 3 ; + DUP ; + DUG 4 ; + CAR ; + CAR ; + CDR ; + DIP { DUP } ; + SWAP ; + SIZE ; + COMPARE ; + GT ; + IF { PUSH string "Message size exceed maximum limit" ; FAILWITH } + { PUSH unit Unit } ; + EMPTY_SET address ; + DIG 5 ; + DUP ; + DUG 6 ; + DIP { DUP } ; + SWAP ; + PAIR ; + DIG 6 ; + DUP ; + DUG 7 ; + CAR ; + CDR ; + CDR ; + DIG 4 ; + DUP ; + DUG 5 ; + GET ; + IF_NONE + { DIG 6 ; DUP ; - CDR ; + DUG 7 ; + DIG 7 ; DUP ; + DUG 8 ; + CDR ; CAR ; CAR ; - CAR ; - SENDER ; - MEM ; - NOT ; - IF { PUSH string "Unauthorized address" ; FAILWITH } { PUSH unit Unit } ; - DIP 2 { DUP } ; - DIG 2 ; - CAR ; - DUP ; - PACK ; - DIP 3 { DUP } ; - DIG 3 ; - CAR ; - CAR ; - CDR ; - DIP { DUP } ; - SWAP ; - SIZE ; - COMPARE ; - GT ; - IF { PUSH string "Message size exceed maximum limit" ; FAILWITH } - { PUSH unit Unit } ; - EMPTY_SET address ; - DIP 5 { DUP } ; - DIG 5 ; - DIP { DUP } ; - SWAP ; - PAIR ; - DIP 6 { DUP } ; - DIG 6 ; - CAR ; - CDR ; - CDR ; - DIP 4 { DUP } ; - DIG 4 ; - GET ; - IF_NONE - { DIP 6 { DUP } ; - DIG 6 ; - DIP 7 { DUP } ; - DIG 7 ; - CDR ; - CAR ; - CAR ; - PUSH nat 1 ; - DIP 9 { DUP } ; - DIG 9 ; - CDR ; - CAR ; - CAR ; - SENDER ; - GET ; - IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; - ADD ; - SOME ; - SENDER ; - UPDATE ; - DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; - PAIR ; - PAIR ; - SWAP ; - PAIR ; - EMPTY_SET address ; - PUSH bool True ; - SENDER ; - UPDATE ; - DIP 2 { DUP } ; - DIG 2 ; - DIP 2 { DUP } ; - DIG 2 ; - SWAP ; - CAR ; - PAIR ; - CDR ; - DIP { DUP } ; - SWAP ; - PAIR ; - DIP { DROP 2 } } - { DUP ; - SENDER ; - MEM ; - IF { DIP 7 { DUP } ; DIG 7 } - { DIP 7 { DUP } ; - DIG 7 ; - DIP 8 { DUP } ; - DIG 8 ; - CDR ; - CAR ; - CAR ; - PUSH nat 1 ; - DIP 10 { DUP } ; - DIG 10 ; - CDR ; - CAR ; - CAR ; - SENDER ; - GET ; - IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; - ADD ; - SOME ; - SENDER ; - UPDATE ; - DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; - PAIR ; - PAIR ; - SWAP ; - PAIR ; - DIP 8 { DUP } ; - DIG 8 ; - DIP { DUP } ; - SWAP ; - DIP { DROP 2 } } ; - DIP { DUP } ; - SWAP ; - PUSH bool True ; - SENDER ; - UPDATE ; - DIP 3 { DUP } ; - DIG 3 ; - DIP 2 { DUP } ; - DIG 2 ; - SWAP ; - CAR ; - PAIR ; - CDR ; - DIP { DUP } ; - SWAP ; - PAIR ; - DIP { DROP 3 } } ; - DUP ; - CAR ; - DIP { DUP } ; - SWAP ; - CDR ; + PUSH nat 1 ; + DIG 9 ; DUP ; + DUG 10 ; CDR ; CAR ; CAR ; SENDER ; GET ; IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; - DIP { DUP } ; + ADD ; + SOME ; + SENDER ; + UPDATE ; + DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; + PAIR ; + PAIR ; + SWAP ; + PAIR ; + EMPTY_SET address ; + PUSH bool True ; + SENDER ; + UPDATE ; + DIG 2 ; + DUP ; + DUG 3 ; + DIG 2 ; + DUP ; + DUG 3 ; SWAP ; CAR ; + PAIR ; CDR ; - CAR ; - DIP { DUP } ; - SWAP ; - COMPARE ; - GT ; - IF { PUSH string "Maximum number of proposal reached" ; FAILWITH } - { PUSH unit Unit } ; - NIL operation ; - DIP 3 { DUP } ; - DIG 3 ; DIP { DUP } ; SWAP ; PAIR ; - DIP 4 { DUP } ; - DIG 4 ; - CDR ; - CDR ; - DIP 6 { DUP } ; - DIG 6 ; - SIZE ; - COMPARE ; - GE ; - IF { DIP 4 { DUP } ; - DIG 4 ; - DIP 5 { DUP } ; - DIG 5 ; - CAR ; - CDR ; - CDR ; - DIP 12 { DUP } ; - DIG 12 ; - NONE (set address) ; - SWAP ; - UPDATE ; - DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; - SWAP ; - PAIR ; - SWAP ; - PAIR ; - PAIR ; - DUP ; - CDR ; - CAR ; - CDR ; - DIP 13 { DUP } ; - DIG 13 ; - SWAP ; - EXEC ; - DIP { DUP } ; - SWAP ; - DIP 13 { DUP } ; - DIG 13 ; - DIP 3 { DUP } ; - DIG 3 ; - CDR ; - CAR ; - CDR ; - CONCAT ; - SHA256 ; - DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CAR } ; - SWAP ; - PAIR ; - PAIR ; - SWAP ; - PAIR ; - DUP ; - DIP { DUP } ; - SWAP ; - CDR ; - CAR ; - CAR ; - ITER { SWAP ; - PAIR ; - DUP ; - CAR ; - DIP { DUP } ; - SWAP ; - CDR ; - CAR ; - DIP 11 { DUP } ; - DIG 11 ; - DIP { DUP } ; - SWAP ; - MEM ; - IF { DIP { DUP } ; - SWAP ; - DIP 2 { DUP } ; - DIG 2 ; - CDR ; - CAR ; - CAR ; - PUSH nat 1 ; - DIP 5 { DUP } ; - DIG 5 ; - CDR ; - CDR ; - SUB ; - ABS ; - DIP 3 { DUP } ; - DIG 3 ; - SWAP ; - SOME ; - SWAP ; - UPDATE ; - DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; - PAIR ; - PAIR ; - SWAP ; - PAIR ; - DIP 2 { DUP } ; - DIG 2 ; - DIP { DUP } ; - SWAP ; - DIP { DROP 2 } } - { DIP { DUP } ; SWAP } ; - DIP 3 { DUP } ; - DIG 3 ; - CDR ; - DIP { DUP } ; - SWAP ; - PAIR ; - CAR ; - DIP { DROP 4 } } ; - DIP 4 { DUP } ; - DIG 4 ; - DIP 4 { DUP } ; - DIG 4 ; - SWAP ; - CAR ; - PAIR ; - DIP 3 { DUP } ; - DIG 3 ; - SWAP ; - CDR ; - SWAP ; - PAIR ; - DIP 2 { DUP } ; - DIG 2 ; - SWAP ; - CAR ; - PAIR ; - CAR ; - DIP { DUP } ; - PAIR ; - DIP { DROP 4 } } - { DUP ; - DIP 5 { DUP } ; - DIG 5 ; - DIP 6 { DUP } ; - DIG 6 ; - CAR ; - CDR ; - CDR ; - DIP 8 { DUP } ; - DIG 8 ; - DIP 14 { DUP } ; - DIG 14 ; - SWAP ; - SOME ; - SWAP ; - UPDATE ; - DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; - SWAP ; - PAIR ; - SWAP ; - PAIR ; - PAIR ; - SWAP ; - CAR ; - PAIR } ; - DUP ; - DIP { DROP 17 } } ; - DIP { DROP } } - { DIP { DUP } ; - SWAP ; - DIP { DUP } ; - SWAP ; - PAIR ; - DUP ; - CDR ; - DIP { DUP } ; - SWAP ; - CAR ; - PACK ; - DIP { DUP } ; - SWAP ; - CAR ; - CDR ; - CDR ; - DIP { DUP } ; - SWAP ; - GET ; - IF_NONE - { DIP { DUP } ; SWAP } + DIP { DROP 2 } } { DUP ; - PUSH bool False ; SENDER ; - UPDATE ; - DUP ; - SIZE ; - DIP 2 { DUP } ; - DIG 2 ; - SIZE ; - COMPARE ; - NEQ ; - IF { DIP 3 { DUP } ; - DIG 3 ; - DIP 4 { DUP } ; - DIG 4 ; + MEM ; + IF { DIG 7 ; DUP ; DUG 8 } + { DIG 7 ; + DUP ; + DUG 8 ; + DIG 8 ; + DUP ; + DUG 9 ; CDR ; CAR ; CAR ; PUSH nat 1 ; - DIP 6 { DUP } ; - DIG 6 ; + DIG 10 ; + DUP ; + DUG 11 ; CDR ; CAR ; CAR ; SENDER ; GET ; IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; - SUB ; - ABS ; + ADD ; SOME ; SENDER ; UPDATE ; @@ -742,75 +519,382 @@ let%expect_test _ = PAIR ; SWAP ; PAIR ; - DIP 4 { DUP } ; - DIG 4 ; + DIG 8 ; + DUP ; + DUG 9 ; DIP { DUP } ; SWAP ; - DIP { DROP 2 } } - { DIP 3 { DUP } ; DIG 3 } ; - PUSH nat 0 ; - DIP 2 { DUP } ; - DIG 2 ; - SIZE ; - COMPARE ; - EQ ; - IF { DUP ; - DIP { DUP } ; - SWAP ; - CAR ; - CDR ; - CDR ; - DIP 5 { DUP } ; - DIG 5 ; - NONE (set address) ; - SWAP ; - UPDATE ; - DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; - SWAP ; - PAIR ; - SWAP ; - PAIR ; - PAIR ; - DIP { DUP } ; - SWAP ; - DIP { DUP } ; - SWAP ; - DIP { DROP 2 } } - { DUP ; - DIP { DUP } ; - SWAP ; - DIP 2 { DUP } ; - DIG 2 ; - CAR ; - CDR ; - CDR ; - DIP 4 { DUP } ; - DIG 4 ; - DIP 7 { DUP } ; - DIG 7 ; - SWAP ; - SOME ; - SWAP ; - UPDATE ; - DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; - SWAP ; - PAIR ; - SWAP ; - PAIR ; - PAIR ; - DIP { DROP } } ; - DIP 5 { DUP } ; - DIG 5 ; - DIP 2 { DUP } ; - DIG 2 ; - DIP { DROP ; DUP } ; + DIP { DROP 2 } } ; + DIP { DUP } ; SWAP ; - DIP { DROP 5 } } ; + PUSH bool True ; + SENDER ; + UPDATE ; + DIG 3 ; + DUP ; + DUG 4 ; + DIG 2 ; + DUP ; + DUG 3 ; + SWAP ; + CAR ; + PAIR ; + CDR ; + DIP { DUP } ; + SWAP ; + PAIR ; + DIP { DROP 3 } } ; DUP ; + CAR ; + DIP { DUP } ; + SWAP ; + CDR ; + DUP ; + CDR ; + CAR ; + CAR ; + SENDER ; + GET ; + IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; + DIP { DUP } ; + SWAP ; + CAR ; + CDR ; + CAR ; + DIP { DUP } ; + SWAP ; + COMPARE ; + GT ; + IF { PUSH string "Maximum number of proposal reached" ; FAILWITH } + { PUSH unit Unit } ; NIL operation ; + DIG 3 ; + DUP ; + DUG 4 ; + DIP { DUP } ; + SWAP ; PAIR ; + DIG 4 ; + DUP ; + DUG 5 ; + CDR ; + CDR ; + DIG 6 ; + DUP ; + DUG 7 ; + SIZE ; + COMPARE ; + GE ; + IF { DIG 4 ; + DUP ; + DUG 5 ; + DIG 5 ; + DUP ; + DUG 6 ; + CAR ; + CDR ; + CDR ; + DIG 12 ; + DUP ; + DUG 13 ; + NONE (set address) ; + SWAP ; + UPDATE ; + DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; + SWAP ; + PAIR ; + SWAP ; + PAIR ; + PAIR ; + DUP ; + CDR ; + CAR ; + CDR ; + DIG 13 ; + DUP ; + DUG 14 ; + SWAP ; + EXEC ; + DIP { DUP } ; + SWAP ; + DIG 13 ; + DUP ; + DUG 14 ; + DIG 3 ; + DUP ; + DUG 4 ; + CDR ; + CAR ; + CDR ; + CONCAT ; + SHA256 ; + DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CAR } ; + SWAP ; + PAIR ; + PAIR ; + SWAP ; + PAIR ; + DUP ; + DIP { DUP } ; + SWAP ; + CDR ; + CAR ; + CAR ; + ITER { SWAP ; + PAIR ; + DUP ; + CAR ; + DIP { DUP } ; + SWAP ; + CDR ; + CAR ; + DIG 11 ; + DUP ; + DUG 12 ; + DIP { DUP } ; + SWAP ; + MEM ; + IF { DIP { DUP } ; + SWAP ; + DIG 2 ; + DUP ; + DUG 3 ; + CDR ; + CAR ; + CAR ; + PUSH nat 1 ; + DIG 5 ; + DUP ; + DUG 6 ; + CDR ; + CDR ; + SUB ; + ABS ; + DIG 3 ; + DUP ; + DUG 4 ; + SWAP ; + SOME ; + SWAP ; + UPDATE ; + DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; + PAIR ; + PAIR ; + SWAP ; + PAIR ; + DIG 2 ; + DUP ; + DUG 3 ; + DIP { DUP } ; + SWAP ; + DIP { DROP 2 } } + { DIP { DUP } ; SWAP } ; + DIG 3 ; + DUP ; + DUG 4 ; + CDR ; + DIP { DUP } ; + SWAP ; + PAIR ; + CAR ; + DIP { DROP 4 } } ; + DIG 4 ; + DUP ; + DUG 5 ; + DIG 4 ; + DUP ; + DUG 5 ; + SWAP ; + CAR ; + PAIR ; + DIG 3 ; + DUP ; + DUG 4 ; + SWAP ; + CDR ; + SWAP ; + PAIR ; + DIG 2 ; + DUP ; + DUG 3 ; + SWAP ; + CAR ; + PAIR ; + CAR ; + DIP { DUP } ; + PAIR ; + DIP { DROP 4 } } + { DUP ; + DIG 5 ; + DUP ; + DUG 6 ; + DIG 6 ; + DUP ; + DUG 7 ; + CAR ; + CDR ; + CDR ; + DIG 8 ; + DUP ; + DUG 9 ; + DIG 14 ; + DUP ; + DUG 15 ; + SWAP ; + SOME ; + SWAP ; + UPDATE ; + DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; + SWAP ; + PAIR ; + SWAP ; + PAIR ; + PAIR ; + SWAP ; + CAR ; + PAIR } ; + DUP ; + DIP { DROP 17 } } ; + DIP { DROP } } + { DIP { DUP } ; + SWAP ; + DIP { DUP } ; + SWAP ; + PAIR ; + DUP ; + CDR ; + DIP { DUP } ; + SWAP ; + CAR ; + PACK ; + DIP { DUP } ; + SWAP ; + CAR ; + CDR ; + CDR ; + DIP { DUP } ; + SWAP ; + GET ; + IF_NONE + { DIP { DUP } ; SWAP } + { DUP ; + PUSH bool False ; + SENDER ; + UPDATE ; + DUP ; + SIZE ; + DIG 2 ; + DUP ; + DUG 3 ; + SIZE ; + COMPARE ; + NEQ ; + IF { DIG 3 ; + DUP ; + DUG 4 ; + DIG 4 ; + DUP ; + DUG 5 ; + CDR ; + CAR ; + CAR ; + PUSH nat 1 ; + DIG 6 ; + DUP ; + DUG 7 ; + CDR ; + CAR ; + CAR ; + SENDER ; + GET ; + IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; + SUB ; + ABS ; + SOME ; + SENDER ; + UPDATE ; + DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; + PAIR ; + PAIR ; + SWAP ; + PAIR ; + DIG 4 ; + DUP ; + DUG 5 ; + DIP { DUP } ; + SWAP ; + DIP { DROP 2 } } + { DIG 3 ; DUP ; DUG 4 } ; + PUSH nat 0 ; + DIG 2 ; + DUP ; + DUG 3 ; + SIZE ; + COMPARE ; + EQ ; + IF { DUP ; + DIP { DUP } ; + SWAP ; + CAR ; + CDR ; + CDR ; + DIG 5 ; + DUP ; + DUG 6 ; + NONE (set address) ; + SWAP ; + UPDATE ; + DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; + SWAP ; + PAIR ; + SWAP ; + PAIR ; + PAIR ; + DIP { DUP } ; + SWAP ; + DIP { DUP } ; + SWAP ; + DIP { DROP 2 } } + { DUP ; + DIP { DUP } ; + SWAP ; + DIG 2 ; + DUP ; + DUG 3 ; + CAR ; + CDR ; + CDR ; + DIG 4 ; + DUP ; + DUG 5 ; + DIG 7 ; + DUP ; + DUG 8 ; + SWAP ; + SOME ; + SWAP ; + UPDATE ; + DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; + SWAP ; + PAIR ; + SWAP ; + PAIR ; + PAIR ; + DIP { DROP } } ; + DIG 5 ; + DUP ; + DUG 6 ; + DIG 2 ; + DUP ; + DUG 3 ; + DIP { DROP ; DUP } ; + SWAP ; DIP { DROP 5 } } ; - DIP { DROP 2 } } } |} ] + DUP ; + NIL operation ; + PAIR ; + DIP { DROP 5 } } ; + DIP { DROP 2 } } } |} ] let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "vote.mligo" ; "main" ] ; @@ -831,14 +915,16 @@ let%expect_test _ = DIP { DUP } ; SWAP ; CDR ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CAR ; CDR ; PAIR ; PUSH nat 0 ; - DIP 3 { DUP } ; DIG 3 ; + DUP ; + DUG 4 ; CAR ; CAR ; PAIR ; @@ -857,15 +943,18 @@ let%expect_test _ = CDR ; NOW ; SENDER ; - DIP 3 { DUP } ; DIG 3 ; + DUP ; + DUG 4 ; CAR ; IF_LEFT - { DIP 3 { DUP } ; - DIG 3 ; + { DIG 3 ; + DUP ; + DUG 4 ; PUSH nat 1 ; - DIP 5 { DUP } ; DIG 5 ; + DUP ; + DUG 6 ; CAR ; CAR ; CDR ; @@ -876,11 +965,13 @@ let%expect_test _ = PAIR ; PAIR ; DIP { DROP } } - { DIP 3 { DUP } ; - DIG 3 ; + { DIG 3 ; + DUP ; + DUG 4 ; PUSH nat 1 ; - DIP 5 { DUP } ; DIG 5 ; + DUP ; + DUG 6 ; CDR ; CDR ; ADD ; @@ -895,8 +986,9 @@ let%expect_test _ = SWAP ; CDR ; CAR ; - DIP 3 { DUP } ; DIG 3 ; + DUP ; + DUG 4 ; PUSH bool True ; SWAP ; UPDATE ; @@ -1125,8 +1217,9 @@ ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, char SWAP ; CDR ; NIL operation ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CAR ; CONS ; PAIR ; @@ -1223,12 +1316,14 @@ let%expect_test _ = PUSH mutez 300000000 ; PUSH int 2 ; TRANSFER_TOKENS ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CDR ; NIL operation ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CONS ; PAIR ; DIP { DROP 3 } } } |}] ; @@ -1242,12 +1337,14 @@ let%expect_test _ = PUSH mutez 300000000 ; PUSH int 2 ; TRANSFER_TOKENS ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CDR ; NIL operation ; - DIP 2 { DUP } ; DIG 2 ; + DUP ; + DUG 3 ; CONS ; PAIR ; DIP { DROP 3 } } } |}] ; diff --git a/src/passes/12-compiler/compiler_environment.ml b/src/passes/12-compiler/compiler_environment.ml index 0736593ee..0786def09 100644 --- a/src/passes/12-compiler/compiler_environment.ml +++ b/src/passes/12-compiler/compiler_environment.ml @@ -24,8 +24,9 @@ let get : environment -> expression_variable -> michelson result = fun e s -> ] in let aux_dig = fun n -> seq [ - dipn n i_dup ; i_dig n ; + i_dup ; + i_dug (n + 1) ; ] in let code = From 56fe3b60217c3c2e4b175f1019b4896b56ad854d Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Mon, 3 Feb 2020 17:34:52 -0600 Subject: [PATCH 6/6] Don't dip for the second var either --- src/bin/expect_tests/contract_tests.ml | 501 ++++++++++++++---- .../12-compiler/compiler_environment.ml | 12 +- 2 files changed, 391 insertions(+), 122 deletions(-) diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 98b286f3a..69f2c4a7d 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -7,16 +7,16 @@ let bad_contract basename = let%expect_test _ = run_ligo_good [ "measure-contract" ; contract "coase.ligo" ; "main" ] ; - [%expect {| 1682 bytes |}] ; + [%expect {| 1700 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ; - [%expect {| 1003 bytes |}] ; + [%expect {| 995 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ; - [%expect {| 2522 bytes |}] ; + [%expect {| 2512 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ; - [%expect {| 586 bytes |}] ; + [%expect {| 582 bytes |}] ; run_ligo_good [ "compile-parameter" ; contract "coase.ligo" ; "main" ; "Buy_single (record card_to_buy = 1n end)" ] ; [%expect {| (Left (Left 1)) |}] ; @@ -68,8 +68,9 @@ let%expect_test _ = (nat %next_id)) ; code { DUP ; CDR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CAR ; IF_LEFT { DUP ; @@ -77,13 +78,15 @@ let%expect_test _ = { DIG 2 ; DUP ; DUG 3 ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; PAIR ; DUP ; CAR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; DUP ; CAR ; @@ -95,18 +98,21 @@ let%expect_test _ = IF_NONE { PUSH string "buy_single: No card pattern." ; FAILWITH } { DUP ; DIP { DROP } } ; - DUP ; PUSH nat 1 ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; ADD ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CAR ; MUL ; - DUP ; AMOUNT ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; COMPARE ; GT ; IF { PUSH string "Not enough money" ; FAILWITH } { PUSH unit Unit } ; @@ -159,10 +165,12 @@ let%expect_test _ = SOME ; SWAP ; UPDATE ; - DIP { DUP } ; - SWAP ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; + DIG 1 ; + DUP ; + DUG 2 ; DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; SWAP ; PAIR ; @@ -184,13 +192,15 @@ let%expect_test _ = { DIG 2 ; DUP ; DUG 3 ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; PAIR ; DUP ; CAR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; DUP ; CAR ; @@ -202,9 +212,10 @@ let%expect_test _ = IF_NONE { PUSH string "sell_single: No card." ; FAILWITH } { DUP ; DIP { DROP } } ; - DUP ; SENDER ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CAR ; COMPARE ; NEQ ; @@ -285,9 +296,10 @@ let%expect_test _ = DUG 3 ; UNIT ; TRANSFER_TOKENS ; - DUP ; NIL operation ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CONS ; DIG 5 ; DUP ; @@ -299,20 +311,24 @@ let%expect_test _ = SWAP ; PAIR ; PAIR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; PAIR ; DIP { DROP 14 } } ; DIP { DROP } } - { DIP { DUP } ; - SWAP ; - DIP { DUP } ; - SWAP ; + { DIG 1 ; + DUP ; + DUG 2 ; + DIG 1 ; + DUP ; + DUG 2 ; PAIR ; DUP ; CAR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; DUP ; CAR ; @@ -326,9 +342,10 @@ let%expect_test _ = IF_NONE { PUSH string "transfer_single: No card." ; FAILWITH } { DUP ; DIP { DROP } } ; - DUP ; SENDER ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CAR ; COMPARE ; NEQ ; @@ -368,6 +385,220 @@ let%expect_test _ = DIP { DROP 7 } } ; DIP { DROP 2 } } } |} ] +let%expect_test _ = + run_ligo_good [ "compile-contract" ; contract "multisig.ligo" ; "main" ] ; + [%expect {| +{ parameter + (pair (pair (nat %counter) (lambda %message unit (list operation))) + (list %signatures (pair key_hash signature))) ; + storage + (pair (pair (list %auth key) (nat %counter)) (pair (string %id) (nat %threshold))) ; + code { DUP ; + CAR ; + DIG 1 ; + DUP ; + DUG 2 ; + CDR ; + DIG 1 ; + DUP ; + DUG 2 ; + CAR ; + CDR ; + DIG 1 ; + DUP ; + DUG 2 ; + CAR ; + CDR ; + DIG 3 ; + DUP ; + DUG 4 ; + CAR ; + CAR ; + COMPARE ; + NEQ ; + IF { PUSH string "Counters does not match" ; FAILWITH } + { CHAIN_ID ; + DIG 2 ; + DUP ; + DUG 3 ; + CDR ; + CAR ; + PAIR ; + DIG 3 ; + DUP ; + DUG 4 ; + CAR ; + CAR ; + DIG 2 ; + DUP ; + DUG 3 ; + PAIR ; + PAIR ; + PACK ; + PUSH nat 0 ; + DIG 3 ; + DUP ; + DUG 4 ; + CAR ; + CAR ; + PAIR ; + DIG 4 ; + DUP ; + DUG 5 ; + CDR ; + ITER { SWAP ; + PAIR ; + DUP ; + CAR ; + CDR ; + DIG 1 ; + DUP ; + DUG 2 ; + CAR ; + CAR ; + DIG 2 ; + DUP ; + DUG 3 ; + CDR ; + DIG 2 ; + DUP ; + DUG 3 ; + DIG 2 ; + DUP ; + DUG 3 ; + PAIR ; + DIG 2 ; + DUP ; + DUG 3 ; + IF_CONS + { DUP ; + HASH_KEY ; + DIG 4 ; + DUP ; + DUG 5 ; + CAR ; + COMPARE ; + EQ ; + IF { DIG 7 ; + DUP ; + DUG 8 ; + DIG 4 ; + DUP ; + DUG 5 ; + CDR ; + DIG 2 ; + DUP ; + DUG 3 ; + CHECK_SIGNATURE ; + IF { PUSH nat 1 ; + DIG 6 ; + DUP ; + DUG 7 ; + ADD ; + DIG 6 ; + DUP ; + DUG 7 ; + DIG 1 ; + DUP ; + DUG 2 ; + DIP { DROP 2 } } + { PUSH string "Invalid signature" ; FAILWITH } ; + DIG 6 ; + DUP ; + DUG 7 ; + DIG 1 ; + DUP ; + DUG 2 ; + DIP { DROP 2 } } + { DIG 5 ; DUP ; DUG 6 } ; + DIG 3 ; + DUP ; + DUG 4 ; + DIG 3 ; + DUP ; + DUG 4 ; + SWAP ; + CDR ; + SWAP ; + PAIR ; + DIG 1 ; + DUP ; + DUG 2 ; + SWAP ; + CAR ; + PAIR ; + DIP { DROP 3 } } + { DUP } ; + DIG 5 ; + DUP ; + DUG 6 ; + DIG 1 ; + DUP ; + DUG 2 ; + CAR ; + DIP { DUP ; CDR ; SWAP ; CAR ; CDR } ; + PAIR ; + PAIR ; + DIG 1 ; + DUP ; + DUG 2 ; + CDR ; + DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; + SWAP ; + PAIR ; + PAIR ; + CAR ; + DIP { DROP 6 } } ; + DIG 3 ; + DUP ; + DUG 4 ; + CDR ; + CDR ; + DIG 1 ; + DUP ; + DUG 2 ; + CDR ; + COMPARE ; + LT ; + IF { PUSH string "Not enough signatures passed the check" ; FAILWITH } + { DIG 3 ; + DUP ; + DUG 4 ; + PUSH nat 1 ; + DIG 5 ; + DUP ; + DUG 6 ; + CAR ; + CDR ; + ADD ; + DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; + SWAP ; + PAIR ; + PAIR ; + DIG 4 ; + DUP ; + DUG 5 ; + DIG 1 ; + DUP ; + DUG 2 ; + DIP { DROP 2 } } ; + DIG 4 ; + DUP ; + DUG 5 ; + DIG 1 ; + DUP ; + DUG 2 ; + DIP { DROP 4 } } ; + DUP ; + UNIT ; + DIG 3 ; + DUP ; + DUG 4 ; + SWAP ; + EXEC ; + PAIR ; + DIP { DROP 5 } } } |} ] + let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "multisig-v2.ligo" ; "main" ] ; [%expect {| @@ -381,8 +612,9 @@ let%expect_test _ = (nat %threshold))) ; code { DUP ; CDR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CAR ; IF_LEFT { DUP ; @@ -391,8 +623,9 @@ let%expect_test _ = { DIG 2 ; DUP ; DUG 3 ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; PAIR ; DUP ; CDR ; @@ -416,8 +649,9 @@ let%expect_test _ = CAR ; CAR ; CDR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; SIZE ; COMPARE ; GT ; @@ -427,8 +661,9 @@ let%expect_test _ = DIG 5 ; DUP ; DUG 6 ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; PAIR ; DIG 6 ; DUP ; @@ -482,8 +717,11 @@ let%expect_test _ = SWAP ; CAR ; PAIR ; + DIG 1 ; + DUP ; + DUG 2 ; + SWAP ; CDR ; - DIP { DUP } ; SWAP ; PAIR ; DIP { DROP 2 } } @@ -522,11 +760,13 @@ let%expect_test _ = DIG 8 ; DUP ; DUG 9 ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; DIP { DROP 2 } } ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; PUSH bool True ; SENDER ; UPDATE ; @@ -539,15 +779,19 @@ let%expect_test _ = SWAP ; CAR ; PAIR ; + DIG 1 ; + DUP ; + DUG 2 ; + SWAP ; CDR ; - DIP { DUP } ; SWAP ; PAIR ; DIP { DROP 3 } } ; DUP ; CAR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; DUP ; CDR ; @@ -556,13 +800,15 @@ let%expect_test _ = SENDER ; GET ; IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CAR ; CDR ; CAR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; COMPARE ; GT ; IF { PUSH string "Maximum number of proposal reached" ; FAILWITH } @@ -571,8 +817,9 @@ let%expect_test _ = DIG 3 ; DUP ; DUG 4 ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; PAIR ; DIG 4 ; DUP ; @@ -615,8 +862,9 @@ let%expect_test _ = DUG 14 ; SWAP ; EXEC ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; DIG 13 ; DUP ; DUG 14 ; @@ -635,8 +883,9 @@ let%expect_test _ = SWAP ; PAIR ; DUP ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; CAR ; CAR ; @@ -644,18 +893,21 @@ let%expect_test _ = PAIR ; DUP ; CAR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; CAR ; DIG 11 ; DUP ; DUG 12 ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; MEM ; - IF { DIP { DUP } ; - SWAP ; + IF { DIG 1 ; + DUP ; + DUG 2 ; DIG 2 ; DUP ; DUG 3 ; @@ -685,15 +937,19 @@ let%expect_test _ = DIG 2 ; DUP ; DUG 3 ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; DIP { DROP 2 } } - { DIP { DUP } ; SWAP } ; + { DIG 1 ; DUP ; DUG 2 } ; DIG 3 ; DUP ; DUG 4 ; + DIG 1 ; + DUP ; + DUG 2 ; + SWAP ; CDR ; - DIP { DUP } ; SWAP ; PAIR ; CAR ; @@ -720,8 +976,11 @@ let%expect_test _ = SWAP ; CAR ; PAIR ; + DIG 1 ; + DUP ; + DUG 2 ; + SWAP ; CAR ; - DIP { DUP } ; PAIR ; DIP { DROP 4 } } { DUP ; @@ -756,27 +1015,32 @@ let%expect_test _ = DUP ; DIP { DROP 17 } } ; DIP { DROP } } - { DIP { DUP } ; - SWAP ; - DIP { DUP } ; - SWAP ; + { DIG 1 ; + DUP ; + DUG 2 ; + DIG 1 ; + DUP ; + DUG 2 ; PAIR ; DUP ; CDR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CAR ; PACK ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CAR ; CDR ; CDR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; GET ; IF_NONE - { DIP { DUP } ; SWAP } + { DIG 1 ; DUP ; DUG 2 } { DUP ; PUSH bool False ; SENDER ; @@ -821,8 +1085,9 @@ let%expect_test _ = DIG 4 ; DUP ; DUG 5 ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; DIP { DROP 2 } } { DIG 3 ; DUP ; DUG 4 } ; PUSH nat 0 ; @@ -833,8 +1098,9 @@ let%expect_test _ = COMPARE ; EQ ; IF { DUP ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CAR ; CDR ; CDR ; @@ -850,14 +1116,17 @@ let%expect_test _ = SWAP ; PAIR ; PAIR ; - DIP { DUP } ; - SWAP ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; + DIG 1 ; + DUP ; + DUG 2 ; DIP { DROP 2 } } { DUP ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; DIG 2 ; DUP ; DUG 3 ; @@ -887,8 +1156,10 @@ let%expect_test _ = DIG 2 ; DUP ; DUG 3 ; - DIP { DROP ; DUP } ; - SWAP ; + DIP { DROP } ; + DIG 1 ; + DUP ; + DUG 2 ; DIP { DROP 5 } } ; DUP ; NIL operation ; @@ -912,8 +1183,9 @@ let%expect_test _ = { PUSH nat 0 ; EMPTY_SET address ; PAIR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; DIG 2 ; DUP ; @@ -933,11 +1205,13 @@ let%expect_test _ = NIL operation ; PAIR ; DIP { DROP } } - { DIP { DUP } ; - SWAP ; + { DIG 1 ; + DUP ; + DUG 2 ; CDR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; PAIR ; DUP ; CDR ; @@ -982,8 +1256,9 @@ let%expect_test _ = PAIR ; DIP { DROP } } ; DUP ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; CAR ; DIG 3 ; @@ -1027,7 +1302,7 @@ let%expect_test _ = LAMBDA (pair mutez unit) mutez - { DUP ; CAR ; SWAP ; CDR ; DIP { DUP } ; SWAP ; DIP { DROP 2 } } ; + { DUP ; CAR ; SWAP ; CDR ; DIG 1 ; DUP ; DUG 2 ; DIP { DROP 2 } } ; SWAP ; APPLY ; DIP { DROP } } @@ -1213,8 +1488,9 @@ ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, char storage string ; code { PUSH string "one" ; NIL operation ; PAIR ; DIP { DROP } } } ; PAIR ; - DIP { DUP } ; - SWAP ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; NIL operation ; DIG 2 ; @@ -1258,9 +1534,10 @@ let%expect_test _ = [%expect {| { parameter nat ; storage int ; - code { DUP ; - SELF %default ; - SWAP ; + code { SELF %default ; + DIG 1 ; + DUP ; + DUG 2 ; CDR ; NIL operation ; PAIR ; diff --git a/src/passes/12-compiler/compiler_environment.ml b/src/passes/12-compiler/compiler_environment.ml index 0786def09..5b429208f 100644 --- a/src/passes/12-compiler/compiler_environment.ml +++ b/src/passes/12-compiler/compiler_environment.ml @@ -15,14 +15,6 @@ let get : environment -> expression_variable -> michelson result = fun e s -> error title content in generic_try error @@ (fun () -> Environment.get_i s e) in - let rec aux_bubble = fun n -> - match n with - | 0 -> i_dup - | n -> seq [ - dip @@ aux_bubble (n - 1) ; - i_swap ; - ] - in let aux_dig = fun n -> seq [ i_dig n ; i_dup ; @@ -30,8 +22,8 @@ let get : environment -> expression_variable -> michelson result = fun e s -> ] in let code = - if position < 2 - then aux_bubble position + if position < 1 + then i_dup else aux_dig position in ok code