From 5a4c0b32fb4133b309717145c3f088fc7815edae Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Tue, 17 Mar 2020 16:04:27 +0100 Subject: [PATCH] rewrite test suite to compare value from ast_imperative instead of ast_core; includes uncompiler fo stage 4 and 6 --- src/bin/cli.ml | 2 +- src/main/uncompile/dune | 2 + src/main/uncompile/uncompile.ml | 3 +- .../imperative_to_sugar.ml | 169 ++++++++++++++++++ src/passes/6-sugar_to_core/sugar_to_core.ml | 169 ++++++++++++++++++ src/test/coase_tests.ml | 9 +- src/test/hash_lock_tests.ml | 2 +- src/test/id_tests.ml | 2 +- src/test/integration_tests.ml | 65 ++++--- src/test/multisig_tests.ml | 2 +- src/test/multisig_v2_tests.ml | 4 +- src/test/pledge_tests.ml | 3 +- src/test/replaceable_id_tests.ml | 3 +- src/test/test_helpers.ml | 51 ++++-- src/test/time_lock_repeat_tests.ml | 2 +- src/test/time_lock_tests.ml | 3 +- src/test/vote_tests.ml | 10 +- 17 files changed, 431 insertions(+), 70 deletions(-) diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 950d64549..1c9a60fe1 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -381,7 +381,7 @@ let evaluate_value = let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; balance ; sender ; source } in let%bind michelson_output = Run.run_no_failwith ~options compiled.expr compiled.expr_ty in - let%bind core_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in + let%bind core_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in ok @@ Format.asprintf "%a\n" Ast_core.PP.expression core_output in let term = diff --git a/src/main/uncompile/dune b/src/main/uncompile/dune index bf039deb8..8762c6abf 100644 --- a/src/main/uncompile/dune +++ b/src/main/uncompile/dune @@ -4,6 +4,8 @@ (libraries simple-utils compiler + imperative_to_sugar + sugar_to_core typer_new typer ast_typed diff --git a/src/main/uncompile/uncompile.ml b/src/main/uncompile/uncompile.ml index 6d43fba15..3adf7445e 100644 --- a/src/main/uncompile/uncompile.ml +++ b/src/main/uncompile/uncompile.ml @@ -10,7 +10,8 @@ let uncompile_value func_or_expr program entry ex_ty_value = ok output_type in let%bind mini_c = Compiler.Uncompiler.translate_value ex_ty_value in let%bind typed = Transpiler.untranspile mini_c output_type in - Typer.untype_expression typed + let%bind core = Typer.untype_expression typed in + ok @@ core let uncompile_typed_program_entry_expression_result program entry ex_ty_value = uncompile_value Expression program entry ex_ty_value diff --git a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml index 3020d9254..fc30c7e88 100644 --- a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml +++ b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml @@ -184,3 +184,172 @@ let compile_declaration : I.declaration Location.wrap -> _ = let compile_program : I.program -> O.program result = fun p -> bind_map_list compile_declaration p + +(* uncompiling *) +let rec uncompile_type_expression : O.type_expression -> I.type_expression result = + fun te -> + let return te = ok @@ I.make_t te in + match te.type_content with + | O.T_sum sum -> + let sum = I.CMap.to_kv_list sum in + let%bind sum = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_type_expression v in + ok @@ (k,v) + ) sum + in + return @@ I.T_sum (O.CMap.of_list sum) + | O.T_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_type_expression v in + ok @@ (k,v) + ) record + in + return @@ I.T_record (O.LMap.of_list record) + | O.T_arrow {type1;type2} -> + let%bind type1 = uncompile_type_expression type1 in + let%bind type2 = uncompile_type_expression type2 in + return @@ T_arrow {type1;type2} + | O.T_variable type_variable -> return @@ T_variable type_variable + | O.T_constant type_constant -> return @@ T_constant type_constant + | O.T_operator type_operator -> + let%bind type_operator = uncompile_type_operator type_operator in + return @@ T_operator type_operator + +and uncompile_type_operator : O.type_operator -> I.type_operator result = + fun t_o -> + match t_o with + | TC_contract c -> + let%bind c = uncompile_type_expression c in + ok @@ I.TC_contract c + | TC_option o -> + let%bind o = uncompile_type_expression o in + ok @@ I.TC_option o + | TC_list l -> + let%bind l = uncompile_type_expression l in + ok @@ I.TC_list l + | TC_set s -> + let%bind s = uncompile_type_expression s in + ok @@ I.TC_set s + | TC_map (k,v) -> + let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in + ok @@ I.TC_map (k,v) + | TC_big_map (k,v) -> + let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in + ok @@ I.TC_big_map (k,v) + | TC_arrow (i,o) -> + let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in + ok @@ I.TC_arrow (i,o) + +let rec uncompile_expression : O.expression -> I.expression result = + fun e -> + let return expr = ok @@ I.make_expr ~loc:e.location expr in + match e.expression_content with + O.E_literal lit -> return @@ I.E_literal lit + | O.E_constant {cons_name;arguments} -> + let%bind arguments = bind_map_list uncompile_expression arguments in + return @@ I.E_constant {cons_name;arguments} + | O.E_variable name -> return @@ I.E_variable name + | O.E_application {expr1;expr2} -> + let%bind expr1 = uncompile_expression expr1 in + let%bind expr2 = uncompile_expression expr2 in + return @@ I.E_application {expr1; expr2} + | O.E_lambda lambda -> + let%bind lambda = uncompile_lambda lambda in + return @@ I.E_lambda lambda + | O.E_recursive {fun_name;fun_type;lambda} -> + let%bind fun_type = uncompile_type_expression fun_type in + let%bind lambda = uncompile_lambda lambda in + return @@ I.E_recursive {fun_name;fun_type;lambda} + | O.E_let_in {let_binder;inline;rhs;let_result} -> + let (binder,ty_opt) = let_binder in + let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in + let%bind rhs = uncompile_expression rhs in + let%bind let_result = uncompile_expression let_result in + return @@ I.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result} + | O.E_skip -> return @@ I.E_skip + | O.E_constructor {constructor;element} -> + let%bind element = uncompile_expression element in + return @@ I.E_constructor {constructor;element} + | O.E_matching {matchee; cases} -> + let%bind matchee = uncompile_expression matchee in + let%bind cases = uncompile_matching cases in + return @@ I.E_matching {matchee;cases} + | O.E_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_expression v in + ok @@ (k,v) + ) record + in + return @@ I.E_record (O.LMap.of_list record) + | O.E_record_accessor {expr;label} -> + let%bind expr = uncompile_expression expr in + return @@ I.E_record_accessor {expr;label} + | O.E_record_update {record;path;update} -> + let%bind record = uncompile_expression record in + let%bind update = uncompile_expression update in + return @@ I.E_record_update {record;path;update} + | O.E_map map -> + let%bind map = bind_map_list ( + bind_map_pair uncompile_expression + ) map + in + return @@ I.E_map map + | O.E_big_map big_map -> + let%bind big_map = bind_map_list ( + bind_map_pair uncompile_expression + ) big_map + in + return @@ I.E_big_map big_map + | O.E_list lst -> + let%bind lst = bind_map_list uncompile_expression lst in + return @@ I.E_list lst + | O.E_set set -> + let%bind set = bind_map_list uncompile_expression set in + return @@ I.E_set set + | O.E_look_up look_up -> + let%bind look_up = bind_map_pair uncompile_expression look_up in + return @@ I.E_look_up look_up + | O.E_ascription {anno_expr; type_annotation} -> + let%bind anno_expr = uncompile_expression anno_expr in + let%bind type_annotation = uncompile_type_expression type_annotation in + return @@ I.E_ascription {anno_expr; type_annotation} + +and uncompile_lambda : O.lambda -> I.lambda result = + fun {binder;input_type;output_type;result}-> + let%bind input_type = bind_map_option uncompile_type_expression input_type in + let%bind output_type = bind_map_option uncompile_type_expression output_type in + let%bind result = uncompile_expression result in + ok @@ I.{binder;input_type;output_type;result} +and uncompile_matching : O.matching_expr -> I.matching_expr result = + fun m -> + match m with + | O.Match_bool {match_true;match_false} -> + let%bind match_true = uncompile_expression match_true in + let%bind match_false = uncompile_expression match_false in + ok @@ I.Match_bool {match_true;match_false} + | O.Match_list {match_nil;match_cons} -> + let%bind match_nil = uncompile_expression match_nil in + let (hd,tl,expr,tv) = match_cons in + let%bind expr = uncompile_expression expr in + ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)} + | O.Match_option {match_none;match_some} -> + let%bind match_none = uncompile_expression match_none in + let (n,expr,tv) = match_some in + let%bind expr = uncompile_expression expr in + ok @@ I.Match_option {match_none; match_some=(n,expr,tv)} + | O.Match_tuple ((lst,expr), tv) -> + let%bind expr = uncompile_expression expr in + ok @@ O.Match_tuple ((lst,expr), tv) + | O.Match_variant (lst,tv) -> + let%bind lst = bind_map_list ( + fun ((c,n),expr) -> + let%bind expr = uncompile_expression expr in + ok @@ ((c,n),expr) + ) lst + in + ok @@ I.Match_variant (lst,tv) diff --git a/src/passes/6-sugar_to_core/sugar_to_core.ml b/src/passes/6-sugar_to_core/sugar_to_core.ml index a5c525526..b6138ed7f 100644 --- a/src/passes/6-sugar_to_core/sugar_to_core.ml +++ b/src/passes/6-sugar_to_core/sugar_to_core.ml @@ -185,3 +185,172 @@ let compile_declaration : I.declaration Location.wrap -> _ = let compile_program : I.program -> O.program result = fun p -> bind_map_list compile_declaration p + +(* uncompiling *) +let rec uncompile_type_expression : O.type_expression -> I.type_expression result = + fun te -> + let return te = ok @@ I.make_t te in + match te.type_content with + | O.T_sum sum -> + let sum = I.CMap.to_kv_list sum in + let%bind sum = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_type_expression v in + ok @@ (k,v) + ) sum + in + return @@ I.T_sum (O.CMap.of_list sum) + | O.T_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_type_expression v in + ok @@ (k,v) + ) record + in + return @@ I.T_record (O.LMap.of_list record) + | O.T_arrow {type1;type2} -> + let%bind type1 = uncompile_type_expression type1 in + let%bind type2 = uncompile_type_expression type2 in + return @@ T_arrow {type1;type2} + | O.T_variable type_variable -> return @@ T_variable type_variable + | O.T_constant type_constant -> return @@ T_constant type_constant + | O.T_operator type_operator -> + let%bind type_operator = uncompile_type_operator type_operator in + return @@ T_operator type_operator + +and uncompile_type_operator : O.type_operator -> I.type_operator result = + fun t_o -> + match t_o with + | TC_contract c -> + let%bind c = uncompile_type_expression c in + ok @@ I.TC_contract c + | TC_option o -> + let%bind o = uncompile_type_expression o in + ok @@ I.TC_option o + | TC_list l -> + let%bind l = uncompile_type_expression l in + ok @@ I.TC_list l + | TC_set s -> + let%bind s = uncompile_type_expression s in + ok @@ I.TC_set s + | TC_map (k,v) -> + let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in + ok @@ I.TC_map (k,v) + | TC_big_map (k,v) -> + let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in + ok @@ I.TC_big_map (k,v) + | TC_arrow (i,o) -> + let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in + ok @@ I.TC_arrow (i,o) + +let rec uncompile_expression : O.expression -> I.expression result = + fun e -> + let return expr = ok @@ I.make_expr ~loc:e.location expr in + match e.expression_content with + O.E_literal lit -> return @@ I.E_literal lit + | O.E_constant {cons_name;arguments} -> + let%bind arguments = bind_map_list uncompile_expression arguments in + return @@ I.E_constant {cons_name;arguments} + | O.E_variable name -> return @@ I.E_variable name + | O.E_application {expr1;expr2} -> + let%bind expr1 = uncompile_expression expr1 in + let%bind expr2 = uncompile_expression expr2 in + return @@ I.E_application {expr1; expr2} + | O.E_lambda lambda -> + let%bind lambda = uncompile_lambda lambda in + return @@ I.E_lambda lambda + | O.E_recursive {fun_name;fun_type;lambda} -> + let%bind fun_type = uncompile_type_expression fun_type in + let%bind lambda = uncompile_lambda lambda in + return @@ I.E_recursive {fun_name;fun_type;lambda} + | O.E_let_in {let_binder;inline;rhs;let_result} -> + let (binder,ty_opt) = let_binder in + let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in + let%bind rhs = uncompile_expression rhs in + let%bind let_result = uncompile_expression let_result in + return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result} + | O.E_skip -> return @@ I.E_skip + | O.E_constructor {constructor;element} -> + let%bind element = uncompile_expression element in + return @@ I.E_constructor {constructor;element} + | O.E_matching {matchee; cases} -> + let%bind matchee = uncompile_expression matchee in + let%bind cases = uncompile_matching cases in + return @@ I.E_matching {matchee;cases} + | O.E_record record -> + let record = I.LMap.to_kv_list record in + let%bind record = + bind_map_list (fun (k,v) -> + let%bind v = uncompile_expression v in + ok @@ (k,v) + ) record + in + return @@ I.E_record (O.LMap.of_list record) + | O.E_record_accessor {expr;label} -> + let%bind expr = uncompile_expression expr in + return @@ I.E_record_accessor {expr;label} + | O.E_record_update {record;path;update} -> + let%bind record = uncompile_expression record in + let%bind update = uncompile_expression update in + return @@ I.E_record_update {record;path;update} + | O.E_map map -> + let%bind map = bind_map_list ( + bind_map_pair uncompile_expression + ) map + in + return @@ I.E_map map + | O.E_big_map big_map -> + let%bind big_map = bind_map_list ( + bind_map_pair uncompile_expression + ) big_map + in + return @@ I.E_big_map big_map + | O.E_list lst -> + let%bind lst = bind_map_list uncompile_expression lst in + return @@ I.E_list lst + | O.E_set set -> + let%bind set = bind_map_list uncompile_expression set in + return @@ I.E_set set + | O.E_look_up look_up -> + let%bind look_up = bind_map_pair uncompile_expression look_up in + return @@ I.E_look_up look_up + | O.E_ascription {anno_expr; type_annotation} -> + let%bind anno_expr = uncompile_expression anno_expr in + let%bind type_annotation = uncompile_type_expression type_annotation in + return @@ I.E_ascription {anno_expr; type_annotation} + +and uncompile_lambda : O.lambda -> I.lambda result = + fun {binder;input_type;output_type;result}-> + let%bind input_type = bind_map_option uncompile_type_expression input_type in + let%bind output_type = bind_map_option uncompile_type_expression output_type in + let%bind result = uncompile_expression result in + ok @@ I.{binder;input_type;output_type;result} +and uncompile_matching : O.matching_expr -> I.matching_expr result = + fun m -> + match m with + | O.Match_bool {match_true;match_false} -> + let%bind match_true = uncompile_expression match_true in + let%bind match_false = uncompile_expression match_false in + ok @@ I.Match_bool {match_true;match_false} + | O.Match_list {match_nil;match_cons} -> + let%bind match_nil = uncompile_expression match_nil in + let (hd,tl,expr,tv) = match_cons in + let%bind expr = uncompile_expression expr in + ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)} + | O.Match_option {match_none;match_some} -> + let%bind match_none = uncompile_expression match_none in + let (n,expr,tv) = match_some in + let%bind expr = uncompile_expression expr in + ok @@ I.Match_option {match_none; match_some=(n,expr,tv)} + | O.Match_tuple ((lst,expr), tv) -> + let%bind expr = uncompile_expression expr in + ok @@ O.Match_tuple ((lst,expr), tv) + | O.Match_variant (lst,tv) -> + let%bind lst = bind_map_list ( + fun ((c,n),expr) -> + let%bind expr = uncompile_expression expr in + ok @@ ((c,n),expr) + ) lst + in + ok @@ I.Match_variant (lst,tv) diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml index 73520c60e..dcf82891a 100644 --- a/src/test/coase_tests.ml +++ b/src/test/coase_tests.ml @@ -27,7 +27,7 @@ let compile_main () = Ligo.Compile.Of_michelson.build_contract michelson_prg in ok () -open Ast_core +open Ast_imperative let card owner = e_record_ez [ @@ -220,14 +220,15 @@ let sell () = let storage = basic 100 1000 cards (2 * n) in e_pair sell_action storage in - let make_expecter : int -> expression -> unit result = fun n result -> - let%bind (ops , storage) = get_e_pair result.expression_content in + let make_expecter : int -> Ast_core.expression -> unit result = fun n result -> + let%bind (ops , storage) = Ast_core.get_e_pair result.expression_content in let%bind () = - let%bind lst = get_e_list ops.expression_content in + let%bind lst = Ast_core.get_e_list ops.expression_content in Assert.assert_list_size lst 1 in let expected_storage = let cards = List.hds @@ cards_ez first_owner n in basic 99 1000 cards (2 * n) in + let%bind expected_storage = Test_helpers.expression_to_core expected_storage in Ast_core.Misc.assert_value_eq (expected_storage , storage) in let%bind () = diff --git a/src/test/hash_lock_tests.ml b/src/test/hash_lock_tests.ml index d6bfd7aed..e33364cda 100644 --- a/src/test/hash_lock_tests.ml +++ b/src/test/hash_lock_tests.ml @@ -1,6 +1,6 @@ open Trace open Test_helpers -open Ast_core +open Ast_imperative let type_file f = let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" (Contract "main") in diff --git a/src/test/id_tests.ml b/src/test/id_tests.ml index 8632c78e0..4d7a88a6d 100644 --- a/src/test/id_tests.ml +++ b/src/test/id_tests.ml @@ -1,6 +1,6 @@ open Trace open Test_helpers -open Ast_core +open Ast_imperative let mtype_file f = diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 8b84434ed..2b9bc2ed8 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1,7 +1,7 @@ open Trace open Test_helpers -open Ast_core.Combinators +open Ast_imperative.Combinators let retype_file f = let%bind typed,state = Ligo.Compile.Utils.type_file f "reasonligo" Env in @@ -424,9 +424,9 @@ let bytes_arithmetic () : unit result = let%bind () = expect_eq program "slice_op" tata at in let%bind () = expect_fail program "slice_op" foo in let%bind () = expect_fail program "slice_op" ba in - let%bind b1 = Test_helpers.run_typed_program_with_core_input program "hasherman" foo in - let%bind () = expect_eq program "hasherman" foo b1 in - let%bind b3 = Test_helpers.run_typed_program_with_core_input program "hasherman" foototo in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foo in + let%bind () = expect_eq_core program "hasherman" foo b1 in + let%bind b3 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foototo in let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b3 , b1) in ok () @@ -434,13 +434,13 @@ let crypto () : unit result = let%bind program = type_file "./contracts/crypto.ligo" in let%bind foo = e_bytes_hex "0f00" in let%bind foototo = e_bytes_hex "0f007070" in - let%bind b1 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foo in - let%bind () = expect_eq program "hasherman512" foo b1 in - let%bind b2 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foototo in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in + let%bind () = expect_eq_core program "hasherman512" foo b1 in + let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b2 , b1) in - let%bind b4 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foo in - let%bind () = expect_eq program "hasherman_blake" foo b4 in - let%bind b5 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foototo in + let%bind b4 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foo in + let%bind () = expect_eq_core program "hasherman_blake" foo b4 in + let%bind b5 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foototo in let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b5 , b4) in ok () @@ -448,13 +448,13 @@ let crypto_mligo () : unit result = let%bind program = mtype_file "./contracts/crypto.mligo" in let%bind foo = e_bytes_hex "0f00" in let%bind foototo = e_bytes_hex "0f007070" in - let%bind b1 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foo in - let%bind () = expect_eq program "hasherman512" foo b1 in - let%bind b2 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foototo in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in + let%bind () = expect_eq_core program "hasherman512" foo b1 in + let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b2 , b1) in - let%bind b4 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foo in - let%bind () = expect_eq program "hasherman_blake" foo b4 in - let%bind b5 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foototo in + let%bind b4 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foo in + let%bind () = expect_eq_core program "hasherman_blake" foo b4 in + let%bind b5 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foototo in let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b5 , b4) in ok () @@ -462,13 +462,13 @@ let crypto_religo () : unit result = let%bind program = retype_file "./contracts/crypto.religo" in let%bind foo = e_bytes_hex "0f00" in let%bind foototo = e_bytes_hex "0f007070" in - let%bind b1 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foo in - let%bind () = expect_eq program "hasherman512" foo b1 in - let%bind b2 = Test_helpers.run_typed_program_with_core_input program "hasherman512" foototo in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in + let%bind () = expect_eq_core program "hasherman512" foo b1 in + let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b2 , b1) in - let%bind b4 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foo in - let%bind () = expect_eq program "hasherman_blake" foo b4 in - let%bind b5 = Test_helpers.run_typed_program_with_core_input program "hasherman_blake" foototo in + let%bind b4 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foo in + let%bind () = expect_eq_core program "hasherman_blake" foo b4 in + let%bind b5 = Test_helpers.run_typed_program_with_imperative_input program "hasherman_blake" foototo in let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b5 , b4) in ok () @@ -486,9 +486,9 @@ let bytes_arithmetic_mligo () : unit result = let%bind () = expect_eq program "slice_op" tata at in let%bind () = expect_fail program "slice_op" foo in let%bind () = expect_fail program "slice_op" ba in - let%bind b1 = Test_helpers.run_typed_program_with_core_input program "hasherman" foo in - let%bind () = expect_eq program "hasherman" foo b1 in - let%bind b3 = Test_helpers.run_typed_program_with_core_input program "hasherman" foototo in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foo in + let%bind () = expect_eq_core program "hasherman" foo b1 in + let%bind b3 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foototo in let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b3 , b1) in ok () @@ -506,9 +506,9 @@ let bytes_arithmetic_religo () : unit result = let%bind () = expect_eq program "slice_op" tata at in let%bind () = expect_fail program "slice_op" foo in let%bind () = expect_fail program "slice_op" ba in - let%bind b1 = Test_helpers.run_typed_program_with_core_input program"hasherman" foo in - let%bind () = expect_eq program "hasherman" foo b1 in - let%bind b3 = Test_helpers.run_typed_program_with_core_input program "hasherman" foototo in + let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program"hasherman" foo in + let%bind () = expect_eq_core program "hasherman" foo b1 in + let%bind b3 = Test_helpers.run_typed_program_with_imperative_input program "hasherman" foototo in let%bind () = Assert.assert_fail @@ Ast_core.Misc.assert_value_eq (b3 , b1) in ok () @@ -974,7 +974,6 @@ let reoption () : unit result = let map_ type_f path : unit result = let%bind program = type_f path in let ez lst = - let open Ast_core.Combinators in let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in e_typed_map lst' t_int t_int in @@ -1063,7 +1062,6 @@ let map_ type_f path : unit result = let big_map_ type_f path : unit result = let%bind program = type_f path in let ez lst = - let open Ast_core.Combinators in let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in (e_typed_big_map lst' t_int t_int) in @@ -1276,7 +1274,6 @@ let loop () : unit result = expect_eq program "inner_capture_in_conditional_block" input expected in let%bind () = let ez lst = - let open Ast_core.Combinators in let lst' = List.map (fun (x, y) -> e_string x, e_int y) lst in e_typed_map lst' t_string t_int in @@ -2032,11 +2029,11 @@ let get_contract_ligo () : unit result = let%bind () = let make_input = fun _n -> e_unit () in let make_expected : int -> Ast_core.expression -> unit result = fun _n result -> - let%bind (ops , storage) = get_e_pair result.expression_content in + let%bind (ops , storage) = Ast_core.get_e_pair result.expression_content in let%bind () = - let%bind lst = get_e_list ops.expression_content in + let%bind lst = Ast_core.get_e_list ops.expression_content in Assert.assert_list_size lst 1 in - let expected_storage = e_unit () in + let expected_storage = Ast_core.e_unit () in Ast_core.Misc.assert_value_eq (expected_storage , storage) in let%bind () = diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml index 4410df2eb..948704894 100644 --- a/src/test/multisig_tests.ml +++ b/src/test/multisig_tests.ml @@ -28,7 +28,7 @@ let compile_main f s () = Ligo.Compile.Of_michelson.build_contract michelson_prg in ok () -open Ast_core +open Ast_imperative let init_storage threshold counter pkeys = let keys = List.map diff --git a/src/test/multisig_v2_tests.ml b/src/test/multisig_v2_tests.ml index 0ce171034..8b2b8972b 100644 --- a/src/test/multisig_v2_tests.ml +++ b/src/test/multisig_v2_tests.ml @@ -24,7 +24,7 @@ let compile_main () = Ligo.Compile.Of_michelson.build_contract michelson_prg in ok () -open Ast_core +open Ast_imperative let empty_op_list = (e_typed_list [] t_operation) @@ -33,7 +33,7 @@ let empty_message = e_lambda (Var.of_name "arguments") empty_op_list let empty_message2 = e_lambda (Var.of_name "arguments") (Some t_bytes) (Some (t_list t_operation)) - ( e_let_in ((Var.of_name "foo"),Some t_unit) false (e_unit ()) empty_op_list) + ( e_let_in ((Var.of_name "foo"),Some t_unit) false false (e_unit ()) empty_op_list) let send_param msg = e_constructor "Send" msg let withdraw_param = e_constructor "Withdraw" empty_message diff --git a/src/test/pledge_tests.ml b/src/test/pledge_tests.ml index f1dc76459..4f6df8a01 100644 --- a/src/test/pledge_tests.ml +++ b/src/test/pledge_tests.ml @@ -1,7 +1,6 @@ open Trace open Test_helpers -open Ast_core - +open Ast_imperative let retype_file f = let%bind typed,state = Ligo.Compile.Utils.type_file f "reasonligo" Env in diff --git a/src/test/replaceable_id_tests.ml b/src/test/replaceable_id_tests.ml index 67cdd9402..1c634c611 100644 --- a/src/test/replaceable_id_tests.ml +++ b/src/test/replaceable_id_tests.ml @@ -23,7 +23,8 @@ let compile_main () = (* fails if the given entry point is not a valid contract *) Ligo.Compile.Of_michelson.build_contract michelson_prg in ok () -open Ast_core + +open Ast_imperative let empty_op_list = (e_typed_list [] t_operation) diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index fc1227472..ded88c33b 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -29,15 +29,21 @@ let test name f = let test_suite name lst = Test_suite (name , lst) +let expression_to_core expression = + let%bind sugar = Compile.Of_imperative.compile_expression expression in + let%bind core = Compile.Of_sugar.compile_expression sugar in + ok @@ core -open Ast_core +open Ast_imperative let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result = let%bind code = let env = Ast_typed.program_environment program in + let%bind sugar = Compile.Of_imperative.compile_expression payload in + let%bind core = Compile.Of_sugar.compile_expression sugar in let%bind (typed,_) = Compile.Of_core.compile_expression - ~env ~state:(Typer.Solver.initial_state) payload in + ~env ~state:(Typer.Solver.initial_state) core in let%bind mini_c = Compile.Of_typed.compile_expression typed in Compile.Of_mini_c.compile_expression mini_c in let (Ex_ty payload_ty) = code.expr_ty in @@ -77,27 +83,29 @@ let sha_256_hash pl = let open Proto_alpha_utils.Memory_proto_alpha.Alpha_environment in Raw_hashes.sha256 pl -open Ast_core.Combinators +open Ast_imperative.Combinators -let typed_program_with_core_input_to_michelson +let typed_program_with_imperative_input_to_michelson (program: Ast_typed.program) (entry_point: string) - (input: Ast_core.expression) : Compiler.compiled_expression result = + (input: Ast_imperative.expression) : Compiler.compiled_expression result = Printexc.record_backtrace true; let env = Ast_typed.program_environment program in let state = Typer.Solver.initial_state in - let%bind app = Compile.Of_core.apply entry_point input in + let%bind sugar = Compile.Of_imperative.compile_expression input in + let%bind core = Compile.Of_sugar.compile_expression sugar in + let%bind app = Compile.Of_core.apply entry_point core in let%bind (typed_app,_) = Compile.Of_core.compile_expression ~env ~state app in let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in let%bind mini_c_prg = Compile.Of_typed.compile program in Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied -let run_typed_program_with_core_input ?options +let run_typed_program_with_imperative_input ?options (program: Ast_typed.program) (entry_point: string) - (input: Ast_core.expression) : Ast_core.expression result = - let%bind michelson_program = typed_program_with_core_input_to_michelson program entry_point input in + (input: Ast_imperative.expression) : Ast_core.expression result = + let%bind michelson_program = typed_program_with_imperative_input_to_michelson program entry_point input in let%bind michelson_output = Ligo.Run.Of_michelson.run_no_failwith ?options michelson_program.expr michelson_program.expr_ty in Uncompile.uncompile_typed_program_entry_function_result program entry_point michelson_output - + let expect ?options program entry_point input expecter = let%bind result = let run_error = @@ -106,7 +114,7 @@ let expect ?options program entry_point input expecter = error title content in trace run_error @@ - run_typed_program_with_core_input ?options program entry_point input in + run_typed_program_with_imperative_input ?options program entry_point input in expecter result let expect_fail ?options program entry_point input = @@ -117,10 +125,10 @@ let expect_fail ?options program entry_point input = in trace run_error @@ Assert.assert_fail @@ - run_typed_program_with_core_input ?options program entry_point input + run_typed_program_with_imperative_input ?options program entry_point input let expect_string_failwith ?options program entry_point input expected_failwith = - let%bind michelson_program = typed_program_with_core_input_to_michelson program entry_point input in + let%bind michelson_program = typed_program_with_imperative_input_to_michelson program entry_point input in let%bind err = Ligo.Run.Of_michelson.run_failwith ?options michelson_program.expr michelson_program.expr_ty in match err with @@ -128,6 +136,7 @@ let expect_string_failwith ?options program entry_point input expected_failwith | _ -> simple_fail "Expected to fail with a string" let expect_eq ?options program entry_point input expected = + let%bind expected = expression_to_core expected in let expecter = fun result -> let expect_error = let title () = "expect result" in @@ -136,7 +145,19 @@ let expect_eq ?options program entry_point input expected = Ast_core.PP.expression result in error title content in trace expect_error @@ - Ast_core.Misc.assert_value_eq (expected , result) in + Ast_core.Misc.assert_value_eq (expected,result) in + expect ?options program entry_point input expecter + +let expect_eq_core ?options program entry_point input expected = + let expecter = fun result -> + let expect_error = + let title () = "expect result" in + let content () = Format.asprintf "Expected %a, got %a" + Ast_core.PP.expression expected + Ast_core.PP.expression result in + error title content in + trace expect_error @@ + Ast_core.Misc.assert_value_eq (expected,result) in expect ?options program entry_point input expecter let expect_evaluate program entry_point expecter = @@ -153,6 +174,7 @@ let expect_evaluate program entry_point expecter = expecter res_simpl let expect_eq_evaluate program entry_point expected = + let%bind expected = expression_to_core expected in let expecter = fun result -> Ast_core.Misc.assert_value_eq (expected , result) in expect_evaluate program entry_point expecter @@ -237,7 +259,6 @@ let expect_eq_n_int a b c = expect_eq_n a b e_int (fun n -> e_int (c n)) let expect_eq_b_bool a b c = - let open Ast_core.Combinators in expect_eq_b a b (fun bool -> e_bool (c bool)) diff --git a/src/test/time_lock_repeat_tests.ml b/src/test/time_lock_repeat_tests.ml index f2610dadb..2720cfb64 100644 --- a/src/test/time_lock_repeat_tests.ml +++ b/src/test/time_lock_repeat_tests.ml @@ -1,6 +1,6 @@ open Trace open Test_helpers -open Ast_core +open Ast_imperative let type_file f = let%bind typed,state = Ligo.Compile.Utils.type_file f "cameligo" (Contract "main") in diff --git a/src/test/time_lock_tests.ml b/src/test/time_lock_tests.ml index 37f936a29..e22cb1792 100644 --- a/src/test/time_lock_tests.ml +++ b/src/test/time_lock_tests.ml @@ -24,7 +24,8 @@ let compile_main () = Ligo.Compile.Of_michelson.build_contract michelson_prg in ok () -open Ast_core +open Ast_imperative + let empty_op_list = (e_typed_list [] t_operation) let empty_message = e_lambda (Var.of_name "arguments") diff --git a/src/test/vote_tests.ml b/src/test/vote_tests.ml index 1fc2c5cd6..9122eff9e 100644 --- a/src/test/vote_tests.ml +++ b/src/test/vote_tests.ml @@ -15,7 +15,7 @@ let get_program = ok (program , state) ) -open Ast_core +open Ast_imperative let init_storage name = e_record_ez [ ("title" , e_string name) ; @@ -38,14 +38,14 @@ let yea = e_constructor "Vote" (e_constructor "Yea" (e_unit ())) let init_vote () = let%bind (program , _) = get_program () in let%bind result = - Test_helpers.run_typed_program_with_core_input + Test_helpers.run_typed_program_with_imperative_input program "main" (e_pair yea (init_storage "basic")) in - let%bind (_, storage) = extract_pair result in - let%bind storage' = extract_record storage in + let%bind (_, storage) = Ast_core.extract_pair result in + let%bind storage' = Ast_core.extract_record storage in (* 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, e_nat 1) in + let%bind () = Ast_core.Misc.assert_value_eq (yea, Ast_core.e_nat 1) in ok () let main = test_suite "Vote" [