balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add crypto primitives; more coase; better tests

Browse Source
This commit is contained in:
Galfour 2019-05-06 06:36:26 +00:00
parent a2caec9939
commit a5971a3b54
13 changed files with 234 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/ligo/compiler/compiler_program.ml
View File

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

7
src/ligo/compiler/compiler_type.ml
View File

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

40
src/ligo/contracts/coase.ligo
View File

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

1
src/ligo/meta_michelson/contract.ml
View File

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

1
src/ligo/mini_c/PP.ml
View File

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

4
src/ligo/mini_c/combinators.ml
View File

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

1
src/ligo/mini_c/types.ml
View File

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

37
src/ligo/operators/operators.ml
View File

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

8
src/ligo/simplify/pascaligo.ml
View File

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

34
src/ligo/test/coase_tests.ml
View File

@ -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 ; *)
]

132
src/ligo/test/integration_tests.ml
View File

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

73
src/ligo/test/test_helpers.ml
View File

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

3
src/ligo/transpiler/transpiler.ml
View File

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