ignore closure error in subexpression of argument

This commit is contained in:
Lesenechal Remi 2019-10-03 15:36:06 +02:00
parent 962a98da75
commit 4e333836cb
5 changed files with 108 additions and 9 deletions

View File

@ -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

View File

@ -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

View File

@ -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)
// 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))

View File

@ -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 =

View File

@ -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)