diff --git a/src/ligo/compiler/compiler_program.ml b/src/ligo/compiler/compiler_program.ml index 1bd8fd6ec..b5257a644 100644 --- a/src/ligo/compiler/compiler_program.ml +++ b/src/ligo/compiler/compiler_program.ml @@ -35,6 +35,15 @@ let get_predicate : string -> type_value -> expression list -> predicate result | _ -> simple_fail "mini_c . RIGHT" in let%bind l_ty = Compiler_type.type_ l in ok @@ simple_unary @@ prim ~children:[l_ty] I_RIGHT + | "CONTRACT" -> + let%bind r = match lst with + | [ _ ] -> get_t_contract ty + | _ -> simple_fail "mini_c . CONTRACT" in + let%bind r_ty = Compiler_type.type_ r in + ok @@ simple_unary @@ seq [ + prim ~children:[r_ty] I_CONTRACT ; + i_assert_some_msg (i_push_string "bad address for get_contract") ; + ] | x -> simple_fail ("predicate \"" ^ x ^ "\" doesn't exist") ) diff --git a/src/ligo/compiler/compiler_type.ml b/src/ligo/compiler/compiler_type.ml index ad4849242..bfa6cd12f 100644 --- a/src/ligo/compiler/compiler_type.ml +++ b/src/ligo/compiler/compiler_type.ml @@ -35,6 +35,7 @@ module Ty = struct | T_map _ -> fail (not_comparable "map") | T_list _ -> fail (not_comparable "list") | T_option _ -> fail (not_comparable "option") + | T_contract _ -> fail (not_comparable "contract") let base_type : type_base -> ex_ty result = fun b -> let open Contract_types in @@ -82,6 +83,9 @@ module Ty = struct | T_option t -> let%bind (Ex_ty t') = type_ t in ok @@ Ex_ty Contract_types.(option t') + | T_contract t -> + let%bind (Ex_ty t') = type_ t in + ok @@ Ex_ty Contract_types.(contract t') and environment_representation = function | [] -> ok @@ Ex_ty Contract_types.unit @@ -138,6 +142,9 @@ let rec type_ : type_value -> O.michelson result = | T_option o -> let%bind o' = type_ o in ok @@ O.prim ~children:[o'] O.T_option + | T_contract o -> + let%bind o' = type_ o in + ok @@ O.prim ~children:[o'] O.T_contract | T_function (arg, ret) -> let%bind arg = type_ arg in let%bind ret = type_ ret in diff --git a/src/ligo/contracts/coase.ligo b/src/ligo/contracts/coase.ligo index 8e79bcf21..ba81e26bc 100644 --- a/src/ligo/contracts/coase.ligo +++ b/src/ligo/contracts/coase.ligo @@ -34,26 +34,26 @@ type action_transfer is record [ type action is | Buy_single of action_buy_single -// | Sell of action_sell_single +| Sell_single of action_sell_single // | Transfer of action_transfer -// function sell_single(const action : action_sell_single ; const s : storage_type) : (list(operation) * storage_type) is -// begin -// const card : card = get_force(action.card_to_sell , s.cards) ; -// if (card.card_owner =/= source) then fail "This card doesn't belong to you" else skip ; -// const card_pattern : card_pattern = get_force(card.card_pattern , s.card_patterns) ; -// card_pattern.quantity := abs(card_pattern.quantity - 1n); -// const card_patterns : card_patterns = s.card_patterns ; -// card_patterns[card.card_pattern] := card_pattern ; -// s.card_patterns := card_patterns ; -// const cards : cards = s.cards ; -// remove action.card_to_sell from map cards ; -// s.cards := cards ; -// const price : tez = card_pattern.coefficient * card_pattern.quantity ; -// const receiver : contract(unit) = get_contract(source) ; -// const op : operation = transaction(price , unit , receiver) ; -// const operations : list(operation) = list op end ; -// end with (operations , s) +function sell_single(const action : action_sell_single ; const s : storage_type) : (list(operation) * storage_type) is + begin + const card : card = get_force(action.card_to_sell , s.cards) ; + if (card.card_owner =/= source) then fail "This card doesn't belong to you" else skip ; + const card_pattern : card_pattern = get_force(card.card_pattern , s.card_patterns) ; + card_pattern.quantity := abs(card_pattern.quantity - 1n); + const card_patterns : card_patterns = s.card_patterns ; + card_patterns[card.card_pattern] := card_pattern ; + s.card_patterns := card_patterns ; + const cards : cards = s.cards ; + remove action.card_to_sell from map cards ; + s.cards := cards ; + const price : tez = card_pattern.coefficient * card_pattern.quantity ; + const receiver : contract(unit) = get_contract(source) ; + const op : operation = transaction(unit , price , receiver) ; + const operations : list(operation) = list op end ; + end with (operations , s) function buy_single(const action : action_buy_single ; const s : storage_type) : (list(operation) * storage_type) is begin @@ -81,7 +81,7 @@ function buy_single(const action : action_buy_single ; const s : storage_type) : function main(const action : action ; const s : storage_type) : (list(operation) * storage_type) is block {skip} with case action of - | Buy_single abs -> buy_single (abs , s) - // | Sell as -> sell_single (as , s) + | Buy_single bs -> buy_single (bs , s) + | Sell_single as -> sell_single (as , s) // | Transfer at -> transfer (at , s) end diff --git a/src/ligo/meta_michelson/contract.ml b/src/ligo/meta_michelson/contract.ml index 8ec3bc02e..056de705b 100644 --- a/src/ligo/meta_michelson/contract.ml +++ b/src/ligo/meta_michelson/contract.ml @@ -272,6 +272,7 @@ module Types = struct | _ -> assert false let option a = Option_t ((a, None), None, None) + let contract a = Contract_t (a, None) let assert_option = function | Option_t ((a, _), _, _) -> a | _ -> assert false diff --git a/src/ligo/mini_c/PP.ml b/src/ligo/mini_c/PP.ml index b81af18aa..bf2b19798 100644 --- a/src/ligo/mini_c/PP.ml +++ b/src/ligo/mini_c/PP.ml @@ -28,6 +28,7 @@ let rec type_ ppf : type_value -> _ = function | T_map(k, v) -> fprintf ppf "map(%a -> %a)" type_ k type_ v | T_list(t) -> fprintf ppf "list(%a)" type_ t | T_option(o) -> fprintf ppf "option(%a)" type_ o + | T_contract(t) -> fprintf ppf "contract(%a)" type_ t | T_deep_closure(c, arg, ret) -> fprintf ppf "[%a](%a)->(%a)" environment c diff --git a/src/ligo/mini_c/combinators.ml b/src/ligo/mini_c/combinators.ml index 3ae362bd3..3302459aa 100644 --- a/src/ligo/mini_c/combinators.ml +++ b/src/ligo/mini_c/combinators.ml @@ -111,6 +111,10 @@ let get_t_right t = match t with | T_or (_ , b) -> ok b | _ -> fail @@ wrong_type "union" t +let get_t_contract t = match t with + | T_contract x -> ok x + | _ -> fail @@ wrong_type "contract" t + let get_last_statement ((b', _):block) : statement result = let aux lst = match lst with | [] -> simple_fail "get_last: empty list" diff --git a/src/ligo/mini_c/types.ml b/src/ligo/mini_c/types.ml index d8a1f4b68..74bd6e7ac 100644 --- a/src/ligo/mini_c/types.ml +++ b/src/ligo/mini_c/types.ml @@ -15,6 +15,7 @@ type type_value = | T_base of type_base | T_map of (type_value * type_value) | T_list of type_value + | T_contract of type_value | T_option of type_value and environment_element = string * type_value diff --git a/src/ligo/operators/operators.ml b/src/ligo/operators/operators.ml index 61afb2e2e..89feeb0e0 100644 --- a/src/ligo/operators/operators.ml +++ b/src/ligo/operators/operators.ml @@ -22,8 +22,11 @@ module Simplify = struct let constants = [ ("get_force" , 2) ; + ("transaction" , 3) ; + ("get_contract" , 1) ; ("size" , 1) ; ("int" , 1) ; + ("abs" , 1) ; ("amount" , 0) ; ("unit" , 0) ; ("source" , 0) ; @@ -223,7 +226,19 @@ module Typer = struct let transaction = "Operation.transaction" , 3 , [ true_3 , typer'_3 ( - fun param contract amount -> + fun param amount contract -> + let%bind () = + assert_t_tez amount in + let%bind contract_param = + get_t_contract contract in + let%bind () = + assert_type_value_eq (param , contract_param) in + ok ("TRANSFER_TOKENS" , t_operation ()) + ) + ] + let transaction' = "transaction" , 3 , [ + true_3 , typer'_3 ( + fun param amount contract -> let%bind () = assert_t_tez amount in let%bind contract_param = @@ -245,6 +260,17 @@ module Typer = struct ok ("CONTRACT" , t_contract tv' ()) ) ] + let get_contract' = "get_contract" , 1 , [ + eq_1 (t_address ()) , typer'_1_opt ( + fun _ tv_opt -> + let%bind tv = + trace_option (simple_error "get_contract needs a type annotation") tv_opt in + let%bind tv' = + trace_strong (simple_error "get_contract has a not-contract annotation") @@ + get_t_contract tv in + ok ("CONTRACT" , t_contract tv' ()) + ) + ] let num_2 : typer_predicate = let aux = fun a b -> @@ -256,6 +282,10 @@ module Typer = struct num_2 , constant_2 "MOD" (t_nat ()) ; ] + let abs = "abs" , 1 , [ + eq_1 (t_int ()) , typer_constant ("ABS" , (t_nat ())) ; + ] + let times = "TIMES" , 2 , [ (eq_2 (t_nat ()) , constant_2 "TIMES_NAT" (t_nat ())) ; (num_2 , constant_2 "TIMES_INT" (t_int ())) ; @@ -306,7 +336,10 @@ module Typer = struct unit ; amount ; transaction ; + transaction' ; get_contract ; + get_contract' ; + abs ; ] end @@ -361,9 +394,11 @@ module Compiler = struct ("FAILWITH" , simple_unary @@ prim I_FAILWITH) ; ("ASSERT" , simple_binary @@ i_if (seq [i_failwith]) (seq [i_drop ; i_push_unit])) ; ("INT" , simple_unary @@ prim I_INT) ; + ("ABS" , simple_unary @@ prim I_ABS) ; ("CONS" , simple_binary @@ prim I_CONS) ; ("UNIT" , simple_constant @@ prim I_UNIT) ; ("AMOUNT" , simple_constant @@ prim I_AMOUNT) ; + ("TRANSFER_TOKENS" , simple_ternary @@ prim I_TRANSFER_TOKENS) ; ("SOURCE" , simple_constant @@ prim I_SOURCE) ; ("SENDER" , simple_constant @@ prim I_SENDER) ; ( "MAP_UPDATE" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE ]) ; diff --git a/src/ligo/simplify/pascaligo.ml b/src/ligo/simplify/pascaligo.ml index 93415e802..45358e5f9 100644 --- a/src/ligo/simplify/pascaligo.ml +++ b/src/ligo/simplify/pascaligo.ml @@ -98,7 +98,13 @@ let rec simpl_expression (t:Raw.expr) : ae result = match List.assoc_opt c' constants with | None -> return @@ E_variable c.value | Some 0 -> return @@ E_constant (c' , []) - | Some _ -> simple_fail "non nullary constant without parameters" + | Some n -> ( + let error = + let title () = "non nullary constant without parameters" in + let content () = Format.asprintf "%s (%d)" c' n in + error title content in + fail error + ) ) | ECall x -> ( let (name, args) = x.value in diff --git a/src/ligo/test/coase_tests.ml b/src/ligo/test/coase_tests.ml index a2baeff99..7ab498d44 100644 --- a/src/ligo/test/coase_tests.ml +++ b/src/ligo/test/coase_tests.ml @@ -113,7 +113,7 @@ let buy () = 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 + expect_eq_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") @@ @@ -121,11 +121,41 @@ let buy () = 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 + @@ expect_eq_n_pos_small ~options program "buy_single" make_input make_expected in ok () in ok () +let sell () = + let%bind program = get_program () in + let%bind () = + let make_input = fun n -> + let sell_action = ez_e_a_record [ + ("card_to_sell" , e_a_nat (n - 1)) ; + ] in + let storage = basic 100 1000 (cards_ez first_owner n) (2 * n) in + e_a_pair sell_action storage + 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_nat (2 * n) , card (e_a_address second_owner))] + in + basic 101 1000 cards ((2 * n) + 1) in + e_a_pair ops storage + in + let%bind () = + let amount = Memory_proto_alpha.Alpha_context.Tez.zero in + let options = make_options ~amount () in + expect_eq_n_pos_small ~options program "sell_single" make_input make_expected in + ok () + in + ok () + + let main = "Coase (End to End)", [ test "buy" buy ; + (* test "sell" sell ; *) ] diff --git a/src/ligo/test/integration_tests.ml b/src/ligo/test/integration_tests.ml index c8e26f363..a9104a564 100644 --- a/src/ligo/test/integration_tests.ml +++ b/src/ligo/test/integration_tests.ml @@ -13,24 +13,24 @@ let mtype_file path : Ast_typed.program result = let function_ () : unit result = let%bind program = type_file "./contracts/function.ligo" in let make_expect = fun n -> n in - expect_n_int program "main" make_expect + expect_eq_n_int program "main" make_expect let complex_function () : unit result = let%bind program = type_file "./contracts/function-complex.ligo" in let make_expect = fun n -> (3 * n + 2) in - expect_n_int program "main" make_expect + expect_eq_n_int program "main" make_expect let variant () : unit result = let%bind program = type_file "./contracts/variant.ligo" in let%bind () = let expected = e_a_constructor "Foo" (e_a_int 42) in - expect_evaluate program "foo" expected in + expect_eq_evaluate program "foo" expected in let%bind () = let expected = e_a_constructor "Bar" (e_a_bool true) in - expect_evaluate program "bar" expected in + expect_eq_evaluate program "bar" expected in let%bind () = let expected = e_a_constructor "Kee" (e_a_nat 23) in - expect_evaluate program "kee" expected in + expect_eq_evaluate program "kee" expected in ok () let variant_matching () : unit result = @@ -38,10 +38,10 @@ let variant_matching () : unit result = let%bind () = let make_input = fun n -> e_a_constructor "Foo" (e_a_int n) in let make_expected = e_a_int in - expect program "fb" (make_input 0) (make_expected 0) >>? fun () -> - expect_n program "fb" make_input make_expected >>? fun () -> - expect program "fb" (e_a_constructor "Kee" (e_a_nat 50)) (e_a_int 23) >>? fun () -> - expect program "fb" (e_a_constructor "Bar" (e_a_bool true)) (e_a_int 42) >>? fun () -> + expect_eq program "fb" (make_input 0) (make_expected 0) >>? fun () -> + expect_eq_n program "fb" make_input make_expected >>? fun () -> + expect_eq program "fb" (e_a_constructor "Kee" (e_a_nat 50)) (e_a_int 23) >>? fun () -> + expect_eq program "fb" (e_a_constructor "Bar" (e_a_bool true)) (e_a_int 42) >>? fun () -> ok () in ok () @@ -50,48 +50,48 @@ let closure () : unit result = let%bind program = type_file "./contracts/closure.ligo" in let%bind () = let make_expect = fun n -> (2 * n) in - expect_n_int program "foo" make_expect + expect_eq_n_int program "foo" make_expect in let%bind _ = let make_expect = fun n -> (4 * n) in - expect_n_int program "toto" make_expect + expect_eq_n_int program "toto" make_expect in ok () let shadow () : unit result = let%bind program = type_file "./contracts/shadow.ligo" in let make_expect = fun _ -> 0 in - expect_n_int program "foo" make_expect + expect_eq_n_int program "foo" make_expect let higher_order () : unit result = let%bind program = type_file "./contracts/high-order.ligo" in let make_expect = fun n -> n in - expect_n_int program "foobar" make_expect + expect_eq_n_int program "foobar" make_expect let shared_function () : unit result = let%bind program = type_file "./contracts/function-shared.ligo" in (* let%bind () = * let make_expect = fun n -> (n + 1) in - * expect_n_int program "inc" make_expect + * expect_eq_n_int program "inc" make_expect * in * let%bind () = * let make_expect = fun n -> (n + 2) in - * expect_n_int program "double_inc" make_expect + * expect_eq_n_int program "double_inc" make_expect * in *) let%bind () = let make_expect = fun n -> (2 * n + 3) in - expect program "foo" (e_a_int 0) (e_a_int @@ make_expect 0) + expect_eq program "foo" (e_a_int 0) (e_a_int @@ make_expect 0) in let%bind () = let make_expect = fun n -> (2 * n + 3) in - expect_n_int program "foo" make_expect + expect_eq_n_int program "foo" make_expect in ok () let bool_expression () : unit result = let%bind program = type_file "./contracts/boolean_operators.ligo" in let%bind _ = - let aux (name , f) = expect_b_bool program name f in + let aux (name , f) = expect_eq_b_bool program name f in bind_map_list aux [ ("or_true", fun b -> b || true) ; ("or_false", fun b -> b || false) ; @@ -103,25 +103,25 @@ let bool_expression () : unit result = let arithmetic () : unit result = let%bind program = type_file "./contracts/arithmetic.ligo" in let%bind _ = - let aux (name , f) = expect_n_int program name f in + let aux (name , f) = expect_eq_n_int program name f in bind_map_list aux [ ("plus_op", fun n -> (n + 42)) ; ("minus_op", fun n -> (n - 42)) ; ("times_op", fun n -> (n * 42)) ; (* ("div_op", fun n -> (n / 2)) ; *) ] in - let%bind () = expect_n_pos program "int_op" e_a_nat e_a_int in - let%bind () = expect_n_pos program "mod_op" e_a_int (fun n -> e_a_nat (n mod 42)) in - let%bind () = expect_n_pos program "div_op" e_a_int (fun n -> e_a_int (n / 2)) in + let%bind () = expect_eq_n_pos program "int_op" e_a_nat e_a_int in + let%bind () = expect_eq_n_pos program "mod_op" e_a_int (fun n -> e_a_nat (n mod 42)) in + let%bind () = expect_eq_n_pos program "div_op" e_a_int (fun n -> e_a_int (n / 2)) in ok () let unit_expression () : unit result = let%bind program = type_file "./contracts/unit.ligo" in - expect_evaluate program "u" e_a_unit + expect_eq_evaluate program "u" e_a_unit let include_ () : unit result = let%bind program = type_file "./contracts/includer.ligo" in - expect_evaluate program "bar" (e_a_int 144) + expect_eq_evaluate program "bar" (e_a_int 144) let record_ez_int names n = ez_e_a_record @@ List.map (fun x -> x, e_a_int n) names @@ -130,7 +130,7 @@ let multiple_parameters () : unit result = let%bind program = type_file "./contracts/multiple-parameters.ligo" in let aux ((name : string) , make_input , make_output) = let make_output' = fun n -> e_a_int @@ make_output n in - expect_n program name make_input make_output' + expect_eq_n program name make_input make_output' in let%bind _ = bind_list @@ List.map aux [ ("ab", record_ez_int ["a";"b"], fun n -> 2 * n) ; @@ -143,23 +143,23 @@ let record () : unit result = let%bind program = type_file "./contracts/record.ligo" in let%bind () = let expected = record_ez_int ["foo" ; "bar"] 0 in - expect_evaluate program "fb" expected + expect_eq_evaluate program "fb" expected in let%bind () = - let%bind () = expect_evaluate program "a" (e_a_int 42) in - let%bind () = expect_evaluate program "b" (e_a_int 142) in - let%bind () = expect_evaluate program "c" (e_a_int 242) in + let%bind () = expect_eq_evaluate program "a" (e_a_int 42) in + let%bind () = expect_eq_evaluate program "b" (e_a_int 142) in + let%bind () = expect_eq_evaluate program "c" (e_a_int 242) in ok () in let%bind () = let make_input = record_ez_int ["foo" ; "bar"] in let make_expected = fun n -> e_a_int (2 * n) in - expect_n program "projection" make_input make_expected + expect_eq_n program "projection" make_input make_expected in let%bind () = let make_input = record_ez_int ["foo" ; "bar"] in let make_expected = fun n -> ez_e_a_record [("foo" , e_a_int 256) ; ("bar" , e_a_int n) ] in - expect_n program "modify" make_input make_expected + expect_eq_n program "modify" make_input make_expected in let%bind () = let make_input = record_ez_int ["a" ; "b" ; "c"] in @@ -168,11 +168,11 @@ let record () : unit result = ("b" , e_a_int 2048) ; ("c" , e_a_int n) ] in - expect_n program "modify_abc" make_input make_expected + expect_eq_n program "modify_abc" make_input make_expected in let%bind () = let expected = record_ez_int ["a";"b";"c";"d";"e"] 23 in - expect_evaluate program "br" expected + expect_eq_evaluate program "br" expected in ok () @@ -182,31 +182,31 @@ let tuple () : unit result = e_a_tuple (List.map e_a_int n) in let%bind () = let expected = ez [0 ; 0] in - expect_evaluate program "fb" expected + expect_eq_evaluate program "fb" expected in let%bind () = let make_input = fun n -> ez [n ; n] in let make_expected = fun n -> e_a_int (2 * n) in - expect_n program "projection" make_input make_expected + expect_eq_n program "projection" make_input make_expected in let%bind () = let make_input = fun n -> ez [n ; 2 * n ; n] in let make_expected = fun n -> e_a_int (2 * n) in - expect_n program "projection_abc" make_input make_expected + expect_eq_n program "projection_abc" make_input make_expected in let%bind () = let make_input = fun n -> ez [n ; n ; n] in let make_expected = fun n -> ez [n ; 2048 ; n] in - expect program "modify_abc" (make_input 12) (make_expected 12) + expect_eq program "modify_abc" (make_input 12) (make_expected 12) in let%bind () = let make_input = fun n -> ez [n ; n ; n] in let make_expected = fun n -> ez [n ; 2048 ; n] in - expect_n program "modify_abc" make_input make_expected + expect_eq_n program "modify_abc" make_input make_expected in let%bind () = let expected = ez [23 ; 23 ; 23 ; 23 ; 23] in - expect_evaluate program "br" expected + expect_eq_evaluate program "br" expected in ok () @@ -214,11 +214,11 @@ let option () : unit result = let%bind program = type_file "./contracts/option.ligo" in let%bind () = let expected = e_a_some (e_a_int 42) in - expect_evaluate program "s" expected + expect_eq_evaluate program "s" expected in let%bind () = let expected = e_a_none t_int in - expect_evaluate program "n" expected + expect_eq_evaluate program "n" expected in ok () @@ -232,16 +232,16 @@ let map () : unit result = let%bind () = let make_input = fun n -> ez [(23, n) ; (42, 4)] in let make_expected = e_a_int in - expect_n program "gf" make_input make_expected + expect_eq_n program "gf" make_input make_expected in let%bind () = let make_input = fun n -> ez List.(map (fun x -> (x, x)) @@ range n) in let make_expected = e_a_nat in - expect_n_strict_pos_small program "size_" make_input make_expected + expect_eq_n_strict_pos_small program "size_" make_input make_expected in let%bind () = let expected = ez [(23, 0) ; (42, 0)] in - expect_evaluate program "fb" expected + expect_eq_evaluate program "fb" expected in let%bind () = let make_input = fun n -> @@ -249,21 +249,21 @@ let map () : unit result = e_a_tuple [(e_a_int n) ; m] in let make_expected = fun n -> ez [(23 , n) ; (42 , 0)] in - expect_n_pos_small program "set_" make_input make_expected + expect_eq_n_pos_small program "set_" make_input make_expected in let%bind () = let make_input = fun n -> ez [(23, n) ; (42, 4)] in let make_expected = fun _ -> e_a_some @@ e_a_int 4 in - expect_n program "get" make_input make_expected + expect_eq_n program "get" make_input make_expected in let%bind () = let expected = ez @@ List.map (fun x -> (x, 23)) [144 ; 51 ; 42 ; 120 ; 421] in - expect_evaluate program "bm" expected + expect_eq_evaluate program "bm" expected in let%bind () = let input = ez [(23, 23) ; (42, 42)] in let expected = ez [23, 23] in - expect program "rm" input expected + expect_eq program "rm" input expected in ok () @@ -276,15 +276,15 @@ let list () : unit result = let%bind () = let make_input = fun n -> (ez @@ List.range n) in let make_expected = e_a_nat in - expect_n_strict_pos_small program "size_" make_input make_expected + expect_eq_n_strict_pos_small program "size_" make_input make_expected in let%bind () = let expected = ez [23 ; 42] in - expect_evaluate program "fb" expected + expect_eq_evaluate program "fb" expected in let%bind () = let expected = ez [144 ; 51 ; 42 ; 120 ; 421] in - expect_evaluate program "bl" expected + expect_eq_evaluate program "bl" expected in ok () @@ -292,24 +292,24 @@ let condition () : unit result = let%bind program = type_file "./contracts/condition.ligo" in let make_input = e_a_int in let make_expected = fun n -> e_a_int (if n = 2 then 42 else 0) in - expect_n program "main" make_input make_expected + expect_eq_n program "main" make_input make_expected let loop () : unit result = let%bind program = type_file "./contracts/loop.ligo" in let%bind () = let make_input = e_a_nat in let make_expected = e_a_nat in - expect_n_pos program "dummy" make_input make_expected + expect_eq_n_pos program "dummy" make_input make_expected in let%bind () = let make_input = e_a_nat in let make_expected = e_a_nat in - expect_n_pos_mid program "counter" make_input make_expected + expect_eq_n_pos_mid program "counter" make_input make_expected in let%bind () = let make_input = e_a_nat in let make_expected = fun n -> e_a_nat (n * (n + 1) / 2) in - expect_n_pos_mid program "sum" make_input make_expected + expect_eq_n_pos_mid program "sum" make_input make_expected in ok() @@ -319,12 +319,12 @@ let matching () : unit result = let%bind () = let make_input = e_a_int in let make_expected = fun n -> e_a_int (if n = 2 then 42 else 0) in - expect_n program "match_bool" make_input make_expected + expect_eq_n program "match_bool" make_input make_expected in let%bind () = let make_input = e_a_int in let make_expected = fun n-> e_a_int (if n = 2 then 42 else 0) in - expect_n program "match_expr_bool" make_input make_expected + expect_eq_n program "match_expr_bool" make_input make_expected in let%bind () = let aux n = @@ -335,7 +335,7 @@ let matching () : unit result = | Some s -> s | None -> 23) in trace (simple_error (Format.asprintf "on input %a" PP_helpers.(option int) n)) @@ - expect program "match_option" input expected + expect_eq program "match_option" input expected in bind_iter_list aux [Some 0 ; Some 2 ; Some 42 ; Some 163 ; Some (-1) ; None] @@ -349,7 +349,7 @@ let matching () : unit result = | Some s -> s | None -> 42) in trace (simple_error (Format.asprintf "on input %a" PP_helpers.(option int) n)) @@ - expect program "match_expr_option" input expected + expect_eq program "match_expr_option" input expected in bind_iter_list aux [Some 0 ; Some 2 ; Some 42 ; Some 163 ; Some (-1) ; None] @@ -360,25 +360,25 @@ let declarations () : unit result = let%bind program = type_file "./contracts/declarations.ligo" in let make_input = e_a_int in let make_expected = fun n -> e_a_int (42 + n) in - expect_n program "main" make_input make_expected + expect_eq_n program "main" make_input make_expected let quote_declaration () : unit result = let%bind program = type_file "./contracts/quote-declaration.ligo" in let make_input = e_a_int in let make_expected = fun n -> e_a_int (42 + 2 * n) in - expect_n program "main" make_input make_expected + expect_eq_n program "main" make_input make_expected let quote_declarations () : unit result = let%bind program = type_file "./contracts/quote-declarations.ligo" in let make_input = e_a_int in let make_expected = fun n -> e_a_int (74 + 2 * n) in - expect_n program "main" make_input make_expected + expect_eq_n program "main" make_input make_expected let counter_contract () : unit result = let%bind program = type_file "./contracts/counter.ligo" in let make_input = fun n-> e_a_pair (e_a_int n) (e_a_int 42) in let make_expected = fun n -> e_a_pair (e_a_list [] t_operation) (e_a_int (42 + n)) in - expect_n program "main" make_input make_expected + expect_eq_n program "main" make_input make_expected let super_counter_contract () : unit result = let%bind program = type_file "./contracts/super-counter.ligo" in @@ -388,7 +388,7 @@ let super_counter_contract () : unit result = let make_expected = fun n -> let op = if n mod 2 = 0 then (+) else (-) in e_a_pair (e_a_list [] t_operation) (e_a_int (op 42 n)) in - expect_n program "main" make_input make_expected + expect_eq_n program "main" make_input make_expected let basic_mligo () : unit result = let%bind typed = mtype_file "./contracts/basic.mligo" in @@ -399,13 +399,13 @@ let counter_mligo () : unit result = let%bind program = mtype_file "./contracts/counter.mligo" in let make_input = fun n-> e_a_pair (e_a_int n) (e_a_int 42) in let make_expected = fun n -> e_a_pair (e_a_list [] t_operation) (e_a_int (42 + n)) in - expect_n program "main" make_input make_expected + expect_eq_n program "main" make_input make_expected let guess_the_hash_mligo () : unit result = let%bind program = mtype_file "./contracts/new-syntax.mligo" in let make_input = fun n-> e_a_pair (e_a_int n) (e_a_int 42) in let make_expected = fun n -> e_a_pair (e_a_list [] t_operation) (e_a_int (42 + n)) in - expect_n program "main" make_input make_expected + expect_eq_n program "main" make_input make_expected let main = "Integration (End to End)", [ test "function" function_ ; diff --git a/src/ligo/test/test_helpers.ml b/src/ligo/test/test_helpers.ml index 146451d12..5c568eddc 100644 --- a/src/ligo/test/test_helpers.ml +++ b/src/ligo/test/test_helpers.ml @@ -21,7 +21,7 @@ let make_options ?amount () = { amount ; } -let expect ?(options = make_options ()) program entry_point input expected = +let expect ?(options = make_options ()) program entry_point input expecter = let%bind result = let run_error = let title () = "expect run" in @@ -29,54 +29,75 @@ let expect ?(options = make_options ()) program entry_point input expected = error title content in trace run_error @@ Ligo.easy_run_typed_simplified ~debug_michelson:false ?amount:options.amount entry_point program input in - let expect_error = - let title () = "expect result" in - let content () = Format.asprintf "Expected %a, got %a" - Ast_simplified.PP.value expected - Ast_simplified.PP.value result in - error title content in - trace_strong expect_error @@ - Ast_simplified.assert_value_eq (expected , result) + expecter result -let expect_evaluate program entry_point expected = +let expect_eq ?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_simplified.PP.value expected + Ast_simplified.PP.value result in + error title content in + trace_strong expect_error @@ + Ast_simplified.assert_value_eq (expected , result) in + expect ?options program entry_point input expecter + +let expect_evaluate program entry_point expecter = let error = let title () = "expect evaluate" in let content () = Format.asprintf "Entry_point: %s" entry_point in error title content in trace error @@ let%bind result = Ligo.easy_evaluate_typed_simplified entry_point program in - Ast_simplified.assert_value_eq (expected , result) + expecter result -let expect_n_aux ?options lst program entry_point make_input make_expected = +let expect_eq_evaluate program entry_point expected = + let expecter = fun result -> + Ast_simplified.assert_value_eq (expected , result) in + expect_evaluate program entry_point expecter + +let expect_n_aux ?options lst program entry_point make_input make_expecter = let aux n = let input = make_input n in - let expected = make_expected n in + let expecter = make_expecter n in trace (simple_error ("expect_n " ^ (string_of_int n))) @@ - let result = expect ?options program entry_point input expected in + let result = expect ?options program entry_point input expecter in result in let%bind _ = bind_map_list aux lst in ok () -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_eq_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_eq_n " ^ (string_of_int n))) @@ + let result = expect_eq ?options program entry_point input expected in + result + in + let%bind _ = bind_map_list aux lst in + ok () -let expect_b program entry_point make_expected = +let expect_eq_n ?options = expect_eq_n_aux ?options [0 ; 2 ; 42 ; 163 ; -1] +let expect_eq_n_pos ?options = expect_eq_n_aux ?options [0 ; 2 ; 42 ; 163] +let expect_eq_n_strict_pos ?options = expect_eq_n_aux ?options [2 ; 42 ; 163] +let expect_eq_n_pos_small ?options = expect_eq_n_aux ?options [0 ; 2 ; 10] +let expect_eq_n_strict_pos_small ?options = expect_eq_n_aux ?options [2 ; 10] +let expect_eq_n_pos_mid = expect_eq_n_aux [0 ; 2 ; 10 ; 33] + +let expect_eq_b program entry_point make_expected = let aux b = let input = e_a_bool b in let expected = make_expected b in - expect program entry_point input expected + expect_eq program entry_point input expected in let%bind _ = bind_map_list aux [false ; true] in ok () -let expect_n_int a b c = - expect_n a b e_a_int (fun n -> e_a_int (c n)) +let expect_eq_n_int a b c = + expect_eq_n a b e_a_int (fun n -> e_a_int (c n)) -let expect_b_bool a b c = +let expect_eq_b_bool a b c = let open Ast_simplified.Combinators in - expect_b a b (fun bool -> e_a_bool (c bool)) + expect_eq_b a b (fun bool -> e_a_bool (c bool)) diff --git a/src/ligo/transpiler/transpiler.ml b/src/ligo/transpiler/transpiler.ml index 2f86583d5..61cb952df 100644 --- a/src/ligo/transpiler/transpiler.ml +++ b/src/ligo/transpiler/transpiler.ml @@ -25,6 +25,9 @@ let rec translate_type (t:AST.type_value) : type_value result = | T_constant ("address", []) -> ok (T_base Base_address) | T_constant ("unit", []) -> ok (T_base Base_unit) | T_constant ("operation", []) -> ok (T_base Base_operation) + | T_constant ("contract", [x]) -> + let%bind x' = translate_type x in + ok (T_contract x') | T_constant ("map", [key;value]) -> let%bind kv' = bind_map_pair translate_type (key, value) in ok (T_map kv')