From 7df3f68f77926992543f278904ce5326fc7acf95 Mon Sep 17 00:00:00 2001 From: Galfour Date: Sat, 4 May 2019 13:59:01 +0000 Subject: [PATCH] better coase tests ; TODO list --- src/lib_utils/trace.ml | 8 +++ src/ligo/TODO.txt | 21 ++++++- src/ligo/ast_simplified/combinators.ml | 10 ++-- src/ligo/ast_typed/combinators.ml | 8 +++ src/ligo/test/coase_tests.ml | 83 ++++++++++++++------------ src/ligo/test/test_helpers.ml | 26 +++++--- src/ligo/typer/typer.ml | 12 ++-- 7 files changed, 110 insertions(+), 58 deletions(-) diff --git a/src/lib_utils/trace.ml b/src/lib_utils/trace.ml index 39b0322f4..6dc7a7093 100644 --- a/src/lib_utils/trace.ml +++ b/src/lib_utils/trace.ml @@ -128,6 +128,10 @@ let trace_option error = function | None -> fail error | Some s -> ok s +let bind_map_option f = function + | None -> ok None + | Some s -> f s >>? fun x -> ok (Some x) + let rec bind_list = function | [] -> ok [] | hd :: tl -> ( @@ -352,6 +356,10 @@ let pp_to_string pp () x = let errors_to_string = pp_to_string errors_pp module Assert = struct + let assert_fail ?(msg="didn't fail") = function + | Ok _ -> simple_fail msg + | _ -> ok () + let assert_true ?(msg="not true") = function | true -> ok () | false -> simple_fail msg diff --git a/src/ligo/TODO.txt b/src/ligo/TODO.txt index ea687b9ba..ef5f79d1e 100644 --- a/src/ligo/TODO.txt +++ b/src/ligo/TODO.txt @@ -1,2 +1,19 @@ -- Unify gets in Ast_simplified -- Unify assignments in Ast_simplified +# Main + +## Back-end + +- Replace Mini_c environments with stacks +- Think about Coq + +## Amendments + +- Bubble_n +- Partial application +- Type size limit (1.000 -> 10.000) + +# PPX + +## Deriving + +- Generate ADT helpers (this removes 90% of Combinators and a lot of maintenance when modifying ASTs) +- Generate option helpers (this makes writing main much easier, much like one would in an untyped language) diff --git a/src/ligo/ast_simplified/combinators.ml b/src/ligo/ast_simplified/combinators.ml index 9110d44ce..0ce8bc97b 100644 --- a/src/ligo/ast_simplified/combinators.ml +++ b/src/ligo/ast_simplified/combinators.ml @@ -26,17 +26,15 @@ let t_bytes : type_expression = T_constant ("bytes", []) let t_int : type_expression = T_constant ("int", []) let t_operation : type_expression = T_constant ("operation", []) let t_nat : type_expression = T_constant ("nat", []) +let t_tez : type_expression = T_constant ("tez", []) let t_unit : type_expression = T_constant ("unit", []) +let t_address : type_expression = T_constant ("address", []) let t_option o : type_expression = T_constant ("option", [o]) let t_list t : type_expression = T_constant ("list", [t]) let t_variable n : type_expression = T_variable n let t_tuple lst : type_expression = T_tuple lst let t_pair (a , b) = t_tuple [a ; b] let t_record m : type_expression = (T_record m) -let t_ez_record (lst:(string * type_expression) list) : type_expression = - let aux prev (k, v) = SMap.add k v prev in - let map = List.fold_left aux SMap.empty lst in - T_record map let t_record_ez lst = let m = SMap.of_list lst in @@ -63,6 +61,8 @@ let e_int n : expression = E_literal (Literal_int n) let e_nat n : expression = E_literal (Literal_nat n) let e_bool b : expression = E_literal (Literal_bool b) let e_string s : expression = E_literal (Literal_string s) +let e_address s : expression = E_literal (Literal_address s) +let e_tez s : expression = E_literal (Literal_tez s) let e_bytes b : expression = E_literal (Literal_bytes (Bytes.of_string b)) let e_record map : expression = E_record map let e_tuple lst : expression = E_tuple lst @@ -84,6 +84,8 @@ let e_a_int n : annotated_expression = make_e_a_full (e_int n) t_int let e_a_nat n : annotated_expression = make_e_a_full (e_nat n) t_nat let e_a_bool b : annotated_expression = make_e_a_full (e_bool b) t_bool let e_a_constructor s a : annotated_expression = make_e_a (e_constructor s a) +let e_a_address x = make_e_a_full (e_address x) t_address +let e_a_tez x = make_e_a_full (e_tez x) t_tez let e_a_record r = let type_annotation = Option.( diff --git a/src/ligo/ast_typed/combinators.ml b/src/ligo/ast_typed/combinators.ml index ea22c52d1..e86848066 100644 --- a/src/ligo/ast_typed/combinators.ml +++ b/src/ligo/ast_typed/combinators.ml @@ -98,6 +98,14 @@ let get_t_map (t:type_value) : (type_value * type_value) result = | T_constant ("map", [k;v]) -> ok (k, v) | _ -> simple_fail "get: not a map" +let get_t_map_key : type_value -> type_value result = fun t -> + let%bind (key , _) = get_t_map t in + ok key + +let get_t_map_value : type_value -> type_value result = fun t -> + let%bind (_ , value) = get_t_map t in + ok value + let assert_t_tez :type_value -> unit result = get_t_tez let assert_t_map (t:type_value) : unit result = diff --git a/src/ligo/test/coase_tests.ml b/src/ligo/test/coase_tests.ml index f0ca9cacd..36dc4db49 100644 --- a/src/ligo/test/coase_tests.ml +++ b/src/ligo/test/coase_tests.ml @@ -14,55 +14,55 @@ let get_program = ok program ) -open Ast_typed +open Ast_simplified let card owner = - ez_e_a_empty_record [ + ez_e_a_record [ ("card_owner" , owner) ; ] -let card_ty = ez_t_record [ - ("card_owner" , t_address ()) ; - ] () +let card_ty = t_record_ez [ + ("card_owner" , t_address) ; + ] -let card_ez owner = card (e_a_empty_address owner) +let card_ez owner = card (e_a_address owner) let make_cards assoc_lst = - let card_id_ty = t_nat () in - e_a_empty_map assoc_lst card_id_ty card_ty + let card_id_ty = t_nat in + e_a_map assoc_lst card_id_ty card_ty let card_pattern (coeff , qtt) = - ez_e_a_empty_record [ + ez_e_a_record [ ("coefficient" , coeff) ; ("quantity" , qtt) ; ] let card_pattern_ty = - ez_t_record [ - ("coefficient" , t_tez ()) ; - ("quantity" , t_nat ()) ; - ] () + t_record_ez [ + ("coefficient" , t_tez) ; + ("quantity" , t_nat) ; + ] let card_pattern_ez (coeff , qtt) = - card_pattern (e_a_empty_tez coeff , e_a_empty_nat qtt) + card_pattern (e_a_tez coeff , e_a_nat qtt) let make_card_patterns lst = - let card_pattern_id_ty = t_nat () in - let assoc_lst = List.mapi (fun i x -> (e_a_empty_nat i , x)) lst in - e_a_empty_map assoc_lst card_pattern_id_ty card_pattern_ty + let card_pattern_id_ty = t_nat in + let assoc_lst = List.mapi (fun i x -> (e_a_nat i , x)) lst in + e_a_map assoc_lst card_pattern_id_ty card_pattern_ty let storage cards_patterns cards next_id = - ez_e_a_empty_record [ + ez_e_a_record [ ("cards" , cards) ; ("card_patterns" , cards_patterns) ; ("next_id" , next_id) ; ] let storage_ez cps cs next_id = - storage (make_card_patterns cps) (make_cards cs) (e_a_empty_nat next_id) + storage (make_card_patterns cps) (make_cards cs) (e_a_nat next_id) let cards_ez owner n = - List.mapi (fun i x -> (e_a_empty_nat i , x)) + List.mapi (fun i x -> (e_a_nat i , x)) @@ List.map card_ez @@ List.map (Function.constant owner) @@ List.range n @@ -88,35 +88,40 @@ let basic a b cards next_id = let buy () = let%bind program = get_program () in - let aux n = - let open AST_Typed.Combinators in - let input = - let buy_action = ez_e_a_empty_record [ - ("card_to_buy" , e_a_empty_nat 0) ; + let%bind () = + let make_input = fun n -> + let buy_action = ez_e_a_record [ + ("card_to_buy" , e_a_nat 0) ; ] in let storage = basic 100 1000 (cards_ez first_owner n) (2 * n) in - e_a_empty_pair buy_action storage + e_a_pair buy_action storage in - let expected = - let ops = e_a_empty_list [] (t_operation ()) in + let make_expected = fun n -> + let ops = e_a_list [] t_operation in let storage = let cards = cards_ez first_owner n @ - [(e_a_empty_nat (2 * n) , card (e_a_empty_address second_owner))] + [(e_a_nat (2 * n) , card (e_a_address second_owner))] in basic 101 1000 cards ((2 * n) + 1) in - e_a_empty_pair ops storage + e_a_pair ops storage in - let%bind amount = - trace_option (simple_error "getting amount for run") @@ - Tezos_utils.Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in - let%bind result = easy_run_typed ~amount "buy_single" program input in - Format.printf "\nResult : %a\n" Ast_typed.PP.value result ; - AST_Typed.assert_value_eq (expected, result) + let%bind () = + let%bind amount = + trace_option (simple_error "getting amount for run") @@ + Tezos_utils.Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in + let options = make_options ~amount () in + expect_n_pos_small ~options program "buy_single" make_input make_expected in + let%bind () = + let%bind amount = + trace_option (simple_error "getting amount for run") @@ + Tezos_utils.Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in + let options = make_options ~amount () in + trace_strong (simple_error "could buy without money") @@ + Assert.assert_fail + @@ expect_n_pos_small ~options program "buy_single" make_input make_expected in + ok () in - let%bind _ = bind_list - @@ List.map aux - @@ [2 ; (* 0 ; 7 ; 12 *)] in ok () let main = "Coase (End to End)", [ diff --git a/src/ligo/test/test_helpers.ml b/src/ligo/test/test_helpers.ml index 73ca16e7a..6754d1e78 100644 --- a/src/ligo/test/test_helpers.ml +++ b/src/ligo/test/test_helpers.ml @@ -13,14 +13,22 @@ let test name f = open Ast_simplified.Combinators -let expect program entry_point input expected = +type options = { + amount : Memory_proto_alpha.Alpha_context.Tez.t option ; +} + +let make_options ?amount () = { + amount ; +} + +let expect ?(options = make_options ()) program entry_point input expected = let%bind result = let run_error = let title () = "expect run" in let content () = Format.asprintf "Entry_point: %s" entry_point in error title content in trace run_error @@ - Ligo.easy_run_typed_simplified entry_point program input in + Ligo.easy_run_typed_simplified ?amount:options.amount entry_point program input in let expect_error = let title () = "expect result" in let content () = Format.asprintf "Expected %a, got %a" @@ -39,22 +47,22 @@ let expect_evaluate program entry_point expected = let%bind result = Ligo.easy_evaluate_typed_simplified entry_point program in Ast_simplified.assert_value_eq (expected , result) -let expect_n_aux lst program entry_point make_input make_expected = +let expect_n_aux ?options lst program entry_point make_input make_expected = let aux n = let input = make_input n in let expected = make_expected n in trace (simple_error ("expect_n " ^ (string_of_int n))) @@ - let result = expect program entry_point input expected in + let result = expect ?options program entry_point input expected in result in let%bind _ = bind_map_list aux lst in ok () -let expect_n = expect_n_aux [0 ; 2 ; 42 ; 163 ; -1] -let expect_n_pos = expect_n_aux [0 ; 2 ; 42 ; 163] -let expect_n_strict_pos = expect_n_aux [2 ; 42 ; 163] -let expect_n_pos_small = expect_n_aux [0 ; 2 ; 10] -let expect_n_strict_pos_small = expect_n_aux [2 ; 10] +let expect_n ?options = expect_n_aux ?options [0 ; 2 ; 42 ; 163 ; -1] +let expect_n_pos ?options = expect_n_aux ?options [0 ; 2 ; 42 ; 163] +let expect_n_strict_pos ?options = expect_n_aux ?options [2 ; 42 ; 163] +let expect_n_pos_small ?options = expect_n_aux ?options [0 ; 2 ; 10] +let expect_n_strict_pos_small ?options = expect_n_aux ?options [2 ; 10] let expect_n_pos_mid = expect_n_aux [0 ; 2 ; 10 ; 33] let expect_b program entry_point make_expected = diff --git a/src/ligo/typer/typer.ml b/src/ligo/typer/typer.ml index a6154d4e0..d54941bf8 100644 --- a/src/ligo/typer/typer.ml +++ b/src/ligo/typer/typer.ml @@ -457,18 +457,22 @@ and type_annotated_expression : environment -> I.annotated_expression -> O.annot let%bind _eq = Ast_typed.assert_type_value_eq (c, c') in ok (Some c') in let%bind key_type = - let%bind opt = + let%bind sub = bind_fold_list aux None @@ List.map get_type_annotation @@ List.map fst lst' in - trace_option (simple_error "empty map expression") opt + let%bind annot = bind_map_option get_t_map_key tv_opt in + trace (simple_error "untyped empty map expression") @@ + O.merge_annotation annot sub in let%bind value_type = - let%bind opt = + let%bind sub = bind_fold_list aux None @@ List.map get_type_annotation @@ List.map snd lst' in - trace_option (simple_error "empty map expression") opt + let%bind annot = bind_map_option get_t_map_value tv_opt in + trace (simple_error "untyped empty map expression") @@ + O.merge_annotation annot sub in ok (t_map key_type value_type ()) in