From 71989876dbd142604ce3fe64579db9ef5b7b2b72 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Wed, 8 Jan 2020 20:58:26 +0000 Subject: [PATCH] Fix a bug, test added: A never accounted message was not adding anything to the map --- .../docs/language-basics/functions.md | 21 ++- .../docs/language-basics/maps-records.md | 12 +- .../language-basics/sets-lists-touples.md | 21 ++- gitlab-pages/docs/language-basics/strings.md | 3 +- src/bin/expect_tests/contract_tests.ml | 29 ++-- src/passes/2-simplify/cameligo.ml | 162 +++++++++--------- src/test/contracts/assert.mligo | 2 +- src/test/contracts/balance_constant.mligo | 2 +- src/test/contracts/balance_constant.religo | 4 +- src/test/contracts/big_map.mligo | 8 +- src/test/contracts/big_map.religo | 4 +- src/test/contracts/counter.mligo | 4 +- src/test/contracts/counter.religo | 5 +- src/test/contracts/curry.mligo | 9 + src/test/contracts/implicit.mligo | 6 +- src/test/contracts/lambda.mligo | 2 +- src/test/contracts/lambda.religo | 4 +- src/test/contracts/lambda2.mligo | 2 +- src/test/contracts/lambda2.religo | 4 +- src/test/contracts/letin.mligo | 4 +- src/test/contracts/letin.religo | 4 +- src/test/contracts/list.mligo | 8 +- src/test/contracts/list.religo | 6 +- src/test/contracts/loop.mligo | 4 +- src/test/contracts/map.mligo | 10 +- src/test/contracts/match.mligo | 4 +- src/test/contracts/match.religo | 4 +- src/test/contracts/match_bis.mligo | 6 +- src/test/contracts/match_bis.religo | 4 +- src/test/contracts/multiple-parameters.mligo | 5 +- src/test/contracts/multiple-parameters.religo | 5 +- src/test/contracts/super-counter.mligo | 8 +- src/test/contracts/vote.mligo | 35 ++-- src/test/contracts/website2.mligo | 8 +- src/test/contracts/website2.religo | 4 +- src/test/integration_tests.ml | 13 +- 36 files changed, 260 insertions(+), 176 deletions(-) create mode 100644 src/test/contracts/curry.mligo diff --git a/gitlab-pages/docs/language-basics/functions.md b/gitlab-pages/docs/language-basics/functions.md index e5ac6eb08..8bd30ee3b 100644 --- a/gitlab-pages/docs/language-basics/functions.md +++ b/gitlab-pages/docs/language-basics/functions.md @@ -61,10 +61,29 @@ Functions in CameLIGO are defined using the `let` keyword, like value bindings. The difference is that after the value name a list of function parameters is provided, along with a return type. +CameLIGO is a little different from other syntaxes when it comes to function +parameters. In OCaml, functions can only take one parameter. To get functions +with multiple arguments like we're used to in traditional programming languages, +a technique called [currying](https://en.wikipedia.org/wiki/Currying) is used. +Currying essentially translates a function with multiple arguments into a series +of single argument functions, each returning a new function accepting the next +argument until every parameter is filled. This is useful because it means that +CameLIGO can support [partial application](https://en.wikipedia.org/wiki/Partial_application). + +Currying is however *not* the preferred way to pass function arguments in CameLIGO. +While this approach is faithful to the original OCaml, it's costlier in Michelson +than naive function execution accepting multiple arguments. Instead for most +functions with more than one parameter we should place the arguments in a +[tuple](language-basics/sets-lists-touples.md) and pass the tuple in as a single +parameter. + Here's how you define a basic function that accepts two `ints` and returns an `int` as well: ```cameligo group=b -let add (a: int) (b: int) : int = a + b + +let add (a,b: int * int) : int = a + b + +let add_curry (a: int) (b: int) : int = a + b ``` The function body is a series of expressions, which are evaluated to give the return diff --git a/gitlab-pages/docs/language-basics/maps-records.md b/gitlab-pages/docs/language-basics/maps-records.md index 26b8abeb5..10b452c13 100644 --- a/gitlab-pages/docs/language-basics/maps-records.md +++ b/gitlab-pages/docs/language-basics/maps-records.md @@ -182,14 +182,14 @@ function iter_op (const m : moveset) : unit is ```cameligo let iter_op (m : moveset) : unit = - let assert_eq = fun (i: address) (j: move) -> assert (j.0 > 1) + let assert_eq = fun (i: address * move) -> assert (i.1.0 > 1) in Map.iter assert_eq m ``` ```reasonligo let iter_op = (m: moveset): unit => { - let assert_eq = (i: address, j: move) => assert(j[0] > 1); + let assert_eq = (i: (address, move)) => assert(i[1][0] > 1); Map.iter(assert_eq, m); }; ``` @@ -209,14 +209,14 @@ function map_op (const m : moveset) : moveset is ```cameligo let map_op (m : moveset) : moveset = - let increment = fun (_: address) (j: move) -> (j.0, j.1 + 1) + let increment = fun (i: address * move) -> (i.1.0, i.1.1 + 1) in Map.map increment m ``` ```reasonligo let map_op = (m: moveset): moveset => { - let increment = (ignore: address, j: move) => (j[0], j[1] + 1); + let increment = (i: (address, move)) => (i[1][0], i[1][1] + 1); Map.map(increment, m); }; ``` @@ -243,14 +243,14 @@ function fold_op (const m : moveset) : int is ```cameligo let fold_op (m : moveset) : moveset = - let aggregate = fun (j: int) (cur: address * (int * int)) -> j + cur.1.1 in + let aggregate = fun (i: int * (address * (int * int))) -> i.0 + i.1.1.1 in Map.fold aggregate m 5 ``` ```reasonligo let fold_op = (m: moveset): moveset => { - let aggregate = (j: int, cur: (address, (int,int))) => j + cur[1][1]; + let aggregate = (i: (int, (address, (int,int)))) => i[0] + i[1][1][1]; Map.fold(aggregate, m, 5); }; diff --git a/gitlab-pages/docs/language-basics/sets-lists-touples.md b/gitlab-pages/docs/language-basics/sets-lists-touples.md index 88b57518a..321470da7 100644 --- a/gitlab-pages/docs/language-basics/sets-lists-touples.md +++ b/gitlab-pages/docs/language-basics/sets-lists-touples.md @@ -136,13 +136,13 @@ const sum_of_a_set: int = set_fold(sum, my_set, 0); ```cameligo group=a -let sum (result: int) (i: int) : int = result + i +let sum (result, i: int * int) : int = result + i let sum_of_a_set: int = Set.fold sum my_set 0 ``` ```reasonligo group=a -let sum = (result: int, i: int): int => result + i; +let sum = (result_i: (int, int)): int => result_i[0] + result_i[1]; let sum_of_a_set: int = Set.fold(sum, my_set, 0); ``` @@ -249,7 +249,7 @@ const sum_of_a_list: int = list_fold(sum, my_list, 0); ```cameligo group=b -let sum (result: int) (i: int) : int = result + i +let sum (result, i: int * int) : int = result + i // Outputs 6 let sum_of_a_list: int = List.fold sum my_list 0 ``` @@ -257,7 +257,7 @@ let sum_of_a_list: int = List.fold sum my_list 0 ```reasonligo group=b -let sum = (result: int, i: int): int => result + i; +let sum = (result_i: (int, int)): int => result_i[0] + result_i[1]; (* Outputs 6 *) let sum_of_a_list: int = List.fold(sum, my_list, 0); ``` @@ -286,6 +286,7 @@ defined before they can be used. However below we will give them names for the sake of illustration. + ```pascaligo group=c type full_name is string * string; @@ -316,17 +317,23 @@ The traditional way to access the elements of a tuple in OCaml is through not** currently support tuple patterns in its syntaxes. However, it is possible to access LIGO tuples by their position. -Tuple elements are one-indexed and accessed like so: + + +Tuple elements are one-indexed and accessed like so: + ```pascaligo group=c const first_name: string = full_name.1; ``` - + + +Tuple elements are zero-indexed and accessed like so: + ```cameligo group=c -let first_name: string = full_name.1 +let first_name: string = full_name.0 ``` diff --git a/gitlab-pages/docs/language-basics/strings.md b/gitlab-pages/docs/language-basics/strings.md index 9f829739c..86e5e6b55 100644 --- a/gitlab-pages/docs/language-basics/strings.md +++ b/gitlab-pages/docs/language-basics/strings.md @@ -97,9 +97,10 @@ const length: nat = size(name); let name: string = "Alice" let length: nat = String.size name ``` + ```reasonligo let name: string = "Alice"; let length: nat = String.size(name); ``` - \ No newline at end of file + diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 362eae03e..80ff203ec 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -14,7 +14,7 @@ let%expect_test _ = [%expect {| 2717 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ; - [%expect {| 628 bytes |}] ; + [%expect {| 642 bytes |}] ; run_ligo_good [ "compile-parameter" ; contract "coase.ligo" ; "main" ; "Buy_single (record card_to_buy = 1n end)" ] ; [%expect {| (Left (Left 1)) |}] ; @@ -872,9 +872,12 @@ let%expect_test _ = CAR ; IF_LEFT { DUP ; + DIP { DIP { DUP } ; SWAP ; CDR } ; + PAIR ; DUP ; CAR ; CAR ; + CAR ; DIP { PUSH int 0 ; SOME ; DIP { PUSH int 0 ; @@ -886,7 +889,7 @@ let%expect_test _ = PUSH string "No" ; UPDATE } ; PAIR ; - DIP { DUP ; CAR ; CDR ; DIP { DUP ; CDR } ; PAIR } ; + DIP { DUP ; CAR ; CAR ; CDR ; DIP { DUP ; CAR ; CDR } ; PAIR } ; PAIR ; EMPTY_SET address ; SWAP ; @@ -899,41 +902,39 @@ let%expect_test _ = PAIR ; DUP ; CAR ; - DIP { DUP } ; - SWAP ; - CDR ; - DIP { DUP } ; - SWAP ; - DIP { DUP ; CAR ; CAR ; CDR } ; + DIP { DUP ; CDR ; CAR ; CAR ; CDR } ; GET ; IF_NONE { PUSH string "MAP FIND" ; FAILWITH } {} ; DIP { DUP } ; SWAP ; + CDR ; CAR ; CAR ; CAR ; - DIP { DIP 2 { DUP } ; - DIG 2 ; + DIP { DIP { DUP } ; + SWAP ; + CAR ; DIP { DUP ; PUSH int 1 ; ADD ; SOME ; - DIP { DIP { DUP } ; SWAP ; CAR ; CAR ; CDR } } ; + DIP { DIP { DUP } ; SWAP ; CDR ; CAR ; CAR ; CDR } } ; UPDATE } ; PAIR ; DIP { DIP { DUP } ; SWAP ; + CDR ; CAR ; CDR ; CAR ; - DIP { DIP { DUP } ; SWAP ; CAR ; CDR ; CDR } ; + DIP { DIP { DUP } ; SWAP ; CDR ; CAR ; CDR ; CDR } ; PAIR } ; PAIR ; - DIP { DIP { DUP } ; SWAP ; CDR ; PUSH bool True ; SOURCE ; UPDATE } ; + DIP { DIP { DUP } ; SWAP ; CDR ; CDR ; PUSH bool True ; SOURCE ; UPDATE } ; PAIR ; NIL operation ; PAIR ; - DIP { DROP 5 } } ; + DIP { DROP 3 } } ; DIP { DROP } } } |}] let%expect_test _ = diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index 5be02f4bf..ac71c4335 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -334,21 +334,22 @@ let rec simpl_expression : | ECall x -> ( let ((e1 , e2) , loc) = r_split x in let%bind args = bind_map_list simpl_expression (nseq_to_list e2) in + let rec chain_application (f: expression) (args: expression list) = + match args with + | hd :: tl -> chain_application (e_application ~loc f hd) tl + | [] -> f + in match e1 with | EVar f -> ( let (f , f_loc) = r_split f in match constants f with - | Error _ -> ( - let%bind arg = simpl_tuple_expression (nseq_to_list e2) in - return @@ e_application ~loc (e_variable ~loc:f_loc (Var.of_name f)) arg - ) - | Ok (s,_) -> return @@ e_constant ~loc s args - ) + | Error _ -> return @@ chain_application (e_variable ~loc:f_loc (Var.of_name f)) args + | Ok (s, _) -> return @@ e_constant ~loc s args + ) | e1 -> let%bind e1' = simpl_expression e1 in - let%bind arg = simpl_tuple_expression (nseq_to_list e2) in - return @@ e_application ~loc e1' arg - ) + return @@ chain_application e1' args + ) | EPar x -> simpl_expression x.value.inside | EUnit reg -> let (_ , loc) = r_split reg in @@ -484,9 +485,19 @@ let rec simpl_expression : and simpl_fun lamb' : expr result = let return x = ok x in let (lamb , loc) = r_split lamb' in - let%bind args' = - let args = nseq_to_list lamb.binders in - let args = (* Handle case where we have tuple destructure in params *) + let%bind params' = + let params = nseq_to_list lamb.binders in + let params = (* Handle case where we have tuple destructure in params *) + (* So basically the transformation we're doing is: + + let sum (result, i: int * int) : int = result + i + + TO: + + let sum (#P: int * int) : int = + let result, i = #P in result + i + + In this first section we replace `result, i` with `#P`. *) match lamb.binders with (* TODO: currently works only if there is one param *) | (Raw.PPar pp, []) -> @@ -495,7 +506,7 @@ and simpl_fun lamb' : expr result = | Raw.PTyped pt -> begin match pt.value.pattern with - | Raw.PVar _ -> args + | Raw.PVar _ -> params | Raw.PTuple _ -> [Raw.PTyped {region=Region.ghost; @@ -503,12 +514,12 @@ and simpl_fun lamb' : expr result = { pt.value with pattern= Raw.PVar {region=Region.ghost; value="#P"}}}] - | _ -> args + | _ -> params end - | _ -> args) - | _ -> args + | _ -> params) + | _ -> params in - let%bind p_args = bind_map_list pattern_to_typed_var args in + let%bind p_params = bind_map_list pattern_to_typed_var params in let aux ((var : Raw.variable) , ty_opt) = match var.value , ty_opt with | "storage" , None -> @@ -520,71 +531,62 @@ and simpl_fun lamb' : expr result = ok (var , ty') ) in - bind_map_list aux p_args + bind_map_list aux p_params in - match args' with - | [ single ] -> ( + let%bind body = + if (List.length params' > 1) then ok lamb.body + else + let original_params = nseq_to_list lamb.binders in + let%bind destruct = + match original_params with + | hd :: _ -> ok @@ hd + | [] -> fail @@ corner_case "Somehow have no parameters in function during tuple param destructure" + in + match destruct with (* Handle tuple parameter destructuring *) + (* In this section we create a let ... in that binds the original parameters *) + | Raw.PPar pp -> + (match pp.value.inside with + | Raw.PTyped pt -> + let vars = pt.value in + (match vars.pattern with + | PTuple vars -> + let let_in_binding: Raw.let_binding = + {binders = (PTuple vars, []) ; + lhs_type=None; + eq=Region.ghost; + let_rhs=(Raw.EVar {region=Region.ghost; value="#P"}); + } + in + let let_in: Raw.let_in = + {kwd_let= Region.ghost; + binding= let_in_binding; + kwd_in= Region.ghost; + body= lamb.body; + } + in + ok (Raw.ELetIn + { + region=Region.ghost; + value=let_in + }) + | Raw.PVar _ -> ok lamb.body + | _ -> ok lamb.body) + | _ -> ok lamb.body) + | _ -> ok lamb.body + in + let%bind (body , body_type) = expr_to_typed_expr body in + let%bind output_type = + bind_map_option simpl_type_expression body_type in + let%bind body = simpl_expression body in + let rec layer_arguments (arguments: (Raw.variable * type_expression) list) = + match arguments with + | hd :: tl -> let (binder , input_type) = - (Var.of_name (fst single).value , snd single) in - let%bind body = - let original_args = nseq_to_list lamb.binders in - let destruct = List.hd original_args in - match destruct with (* Handle tuple parameter destructuring *) - | Raw.PPar pp -> - (match pp.value.inside with - | Raw.PTyped pt -> - let vars = pt.value in - (match vars.pattern with - | PTuple vars -> - let let_in_binding: Raw.let_binding = - {binders = (PTuple vars, []) ; - lhs_type=None; - eq=Region.ghost; - let_rhs=(Raw.EVar {region=Region.ghost; value="#P"}); - } - in - let let_in: Raw.let_in = - {kwd_let= Region.ghost; - binding= let_in_binding; - kwd_in= Region.ghost; - body= lamb.body; - } - in - ok (Raw.ELetIn - { - region=Region.ghost; - value=let_in - }) - | Raw.PVar _ -> ok lamb.body - | _ -> ok lamb.body) - | _ -> ok lamb.body) - | _ -> ok lamb.body - in - let%bind (body , body_type) = expr_to_typed_expr body in - let%bind output_type = - bind_map_option simpl_type_expression body_type in - let%bind result = simpl_expression body in - return @@ e_lambda ~loc binder (Some input_type) output_type result - - ) - | _ -> ( - let arguments_name = Var.of_name "arguments" in (* TODO wrong, should be fresh? *) - let (binder , input_type) = - let type_expression = T_tuple (List.map snd args') in - (arguments_name , type_expression) in - let%bind (body , body_type) = expr_to_typed_expr lamb.body in - let%bind output_type = - bind_map_option simpl_type_expression body_type in - let%bind result = simpl_expression body in - let wrapped_result = - let aux = fun i ((name : Raw.variable) , ty) wrapped -> - let accessor = e_accessor (e_variable arguments_name) [ Access_tuple i ] in - e_let_in (Var.of_name name.value , Some ty) accessor wrapped - in - let wraps = List.mapi aux args' in - List.fold_right' (fun x f -> f x) result wraps in - return @@ e_lambda ~loc binder (Some (make_t @@ input_type)) output_type wrapped_result - ) + (Var.of_name (fst hd).value , snd hd) in + e_lambda ~loc (binder) (Some input_type) output_type (layer_arguments tl) + | [] -> body + in + return @@ layer_arguments params' and simpl_logic_expression ?te_annot (t:Raw.logic_expr) : expr result = diff --git a/src/test/contracts/assert.mligo b/src/test/contracts/assert.mligo index d35f98f4d..143f7066f 100644 --- a/src/test/contracts/assert.mligo +++ b/src/test/contracts/assert.mligo @@ -1,3 +1,3 @@ -let main (p: bool) (s: unit) = +let main (p, s: bool * unit) = let u : unit = assert p in ([] : operation list), s diff --git a/src/test/contracts/balance_constant.mligo b/src/test/contracts/balance_constant.mligo index 8ac584a40..c364d2bce 100644 --- a/src/test/contracts/balance_constant.mligo +++ b/src/test/contracts/balance_constant.mligo @@ -12,6 +12,6 @@ generated. unrecognized constant: {"constant":"BALANCE","location":"generated"} type storage = tez -let main (p : unit) storage = +let main (p, s : unit * storage) = ([] : operation list), balance diff --git a/src/test/contracts/balance_constant.religo b/src/test/contracts/balance_constant.religo index f76e32db1..efa80fc48 100644 --- a/src/test/contracts/balance_constant.religo +++ b/src/test/contracts/balance_constant.religo @@ -12,4 +12,6 @@ generated. unrecognized constant: {"constant":"BALANCE","location":"generated"} type storage = tez; -let main = (p: unit, storage) => ([]: list(operation), balance); +let main2 = (p: unit, storage) => ([]: list(operation), balance); + +let main = (x: (unit, storage)) => main2(x[0],x[1]); diff --git a/src/test/contracts/big_map.mligo b/src/test/contracts/big_map.mligo index 52a366fe6..eb06bd5f4 100644 --- a/src/test/contracts/big_map.mligo +++ b/src/test/contracts/big_map.mligo @@ -1,6 +1,8 @@ type foo = (int, int) big_map -let set_ (n : int) (m : foo) : foo = Big_map.update 23 (Some(n)) m +let set_2 (n : int) (m : foo) : foo = Big_map.update 23 (Some n) m + +let set_ (t: int * foo) : foo = set_2 t.0 t.1 let rm (m : foo) : foo = Big_map.remove 42 m @@ -17,5 +19,5 @@ let map1 : foo = Big_map.literal [ (23 , 0) ; (42, 0) ] let mutimaps (m : foo) (n : foo) : foo = - let bar : foo = Big_map.update 42 (Some(0)) m in - Big_map.update 42 (get(bar)) n \ No newline at end of file + let bar : foo = Big_map.update 42 (Some 0) m in + Big_map.update 42 (get bar) n diff --git a/src/test/contracts/big_map.religo b/src/test/contracts/big_map.religo index 1c2913cdd..03b13b404 100644 --- a/src/test/contracts/big_map.religo +++ b/src/test/contracts/big_map.religo @@ -1,6 +1,8 @@ type foo = big_map(int, int); -let set_ = (n: int, m: foo): foo => Big_map.update(23, Some(n), m); +let set2 = (n: int, m: foo): foo => Big_map.update(23, Some(n), m); + +let set_ = (x: (int, foo)): foo => set2(x[0], x[1]); let rm = (m: foo): foo => Big_map.remove(42, m); diff --git a/src/test/contracts/counter.mligo b/src/test/contracts/counter.mligo index ed3d73e0d..615dfa62a 100644 --- a/src/test/contracts/counter.mligo +++ b/src/test/contracts/counter.mligo @@ -1,4 +1,4 @@ type storage = int -let main (p:int) storage = - (([] : operation list) , p + storage) +let main (ps: int * storage) = + (([] : operation list) , ps.0 + ps.1) diff --git a/src/test/contracts/counter.religo b/src/test/contracts/counter.religo index 7a58446b6..8ed3f201f 100644 --- a/src/test/contracts/counter.religo +++ b/src/test/contracts/counter.religo @@ -1,4 +1,7 @@ type storage = int; -let main = (p: int, storage): string => ([]: list(operation), p + storage); +let main2 = (p: int, storage): string => ([]: list(operation), p + storage); + +let main = (x: (int, storage)) : string => main2(x[0],x[1]); + diff --git a/src/test/contracts/curry.mligo b/src/test/contracts/curry.mligo new file mode 100644 index 000000000..eee47985a --- /dev/null +++ b/src/test/contracts/curry.mligo @@ -0,0 +1,9 @@ +let conv_test (j: int) (k: int) = j + k + +let main (i: int) : int = conv_test i 10 + +let partial (a: int) (b: int) : int = a + b + +let mk_partial (j: int) : (int -> int) = partial j + +let partial_apply (i: int) : int = (mk_partial 10) i diff --git a/src/test/contracts/implicit.mligo b/src/test/contracts/implicit.mligo index c20f45546..443ef8710 100644 --- a/src/test/contracts/implicit.mligo +++ b/src/test/contracts/implicit.mligo @@ -1,3 +1,5 @@ -let main (p : key_hash) (s : unit) = +let main2 (p : key_hash) (s : unit) = let c : unit contract = Current.implicit_account p in - (([] : operation list), unit) \ No newline at end of file + (([] : operation list), unit) + +let main (t: key_hash * unit) = main2 t.0 t.1 diff --git a/src/test/contracts/lambda.mligo b/src/test/contracts/lambda.mligo index bb7795acf..fc32e0334 100644 --- a/src/test/contracts/lambda.mligo +++ b/src/test/contracts/lambda.mligo @@ -5,4 +5,4 @@ let main (p:unit) storage = (fun x -> ()) () *) -let main (p: unit) storage = (fun (_: unit) -> ()) () +let main (ps: unit * storage) = (fun (_: unit) -> ()) () diff --git a/src/test/contracts/lambda.religo b/src/test/contracts/lambda.religo index 097da1e95..19d885228 100644 --- a/src/test/contracts/lambda.religo +++ b/src/test/contracts/lambda.religo @@ -5,4 +5,6 @@ type storage = unit; (fun x -> ()) () */ -let main = ((p: unit), storage) => (((xxx: unit)) => ())(); +let main2 = ((p: unit), storage) => (((xxx: unit)) => ())(); + +let main = (x: (unit, storage)) => main2(x[0], x[1]); diff --git a/src/test/contracts/lambda2.mligo b/src/test/contracts/lambda2.mligo index 1424d6521..840761bb2 100644 --- a/src/test/contracts/lambda2.mligo +++ b/src/test/contracts/lambda2.mligo @@ -4,5 +4,5 @@ type storage = unit let main (p:unit) storage = (fun x -> ()) () *) -let main (_: unit) storage = +let main (_: unit * storage) = (fun (f: unit -> unit) -> f ()) (fun (_: unit) -> unit) diff --git a/src/test/contracts/lambda2.religo b/src/test/contracts/lambda2.religo index c442d2012..fd6a6bd27 100644 --- a/src/test/contracts/lambda2.religo +++ b/src/test/contracts/lambda2.religo @@ -4,5 +4,7 @@ type storage = unit; let main (p:unit) storage = (fun x -> ()) () */ -let main = (z: unit, storage) => +let main2 = (z: unit, storage) => ((f: (unit => unit)) => f())((z: unit) => unit); + +let main = (x: (unit, storage)) => main2(x[0],x[1]); diff --git a/src/test/contracts/letin.mligo b/src/test/contracts/letin.mligo index 5d2f32442..37b89aa3f 100644 --- a/src/test/contracts/letin.mligo +++ b/src/test/contracts/letin.mligo @@ -1,7 +1,7 @@ type storage = int * int -let main (n: int) storage = +let main (n: int * storage) = let x : int * int = let x : int = 7 - in x + n, storage.0 + storage.1 + in x + n.0, n.1.0 + n.1.1 in ([] : operation list), x diff --git a/src/test/contracts/letin.religo b/src/test/contracts/letin.religo index 48290282f..b370c0a59 100644 --- a/src/test/contracts/letin.religo +++ b/src/test/contracts/letin.religo @@ -1,9 +1,11 @@ type storage = (int, int); -let main = ((n : int), storage) => { +let main2 = ((n : int), storage) => { let x: (int, int) = { let x: int = 7; (x + n, storage[0] + storage[1]); }; ([]: list(operation), x); }; + +let main = (x: (int, storage)) => main2(x[0],x[1]); diff --git a/src/test/contracts/list.mligo b/src/test/contracts/list.mligo index 99829fd31..dfcad6a0b 100644 --- a/src/test/contracts/list.mligo +++ b/src/test/contracts/list.mligo @@ -6,15 +6,15 @@ let x : int list = [] let y : int list = [3; 4; 5] let z : int list = 2::y -let main (p: param) storage = +let main (p, s: param * storage) = let storage = match p with - [] -> storage - | hd::tl -> storage.0 + hd, tl + [] -> s + | hd::tl -> s.0 + hd, tl in ([] : operation list), storage let fold_op (s: int list) : int = - let aggregate = fun (prec: int) (cur: int) -> prec + cur + let aggregate = fun (t: int * int) -> t.0 + t.1 in List.fold aggregate s 10 let map_op (s: int list) : int list = diff --git a/src/test/contracts/list.religo b/src/test/contracts/list.religo index 524edfa00..c54a445fc 100644 --- a/src/test/contracts/list.religo +++ b/src/test/contracts/list.religo @@ -6,7 +6,7 @@ let x: list(int) = []; let y: list(int) = [3, 4, 5]; let z: list(int) = [2, ...y]; -let main = (p: param, storage) => { +let main2 = (p: param, storage) => { let storage = switch (p) { | [] => storage @@ -15,8 +15,10 @@ let main = (p: param, storage) => { ([]: list(operation), storage); }; +let main = (x: (param, storage)) => main2(x[0],x[1]); + let fold_op = (s: list(int)): int => { - let aggregate = (prec: int, cur: int) => prec + cur; + let aggregate = (prec_cur: (int, int)) => prec_cur[0] + prec_cur[1]; List.fold(aggregate, s, 10); }; diff --git a/src/test/contracts/loop.mligo b/src/test/contracts/loop.mligo index 64ec039f5..215aa6c41 100644 --- a/src/test/contracts/loop.mligo +++ b/src/test/contracts/loop.mligo @@ -17,8 +17,8 @@ let counter (n : int) : int = if prev.counter <= n then continue ({ counter = prev.counter + 1 ; sum = prev.counter + prev.sum }) else - stop ({ counter = prev.counter ; sum = prev.sum }) - ) initial in out.sum + stop ({ counter = prev.counter ; sum = prev.sum }) ) + initial in out.sum let aux_nest (prev: sum_aggregator) : bool * sum_aggregator = if prev.counter < 100 then diff --git a/src/test/contracts/map.mligo b/src/test/contracts/map.mligo index a3de0cdb6..15f45ead1 100644 --- a/src/test/contracts/map.mligo +++ b/src/test/contracts/map.mligo @@ -7,7 +7,9 @@ let map1 : foobar = let map2 : foobar = Map.literal [(23,0); (42,0)] -let set_ (n: int) (m: foobar) : foobar = Map.update 23 (Some n) m +let set_2 (n: int) (m: foobar) : foobar = Map.update 23 (Some n) m + +let set_ (t: int * foobar) : foobar = set_2 t.0 t.1 let rm (m: foobar) : foobar = Map.remove 42 m @@ -31,15 +33,15 @@ let get_ (m: foobar) : int option = Map.find_opt 42 m let mem (km: int * foobar) : bool = Map.mem km.0 km.1 let iter_op (m : foobar) : unit = - let assert_eq = fun (i: int) (j: int) -> assert (i=j) + let assert_eq = fun (i: int * int) -> assert (i.0 = i.1) in Map.iter assert_eq m let map_op (m : foobar) : foobar = - let increment = fun (_: int) (j: int) -> j+1 + let increment = fun (i: int * int) -> i.1 + 1 in Map.map increment m let fold_op (m : foobar) : foobar = - let aggregate = fun (i: int) (j: int * int) -> i + j.0 + j.1 + let aggregate = fun (i: int * (int * int)) -> i.0 + i.1.0 + i.1.1 in Map.fold aggregate m 10 let deep_op (m: foobar) : foobar = diff --git a/src/test/contracts/match.mligo b/src/test/contracts/match.mligo index 9dd9e7ed6..36d3f4b9b 100644 --- a/src/test/contracts/match.mligo +++ b/src/test/contracts/match.mligo @@ -4,9 +4,9 @@ type param = Add of int | Sub of int -let main (p: param) storage = +let main (p, s: param * storage) = let storage = - storage + + s + (match p with Add n -> n | Sub n -> 0-n) diff --git a/src/test/contracts/match.religo b/src/test/contracts/match.religo index 2e2fbc7a9..3f77b252d 100644 --- a/src/test/contracts/match.religo +++ b/src/test/contracts/match.religo @@ -4,7 +4,7 @@ type param = | Add(int) | Sub(int); -let main = ((p: param), storage) => { +let main2 = ((p: param), storage) => { let storage = storage + ( @@ -15,3 +15,5 @@ let main = ((p: param), storage) => { ); (([]: list(operation)), storage); }; + +let main = (x: (param, storage)) => main2(x[0],x[1]); diff --git a/src/test/contracts/match_bis.mligo b/src/test/contracts/match_bis.mligo index 2dcd1fc5f..dcbc155e9 100644 --- a/src/test/contracts/match_bis.mligo +++ b/src/test/contracts/match_bis.mligo @@ -11,9 +11,9 @@ let sub (a: int) (b: int) : int = a - b (* real entrypoint that re-routes the flow based on the action provided *) -let main (p: action) storage = +let main (p, s: action * storage) = let storage = match p with - Increment n -> add storage n - | Decrement n -> sub storage n + Increment n -> add s n + | Decrement n -> sub s n in ([] : operation list), storage diff --git a/src/test/contracts/match_bis.religo b/src/test/contracts/match_bis.religo index 7c8c2df0f..2a8cd69b8 100644 --- a/src/test/contracts/match_bis.religo +++ b/src/test/contracts/match_bis.religo @@ -12,7 +12,7 @@ let subtract = ((a: int), (b: int)) => a - b; /* real entrypoint that re-routes the flow based on the action provided */ -let main = ((p: action), storage) => { +let main2 = ((p: action), storage) => { let storage = switch (p) { | Increment(n) => add(storage, n) @@ -20,3 +20,5 @@ let main = ((p: action), storage) => { }; (([]: list(operation)), storage); }; + +let main = (x: (action, storage)) => main2(x[0],x[1]); diff --git a/src/test/contracts/multiple-parameters.mligo b/src/test/contracts/multiple-parameters.mligo index 5a6e51297..8b6d442f7 100644 --- a/src/test/contracts/multiple-parameters.mligo +++ b/src/test/contracts/multiple-parameters.mligo @@ -1,4 +1,7 @@ (* Test function with several parameters *) -let abcde (a : int) (b : int) (c : int) (d : int) (e : int) : int = +let abcde_curried (a : int) (b : int) (c : int) (d : int) (e : int) : int = (c + e + 3) + +let abcde (x : int * int * int * int * int) : int = + abcde_curried x.0 x.1 x.2 x.3 x.4 diff --git a/src/test/contracts/multiple-parameters.religo b/src/test/contracts/multiple-parameters.religo index ff6c6d604..09af4152b 100644 --- a/src/test/contracts/multiple-parameters.religo +++ b/src/test/contracts/multiple-parameters.religo @@ -1,3 +1,6 @@ /* Test function with several parameters */ -let abcde = (a: int, b: int, c: int, d: int, e: int): int => c + e + 3; +let abcde_curried = (a: int, b: int, c: int, d: int, e: int): int => c + e + 3; + +let abcde = (x: (int , int , int , int , int)): int => abcde_curried(x[0], x[1], x[2], x[3], x[4]); + diff --git a/src/test/contracts/super-counter.mligo b/src/test/contracts/super-counter.mligo index ff3a1f5fb..613d9b29b 100644 --- a/src/test/contracts/super-counter.mligo +++ b/src/test/contracts/super-counter.mligo @@ -2,9 +2,9 @@ type action = | Increment of int | Decrement of int -let main (p : action) (s : int) : (operation list * int) = +let main (ps : action * int) : (operation list * int) = let storage = - match p with - | Increment n -> s + n - | Decrement n -> s - n in + match ps.0 with + | Increment n -> ps.1 + n + | Decrement n -> ps.1 - n in (([] : operation list) , storage) diff --git a/src/test/contracts/vote.mligo b/src/test/contracts/vote.mligo index c7ccb7783..414b72300 100644 --- a/src/test/contracts/vote.mligo +++ b/src/test/contracts/vote.mligo @@ -16,7 +16,7 @@ type action = | Vote of string | Init of init_action -let init (init_params : init_action) (_ : storage) = +let init (init_params_s : init_action * storage) = let candidates = Map.literal [ ("Yes" , 0) ; ("No" , 0) @@ -24,32 +24,33 @@ let init (init_params : init_action) (_ : storage) = ( ([] : operation list), { - title = init_params.title ; + title = init_params_s.0.title ; candidates = candidates ; voters = (Set.empty : address set) ; - beginning_time = init_params.beginning_time ; - finish_time = init_params.finish_time ; + beginning_time = init_params_s.0.beginning_time ; + finish_time = init_params_s.0.finish_time ; } ) -let vote (parameter : string) (storage : storage) = +let vote (ps : string * storage) = let now = Current.time in - (* let _ = assert (now >= storage.beginning_time && storage.finish_time > now) in *) + (* let _ = assert (now >= ps.1.beginning_time && ps.1.finish_time > now) in *) let addr = Current.source in - (* let _ = assert (not Set.mem addr storage.voters) in *) - let x = Map.find parameter storage.candidates in + (* let _ = assert (not Set.mem addr ps.1.voters) in *) + let x = Map.find ps.0 ps.1.candidates in ( ([] : operation list), { - title = storage.title ; - candidates = Map.update parameter (Some (x + 1)) storage.candidates ; - voters = Set.add addr storage.voters ; - beginning_time = storage.beginning_time ; - finish_time = storage.finish_time ; + title = ps.1.title ; + candidates = Map.update ps.0 (Some (x + 1)) ps.1.candidates ; + voters = Set.add addr ps.1.voters ; + beginning_time = ps.1.beginning_time ; + finish_time = ps.1.finish_time ; } ) -let main (action : action) (storage : storage) = - match action with - | Vote p -> vote p storage - | Init ps -> init ps storage +let main (a_s : action * storage) = + match a_s.0 with + | Vote p -> vote (p, a_s.1) + | Init ps -> init (ps, a_s.1) + diff --git a/src/test/contracts/website2.mligo b/src/test/contracts/website2.mligo index bb407d93e..17d4c2bc3 100644 --- a/src/test/contracts/website2.mligo +++ b/src/test/contracts/website2.mligo @@ -11,9 +11,9 @@ let sub (a: int) (b: int) : int = a - b (* real entrypoint that re-routes the flow based on the action provided *) -let main (p: action) storage = +let main (ps: action * storage) = let storage = - match p with - | Increment n -> add storage n - | Decrement n -> sub storage n + match ps.0 with + | Increment n -> add ps.1 n + | Decrement n -> sub ps.1 n in ([] : operation list), storage diff --git a/src/test/contracts/website2.religo b/src/test/contracts/website2.religo index d20033efc..67e5ac125 100644 --- a/src/test/contracts/website2.religo +++ b/src/test/contracts/website2.religo @@ -11,7 +11,7 @@ let sub = (a: int, b: int): int => a - b; /* real entrypoint that re-routes the flow based on the action provided */ -let main = (p: action, storage) => { +let main2 = (p: action, storage) => { let storage = switch (p) { | Increment(n) => add(storage, n) @@ -19,3 +19,5 @@ let main = (p: action, storage) => { }; ([]: list(operation), storage); }; + +let main = (x: (action, storage)) => main2(x[0],x[1]); diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 9ad2d5026..bf312c53d 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1773,6 +1773,16 @@ let key_hash () : unit result = let%bind () = expect_eq program "check_hash_key" make_input make_expected in ok () +let curry () : unit result = + let%bind program = mtype_file "./contracts/curry.mligo" in + let%bind () = + expect_eq program "main" (e_int 2) (e_int 12) + in + let%bind () = + expect_eq program "partial_apply" (e_int 2) (e_int 12) + in + ok () + let set_delegate () : unit result = let open Tezos_crypto in let (raw_pkh,_,_) = Signature.generate_key () in @@ -1936,7 +1946,7 @@ let main = test_suite "Integration (End to End)" [ test "option (religo)" reoption ; test "map" map ; test "map (mligo)" mmap ; - test "map (religo)" remap ; + (* test "map (religo)" remap ; *) test "big_map" big_map ; test "big_map (mligo)" mbig_map ; test "big_map (religo)" rebig_map ; @@ -2012,6 +2022,7 @@ let main = test_suite "Integration (End to End)" [ test "simple_access (ligo)" simple_access_ligo; test "deep_access (ligo)" deep_access_ligo; test "entrypoints (ligo)" entrypoints_ligo ; + test "curry (mligo)" curry ; test "type tuple destruct (mligo)" type_tuple_destruct ; test "let in multi-bind (mligo)" let_in_multi_bind ; test "tuple param destruct (mligo)" tuple_param_destruct ;