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:
parent
6dd7afbeb1
commit
5a4c0b32fb
@ -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 =
|
||||
|
@ -4,6 +4,8 @@
|
||||
(libraries
|
||||
simple-utils
|
||||
compiler
|
||||
imperative_to_sugar
|
||||
sugar_to_core
|
||||
typer_new
|
||||
typer
|
||||
ast_typed
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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 () =
|
||||
|
@ -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
|
||||
|
@ -1,6 +1,6 @@
|
||||
open Trace
|
||||
open Test_helpers
|
||||
open Ast_core
|
||||
open Ast_imperative
|
||||
|
||||
|
||||
let mtype_file f =
|
||||
|
@ -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 () =
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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))
|
||||
|
||||
|
||||
|
@ -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
|
||||
|
@ -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")
|
||||
|
@ -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" [
|
||||
|
Loading…
Reference in New Issue
Block a user