From 5159f293f81d9189281b2f0cd6038a5523f65053 Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Thu, 27 Feb 2020 01:36:56 +0100 Subject: [PATCH] Repare function annotation in let binding for Camligo and ReasonLigo and fix some contracts --- .../docs/language-basics/functions.md | 2 +- .../docs/language-basics/maps-records.md | 4 +-- gitlab-pages/docs/reference/map.md | 4 +-- src/passes/2-simplify/cameligo.ml | 30 +++++++++++++++---- src/test/contracts/failwith.mligo | 2 +- src/test/contracts/let_in_multi_bind.mligo | 2 +- src/test/contracts/map.mligo | 4 +-- .../contracts/negative/self_in_lambda.mligo | 4 +-- src/test/contracts/set_arithmetic.mligo | 2 +- 9 files changed, 37 insertions(+), 17 deletions(-) diff --git a/gitlab-pages/docs/language-basics/functions.md b/gitlab-pages/docs/language-basics/functions.md index b4c81beb1..9f55eec5c 100644 --- a/gitlab-pages/docs/language-basics/functions.md +++ b/gitlab-pages/docs/language-basics/functions.md @@ -133,7 +133,7 @@ returns an integer as well: ```cameligo group=b let add (a, b : int * int) : int = a + b // Uncurried let add_curry (a : int) (b : int) : int = add (a, b) // Curried -let increment (b : int) : int = add_curry 1 // Partial application +let increment (b : int) : int = add_curry 1 b // Partial application ``` You can run the `increment` function defined above using the LIGO diff --git a/gitlab-pages/docs/language-basics/maps-records.md b/gitlab-pages/docs/language-basics/maps-records.md index c9837fb26..fda74b822 100644 --- a/gitlab-pages/docs/language-basics/maps-records.md +++ b/gitlab-pages/docs/language-basics/maps-records.md @@ -697,7 +697,7 @@ function fold_op (const m : register) : int is ```cameligo group=maps -let fold_op (m : register) : register = +let fold_op (m : register) : int = let folded = fun (i,j : int * (address * move)) -> i + j.1.1 in Map.fold folded m 5 ``` @@ -705,7 +705,7 @@ let fold_op (m : register) : register = ```reasonligo group=maps -let fold_op = (m : register) : register => { +let fold_op = (m : register) : int => { let folded = ((i,j): (int, (address, move))) => i + j[1][1]; Map.fold (folded, m, 5); }; diff --git a/gitlab-pages/docs/reference/map.md b/gitlab-pages/docs/reference/map.md index df3ecbb31..529de3edf 100644 --- a/gitlab-pages/docs/reference/map.md +++ b/gitlab-pages/docs/reference/map.md @@ -341,14 +341,14 @@ function fold_op (const m : register) : int is ```cameligo group=maps -let fold_op (m : register) : register = +let fold_op (m : register) : int = let folded = fun (i,j : int * (address * move)) -> i + j.1.1 in Map.fold folded m 5 ``` ```reasonligo group=maps -let fold_op = (m : register) : register => { +let fold_op = (m : register) : int => { let folded = ((i,j): (int, (address, move))) => i + j[1][1]; Map.fold (folded, m, 5); }; diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index 1680caf96..d9f516ae8 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -156,6 +156,14 @@ let rec pattern_to_var : Raw.pattern -> _ = fun p -> | Raw.PWild r -> ok @@ ({ region = r ; value = "_" } : Raw.variable) | _ -> fail @@ wrong_pattern "single var" p +let rec tuple_pattern_to_vars : Raw.pattern -> _ = fun pattern -> + match pattern with + | Raw.PPar pp -> tuple_pattern_to_vars pp.value.inside + | Raw.PTuple pt -> bind_map_list pattern_to_var (npseq_to_list pt.value) + | Raw.PVar _ | Raw.PWild _-> bind_list [pattern_to_var pattern] + | other -> (fail @@ wrong_pattern "parenthetical, tuple, or variable" other) + + let rec pattern_to_typed_var : Raw.pattern -> _ = fun p -> match p with | Raw.PPar p -> pattern_to_typed_var p.value.inside @@ -180,11 +188,21 @@ let rec tuple_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern -> | Raw.PVar _ -> bind_list [pattern_to_typed_var pattern] | other -> (fail @@ wrong_pattern "parenthetical, tuple, or variable" other) -let rec unpar_pattern : Raw.pattern -> Raw.pattern = function +let rec typed_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern -> + match pattern with + | Raw.PPar pp -> typed_pattern_to_typed_vars pp.value.inside + | Raw.PTyped pt -> + let (p,t) = pt.value.pattern,pt.value.type_expr in + let%bind p = tuple_pattern_to_vars p in + let%bind t = simpl_type_expression t in + ok @@ (p,t) + | other -> (fail @@ wrong_pattern "parenthetical or type annotation" other) + +and unpar_pattern : Raw.pattern -> Raw.pattern = function | PPar p -> unpar_pattern p.value.inside | _ as p -> p -let rec simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> +and simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> trace (simple_info "simplifying this type expression...") @@ match te with TPar x -> simpl_type_expression x.value.inside @@ -793,10 +811,9 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result let%bind var = pattern_to_var hd in ok (var , tl) in + let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in match args with | [] -> - let%bind lhs_type' = - bind_map_option (fun (_,te) -> simpl_type_expression te) lhs_type in let%bind rhs' = simpl_expression let_rhs in ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type' , inline, rhs'))] | param1::others -> @@ -809,7 +826,10 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result } in let rhs = Raw.EFun {region=Region.ghost ; value=fun_} in let%bind rhs' = simpl_expression rhs in - ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , None , inline, rhs'))] + let%bind ty = bind_map_list typed_pattern_to_typed_vars args in + let aux acc ty = Option.map (t_function (snd ty)) acc in + let func_type = List.fold_right' aux lhs_type' ty in + ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , func_type , inline, rhs'))] ) and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content result = diff --git a/src/test/contracts/failwith.mligo b/src/test/contracts/failwith.mligo index fbc5976bd..b2f7411da 100644 --- a/src/test/contracts/failwith.mligo +++ b/src/test/contracts/failwith.mligo @@ -1,4 +1,4 @@ type storage = unit -let main (p: unit) storage = +let main (p: unit) (s:storage) = if true then failwith "This contract always fails" else () diff --git a/src/test/contracts/let_in_multi_bind.mligo b/src/test/contracts/let_in_multi_bind.mligo index e61dc14a7..f6e11b035 100644 --- a/src/test/contracts/let_in_multi_bind.mligo +++ b/src/test/contracts/let_in_multi_bind.mligo @@ -1,5 +1,5 @@ let sum (p: int * int) : int = let i, result = p in i + result -let sum2 (p: string * string * string * string) : int = +let sum2 (p: string * string * string * string) : string = let a, b, c, d = p in a ^ b ^ c ^ d diff --git a/src/test/contracts/map.mligo b/src/test/contracts/map.mligo index 7b13f406c..5ad4246f7 100644 --- a/src/test/contracts/map.mligo +++ b/src/test/contracts/map.mligo @@ -42,8 +42,8 @@ let map_op (m : foobar) : foobar = 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 * (int * int)) -> i.0 + i.1.0 + i.1.1 +let fold_op (m : foobar) : int = + let aggregate = fun (i,m: int * (int * int)) -> i + m.0 + m.1 in Map.fold aggregate m 10 let deep_op (m: foobar) : foobar = diff --git a/src/test/contracts/negative/self_in_lambda.mligo b/src/test/contracts/negative/self_in_lambda.mligo index 493047199..9595b752d 100644 --- a/src/test/contracts/negative/self_in_lambda.mligo +++ b/src/test/contracts/negative/self_in_lambda.mligo @@ -1,5 +1,5 @@ let foo (u: unit) : address = Current.self_address -let main (ps: unit * address): (operation list * address) = - ( ([] : operation list) , foo) \ No newline at end of file +let main (ps: unit * address): (operation list * (unit -> address)) = + ( ([] : operation list) , foo) diff --git a/src/test/contracts/set_arithmetic.mligo b/src/test/contracts/set_arithmetic.mligo index 2713905b3..0eff261f7 100644 --- a/src/test/contracts/set_arithmetic.mligo +++ b/src/test/contracts/set_arithmetic.mligo @@ -9,7 +9,7 @@ let add_op (s : string set) : string set = let remove_op (s : string set) : string set = Set.remove "foobar" s -let remove_deep (s : string set * nat) : string set * nat = +let remove_deep (s : string set * nat) : string set = Set.remove "foobar" s.0 (*