Only look at arg.type_value instead of arg.content

This commit is contained in:
Lesenechal Remi 2019-10-03 18:35:11 +02:00
parent 4e333836cb
commit c1845c2bfe
2 changed files with 36 additions and 13 deletions

View File

@ -283,18 +283,21 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
| E_application (a, b) -> | E_application (a, b) ->
let%bind a = transpile_annotated_expression a in let%bind a = transpile_annotated_expression a in
let%bind b = transpile_annotated_expression b in let%bind b = transpile_annotated_expression b in
let%bind _err = Self_mini_c.Helpers.fold_expression let%bind contains_closure =
(fun sub_arg exp -> Self_mini_c.Helpers.fold_type_value
match (exp.type_value , exp.content) with (fun contains_closure exp ->
| T_pair _ , _ -> ok false ok (contains_closure
| T_base _ , E_application _ -> ok true || match exp with
| (T_deep_closure _), _ -> | 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" let errmsg = Format.asprintf "Cannot apply closure in function arguments: %a\n"
Mini_c.PP.expression_with_type b in Mini_c.PP.expression_with_type b in
if sub_arg then ok sub_arg else fail @@ simple_error errmsg fail @@ simple_error errmsg
| _,_ -> ok sub_arg else return @@ E_application (a, b)
) false b in
return @@ E_application (a, b)
| E_constructor (m, param) -> ( | E_constructor (m, param) -> (
let%bind param' = transpile_annotated_expression param in let%bind param' = transpile_annotated_expression param in
let (param'_expr , param'_tv) = Combinators.Expression.(get_content param' , get_type param') in let (param'_expr , param'_tv) = Combinators.Expression.(get_content param' , get_type param') in

View File

@ -1,6 +1,26 @@
open Mini_c open Mini_c
open Trace 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 type 'a folder = 'a -> expression -> 'a result
let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f init e -> let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f init e ->
let self = fold_expression f in let self = fold_expression f in