From 558f3f5e80b11d4cee6be137acd52aca71a1163e Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Sat, 7 Mar 2020 02:00:29 +0100 Subject: [PATCH 1/2] fix annotation for funciton in ReasonLigo --- src/passes/1-parser/reasonligo/Parser.mly | 6 ++++- src/passes/2-simplify/cameligo.ml | 27 +++++++++++------------ 2 files changed, 18 insertions(+), 15 deletions(-) diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index defde2e55..d24e3f832 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -558,9 +558,13 @@ fun_expr: in raise (Error (WrongFunctionArguments e)) in let binders = fun_args_to_pattern $1 in + let lhs_type = match $1 with + EAnnot {value = {inside = _ , _, t; _}; region = r} -> Some (r,t) + | _ -> None + in let f = {kwd_fun; binders; - lhs_type=None; + lhs_type; arrow; body } diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index 910da246f..03cdc6344 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -176,11 +176,6 @@ let rec pattern_to_typed_var : Raw.pattern -> _ = fun p -> | Raw.PWild r -> ok (({ region = r ; value = "_" } : Raw.variable) , None) | _ -> fail @@ wrong_pattern "single typed variable" p -let rec expr_to_typed_expr : Raw.expr -> _ = function - EPar e -> expr_to_typed_expr e.value.inside -| EAnnot {value={inside=e,_,t; _}; _} -> ok (e, Some t) -| e -> ok (e , None) - let rec tuple_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern -> match pattern with | Raw.PPar pp -> tuple_pattern_to_typed_vars pp.value.inside @@ -646,9 +641,8 @@ and simpl_fun lamb' : expr result = | _ -> 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 + bind_map_option (fun x -> simpl_type_expression @@ snd x) lamb.lhs_type in let%bind body = simpl_expression body in let rec layer_arguments (arguments: (Raw.variable * type_expression) list) = match arguments with @@ -811,9 +805,8 @@ 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 - let%bind let_rhs,lhs_type = match args with - | [] -> ok (let_rhs, lhs_type') + let%bind let_rhs = match args with + | [] -> ok (let_rhs) | param1::others -> let fun_ = { kwd_fun = Region.ghost; @@ -822,12 +815,18 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result arrow = Region.ghost; body = let_rhs } in - let f_args = nseq_to_list (param1,others) in - let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in - let aux acc ty = Option.map (t_function (snd ty)) acc in - ok (Raw.EFun {region=Region.ghost ; value=fun_},List.fold_right' aux lhs_type' ty) + ok (Raw.EFun {region=Region.ghost ; value=fun_}) in let%bind rhs' = simpl_expression let_rhs in + let%bind lhs_type = match let_rhs with + | Raw.EFun {value={binders;lhs_type};_} -> + let f_args = nseq_to_list (binders) in + let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in + let aux acc ty = Option.map (t_function (snd ty)) acc in + let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in + ok @@ List.fold_right' aux lhs_type' ty + | _ -> bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type + in ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))] ) From 49625001b15f1b8520fe7b12352c3d39fce7d00b Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Sat, 7 Mar 2020 02:39:39 +0100 Subject: [PATCH 2/2] Fix simplifyer and test --- .../docs/advanced/entrypoints-contracts.md | 3 +- src/passes/2-simplify/cameligo.ml | 35 +++++++++++++------ src/test/contracts/balance_constant.religo | 2 +- src/test/contracts/set_arithmetic.religo | 4 +-- 4 files changed, 28 insertions(+), 16 deletions(-) diff --git a/gitlab-pages/docs/advanced/entrypoints-contracts.md b/gitlab-pages/docs/advanced/entrypoints-contracts.md index 499d07c58..c2232e494 100644 --- a/gitlab-pages/docs/advanced/entrypoints-contracts.md +++ b/gitlab-pages/docs/advanced/entrypoints-contracts.md @@ -310,7 +310,7 @@ let main (action, store: parameter * storage) : return = ```reasonligo group=c let owner : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address); -let main = ((action, store) : (parameter, storage)) : storage => { +let main = ((action, store) : (parameter, storage)) : return => { if (Tezos.source != owner) { (failwith ("Access denied.") : return); } else { (([] : list (operation)), store); }; }; @@ -478,4 +478,3 @@ let proxy = ((action, store): (parameter, storage)) : return => { > *deprecated*. - diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index 03cdc6344..569df20b3 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -176,6 +176,11 @@ let rec pattern_to_typed_var : Raw.pattern -> _ = fun p -> | Raw.PWild r -> ok (({ region = r ; value = "_" } : Raw.variable) , None) | _ -> fail @@ wrong_pattern "single typed variable" p +let rec expr_to_typed_expr : Raw.expr -> _ = function + EPar e -> expr_to_typed_expr e.value.inside +| EAnnot {value={inside=e,_,t; _}; _} -> ok (e, Some t) +| e -> ok (e , None) + let rec tuple_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern -> match pattern with | Raw.PPar pp -> tuple_pattern_to_typed_vars pp.value.inside @@ -641,8 +646,9 @@ and simpl_fun lamb' : expr result = | _ -> 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 (fun x -> simpl_type_expression @@ snd x) lamb.lhs_type in + 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 @@ -805,8 +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 let_rhs = match args with - | [] -> ok (let_rhs) + let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in + let%bind let_rhs,lhs_type = match args with + | [] -> ok (let_rhs, lhs_type') | param1::others -> let fun_ = { kwd_fun = Region.ghost; @@ -815,17 +822,23 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result arrow = Region.ghost; body = let_rhs } in - ok (Raw.EFun {region=Region.ghost ; value=fun_}) - in - let%bind rhs' = simpl_expression let_rhs in - let%bind lhs_type = match let_rhs with - | Raw.EFun {value={binders;lhs_type};_} -> - let f_args = nseq_to_list (binders) in + let f_args = nseq_to_list (param1,others) in let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in let aux acc ty = Option.map (t_function (snd ty)) acc in + ok (Raw.EFun {region=Region.ghost ; value=fun_},List.fold_right' aux lhs_type' ty) + in + let%bind rhs' = simpl_expression let_rhs in + let%bind lhs_type = match lhs_type with + | None -> (match let_rhs with + | EFun {value={binders;lhs_type}} -> + let f_args = nseq_to_list (binders) in let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in - ok @@ List.fold_right' aux lhs_type' ty - | _ -> bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type + let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in + let aux acc ty = Option.map (t_function (snd ty)) acc in + ok @@ (List.fold_right' aux lhs_type' ty) + | _ -> ok None + ) + | Some t -> ok @@ Some t in ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))] ) diff --git a/src/test/contracts/balance_constant.religo b/src/test/contracts/balance_constant.religo index 1d136052b..33c1fd725 100644 --- a/src/test/contracts/balance_constant.religo +++ b/src/test/contracts/balance_constant.religo @@ -12,7 +12,7 @@ generated. unrecognized constant: {"constant":"BALANCE","location":"generated"} type storage = tez; -let main2 = (p : unit, storage) => +let main2 = (p : unit, s: storage) => ([]: list (operation), Tezos.balance); let main = (x : (unit, storage)) => main2 (x[0], x[1]); diff --git a/src/test/contracts/set_arithmetic.religo b/src/test/contracts/set_arithmetic.religo index a219fba9b..ed8f7a075 100644 --- a/src/test/contracts/set_arithmetic.religo +++ b/src/test/contracts/set_arithmetic.religo @@ -6,10 +6,10 @@ let literal_op = (p: unit) : set (string) => let add_op = (s: set (string)) : set (string) => Set.add ("foobar", s); -let remove_op = (s: set (string)) : set(string) => +let remove_op = (s: set (string)) : set (string) => Set.remove ("foobar", s); -let remove_deep = (s: (set (string), nat)): (set (string), nat) => +let remove_deep = (s: (set (string), nat)): set (string) => Set.remove ("foobar", s[0]); let mem_op = (s: set (string)) : bool =>