diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index 9427ed5bd..0cef7b26b 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -283,18 +283,21 @@ 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 _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) + let%bind contains_closure = + Self_mini_c.Helpers.fold_type_value + (fun contains_closure exp -> + ok (contains_closure + || match exp with + | T_deep_closure _ -> true + | _ -> false)) + false + b.type_value in + if contains_closure + then + let errmsg = Format.asprintf "Cannot apply closure in function arguments: %a\n" + Mini_c.PP.expression_with_type b in + fail @@ simple_error errmsg + else 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 c7553f908..9904a8083 100644 --- a/src/passes/7-self_mini_c/helpers.ml +++ b/src/passes/7-self_mini_c/helpers.ml @@ -1,6 +1,26 @@ open Mini_c open Trace +let rec fold_type_value : ('a -> type_value -> 'a result) -> 'a -> type_value -> 'a result = fun f init t -> + let self = fold_type_value f in + let%bind init' = f init t in + match t with + | T_pair ((_, a), (_, b)) + | T_or ((_, a), (_, b)) + | T_function (a, b) + | T_map (a, b) + | T_big_map (a, b) -> + bind_fold_pair self init' (a, b) + | T_deep_closure (env, a, b) -> + bind_fold_list self init' (List.map snd env @ [a; b]) + | T_list a + | T_set a + | T_contract a + | T_option a -> + self init' a + | T_base _ -> + ok init' + 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 @@ -137,4 +157,4 @@ let rec map_expression : mapper -> expression -> expression result = fun f e -> | E_assignment (s, lrl, exp) -> ( let%bind exp' = self exp in return @@ E_assignment (s, lrl, exp') - ) \ No newline at end of file + )