ignore closure error in subexpression of argument
This commit is contained in:
parent
962a98da75
commit
4e333836cb
@ -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
|
||||
|
@ -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
|
||||
|
@ -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))
|
||||
|
@ -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 =
|
||||
|
14
vendors/ligo-utils/simple-utils/trace.ml
vendored
14
vendors/ligo-utils/simple-utils/trace.ml
vendored
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user