From 4e333836cbcf1854b5356a98fc0221bb8794844c Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Thu, 3 Oct 2019 15:36:06 +0200 Subject: [PATCH] ignore closure error in subexpression of argument --- src/passes/6-transpiler/transpiler.ml | 19 ++++--- src/passes/7-self_mini_c/helpers.ml | 69 +++++++++++++++++++++++- src/test/contracts/high-order.ligo | 14 ++++- src/test/integration_tests.ml | 1 + vendors/ligo-utils/simple-utils/trace.ml | 14 +++++ 5 files changed, 108 insertions(+), 9 deletions(-) diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index b8017f6b8..9427ed5bd 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -283,13 +283,18 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re | E_application (a, b) -> let%bind a = transpile_annotated_expression a in let%bind b = transpile_annotated_expression b in - let%bind b' = Self_mini_c.Helpers.map_expression - (fun exp -> - match exp.type_value with - | T_deep_closure _ -> fail @@ simple_error "Cannot apply closure in function argument" - | _ -> ok exp - ) b in - return @@ E_application (a, b') + let%bind _err = Self_mini_c.Helpers.fold_expression + (fun sub_arg exp -> + match (exp.type_value , exp.content) with + | T_pair _ , _ -> ok false + | T_base _ , E_application _ -> ok true + | (T_deep_closure _), _ -> + let errmsg = Format.asprintf "Cannot apply closure in function arguments: %a\n" + Mini_c.PP.expression_with_type b in + if sub_arg then ok sub_arg else fail @@ simple_error errmsg + | _,_ -> ok sub_arg + ) false b in + return @@ E_application (a, b) | E_constructor (m, param) -> ( let%bind param' = transpile_annotated_expression param in let (param'_expr , param'_tv) = Combinators.Expression.(get_content param' , get_type param') in diff --git a/src/passes/7-self_mini_c/helpers.ml b/src/passes/7-self_mini_c/helpers.ml index f0d11ff80..c7553f908 100644 --- a/src/passes/7-self_mini_c/helpers.ml +++ b/src/passes/7-self_mini_c/helpers.ml @@ -1,8 +1,75 @@ open Mini_c open Trace +type 'a folder = 'a -> expression -> 'a result +let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f init e -> + let self = fold_expression f in + let%bind init' = f init e in + match e.content with + | E_variable _ | E_skip | E_make_none _ + | E_make_empty_map (_,_) | E_make_empty_list _ + | E_make_empty_set _ -> ( + ok init' + ) + | E_literal v -> ( + match v with + | D_function an -> self init' an.body + | _ -> ok init' + ) + | E_constant (_, lst) -> ( + let%bind res = bind_fold_list self init' lst in + ok res + ) + | E_closure af -> ( + let%bind res = self init' af.body in + ok res + ) + | E_application farg -> ( + let%bind res = bind_fold_pair self init' farg in + ok res + ) + | E_iterator (_, ((_ , _) , body) , exp) -> ( + let%bind res = bind_fold_pair self init' (exp,body) in + ok res + ) + | E_fold (((_ , _) , body) , col , init) -> ( + let%bind res = bind_fold_triple self init' (body,col,init) in + ok res + ) + | E_while eb -> ( + let%bind res = bind_fold_pair self init' eb in + ok res + ) + | E_if_bool cab -> ( + let%bind res = bind_fold_triple self init' cab in + ok res + ) + | E_if_none (c, n, ((_, _) , s)) -> ( + let%bind res = bind_fold_triple self init' (c,n,s) in + ok res + ) + | E_if_cons (c, n, (((_, _) , (_, _)) , cons)) -> ( + let%bind res = bind_fold_triple self init' (c,n,cons) in + ok res + ) + | E_if_left (c, ((_, _) , l), ((_, _) , r)) -> ( + let%bind res = bind_fold_triple self init' (c,l,r) in + ok res + ) + | E_let_in ((_, _) , expr , body) -> ( + let%bind res = bind_fold_pair self init' (expr,body) in + ok res + ) + | E_sequence ab -> ( + let%bind res = bind_fold_pair self init' ab in + ok res + ) + | E_assignment (_, _, exp) -> ( + let%bind res = self init' exp in + ok res + ) + type mapper = expression -> expression result -(* fold ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a *) let rec map_expression : mapper -> expression -> expression result = fun f e -> let self = map_expression f in diff --git a/src/test/contracts/high-order.ligo b/src/test/contracts/high-order.ligo index 9408fd36a..d3c83170a 100644 --- a/src/test/contracts/high-order.ligo +++ b/src/test/contracts/high-order.ligo @@ -22,4 +22,16 @@ function foobar2 (const i : int) : int is // function foobar3 (const i : int) : int is // function foo2 (const i : int) : int is // block { skip } with (a+i); -// block { skip } with higher2(i,foo2) \ No newline at end of file +// block { skip } with higher2(i,foo2) + +function f (const i : int) : int is + block { skip } + with i + +function g (const i : int) : int is + block { skip } + with f(i) + +function foobar4 (const i : int) : int is + block { skip } + with g(g(i)) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index f5b4a7aad..16a4c7d69 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -115,6 +115,7 @@ let higher_order () : unit result = let%bind _ = expect_eq_n_int program "foobar2" make_expect in (* not supported yet: let%bind _ = expect_eq_n_int program "foobar3" make_expect in *) + let%bind _ = expect_eq_n_int program "foobar4" make_expect in ok () let shared_function () : unit result = diff --git a/vendors/ligo-utils/simple-utils/trace.ml b/vendors/ligo-utils/simple-utils/trace.ml index 482ed6e86..54f69246e 100644 --- a/vendors/ligo-utils/simple-utils/trace.ml +++ b/vendors/ligo-utils/simple-utils/trace.ml @@ -592,6 +592,20 @@ let bind_fold_list f init lst = in List.fold_left aux (ok init) lst +let bind_fold_pair f init (a,b) = + let aux x y = + x >>? fun x -> + f x y + in + List.fold_left aux (ok init) [a;b] + +let bind_fold_triple f init (a,b,c) = + let aux x y = + x >>? fun x -> + f x y + in + List.fold_left aux (ok init) [a;b;c] + let bind_fold_map_list = fun f acc lst -> let rec aux (acc , prev) f = function | [] -> ok (acc , prev)