rewrite test suite to compare value from ast_imperative instead of ast_core; includes uncompiler fo stage 4 and 6

This commit is contained in:
Pierre-Emmanuel Wulfman 2020-03-17 16:04:27 +01:00
parent 6dd7afbeb1
commit 5a4c0b32fb
17 changed files with 431 additions and 70 deletions

View File

@ -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 =

View File

@ -4,6 +4,8 @@
(libraries
simple-utils
compiler
imperative_to_sugar
sugar_to_core
typer_new
typer
ast_typed

View File

@ -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

View File

@ -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)

View File

@ -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)

View File

@ -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 () =

View File

@ -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

View File

@ -1,6 +1,6 @@
open Trace
open Test_helpers
open Ast_core
open Ast_imperative
let mtype_file f =

View File

@ -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 () =

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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,24 +83,26 @@ 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
@ -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))

View File

@ -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

View File

@ -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")

View File

@ -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" [