From 961a93ae83fd9b482c6da50c024090e36511dd3a Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Fri, 5 Jul 2024 17:04:45 +0200 Subject: [PATCH] Small printer fix --- compiler/shared_ast/boundList.ml | 7 +++++++ compiler/shared_ast/boundList.mli | 1 + compiler/shared_ast/print.ml | 8 ++++++-- tests/func/good/closure_conversion.catala_en | 1 + tests/func/good/closure_return.catala_en | 1 + tests/func/good/scope_call_func_struct_closure.catala_en | 6 ++++++ 6 files changed, 22 insertions(+), 2 deletions(-) diff --git a/compiler/shared_ast/boundList.ml b/compiler/shared_ast/boundList.ml index faeba5de..ac08591f 100644 --- a/compiler/shared_ast/boundList.ml +++ b/compiler/shared_ast/boundList.ml @@ -20,6 +20,13 @@ type ('e, 'elt, 'last) t = ('e, 'elt, 'last) bound_list = | Last of 'last | Cons of 'elt * ('e, ('e, 'elt, 'last) t) binder +let rec to_seq = function + | Last () -> Seq.empty + | Cons (item, next_bind) -> + fun () -> + let v, next = Bindlib.unbind next_bind in + Seq.Cons ((v, item), to_seq next) + let rec last = function | Last e -> e | Cons (_, bnd) -> diff --git a/compiler/shared_ast/boundList.mli b/compiler/shared_ast/boundList.mli index 33089802..2bd1c524 100644 --- a/compiler/shared_ast/boundList.mli +++ b/compiler/shared_ast/boundList.mli @@ -30,6 +30,7 @@ type ('e, 'elt, 'last) t = ('e, 'elt, 'last) bound_list = | Last of 'last | Cons of 'elt * ('e, ('e, 'elt, 'last) t) binder +val to_seq : (((_, _) gexpr as 'e), 'elt, unit) t -> ('e Var.t * 'elt) Seq.t val last : (_, _, 'a) t -> 'a val iter : f:('e Var.t -> 'elt -> unit) -> ('e, 'elt, 'last) t -> 'last val find : f:('elt -> 'a option) -> (_, 'elt, _) t -> 'a diff --git a/compiler/shared_ast/print.ml b/compiler/shared_ast/print.ml index 3a78aa08..e894aa7d 100644 --- a/compiler/shared_ast/print.ml +++ b/compiler/shared_ast/print.ml @@ -920,11 +920,15 @@ let code_item ?(debug = false) ?name decl_ctx fmt c = "=" (expr ~debug ()) e let code_item_list ?(debug = false) decl_ctx fmt c = - BoundList.iter c ~f:(fun x item -> + Format.pp_open_vbox fmt 0; + Format.pp_print_seq + (fun fmt (x, item) -> code_item ~debug ~name:(Format.asprintf "%a" var_debug x) decl_ctx fmt item; - Format.pp_print_newline fmt ()) + Format.pp_print_cut fmt ()) + fmt (BoundList.to_seq c); + Format.pp_close_box fmt () let program ?(debug = false) fmt p = decl_ctx ~debug p.decl_ctx fmt p.decl_ctx; diff --git a/tests/func/good/closure_conversion.catala_en b/tests/func/good/closure_conversion.catala_en index 6c657d70..7912a943 100644 --- a/tests/func/good/closure_conversion.catala_en +++ b/tests/func/good/closure_conversion.catala_en @@ -33,6 +33,7 @@ type S = { z: integer; } let topval closure_f1 : (closure_env, integer) → integer = λ (env: closure_env) (y: integer) → if (from_closure_env env).0 then y else - y + let scope S (S_in: S_in {x_in: bool}): S {z: integer} = let get x : bool = S_in.x_in in let set f : ((closure_env, integer) → integer, closure_env) = diff --git a/tests/func/good/closure_return.catala_en b/tests/func/good/closure_return.catala_en index 12b85c75..ec705043 100644 --- a/tests/func/good/closure_return.catala_en +++ b/tests/func/good/closure_return.catala_en @@ -31,6 +31,7 @@ type S = { f: ((closure_env, integer) → integer, closure_env); } let topval closure_f1 : (closure_env, integer) → integer = λ (env: closure_env) (y: integer) → if (from_closure_env env).0 then y else - y + let scope S (S_in: S_in {x_in: bool}) : S {f: ((closure_env, integer) → integer, closure_env)} diff --git a/tests/func/good/scope_call_func_struct_closure.catala_en b/tests/func/good/scope_call_func_struct_closure.catala_en index 67619876..640c66df 100644 --- a/tests/func/good/scope_call_func_struct_closure.catala_en +++ b/tests/func/good/scope_call_func_struct_closure.catala_en @@ -76,6 +76,7 @@ type Foo = { z: integer; } let topval closure_y1 : (closure_env, integer) → integer = λ (env: closure_env) (z: integer) → (from_closure_env env).0 + z + let scope SubFoo1 (SubFoo1_in: SubFoo1_in {x_in: integer}) : SubFoo1 { @@ -88,10 +89,12 @@ let scope SubFoo1 (closure_y1, to_closure_env (x)) in return { SubFoo1 x = x; y = y; } + let topval closure_y1 : (closure_env, integer) → integer = λ (env: closure_env) (z: integer) → let env1 : (integer, integer) = from_closure_env env in ((env1.1 + env1.0 + z)) + let scope SubFoo2 (SubFoo2_in: SubFoo2_in {x1_in: integer; x2_in: integer}) : SubFoo2 { @@ -105,18 +108,21 @@ let scope SubFoo2 (closure_y1, to_closure_env (x2, x1)) in return { SubFoo2 x1 = x1; y = y; } + let topval closure_r2 : (closure_env, integer) → integer = λ (env: closure_env) (param0: integer) → let code_and_env : ((closure_env, integer) → integer, closure_env) = (from_closure_env env).0.y in code_and_env.0 code_and_env.1 param0 + let topval closure_r1 : (closure_env, integer) → integer = λ (env: closure_env) (param0: integer) → let code_and_env : ((closure_env, integer) → integer, closure_env) = (from_closure_env env).0.y in code_and_env.0 code_and_env.1 param0 + let scope Foo (Foo_in: Foo_in {b_in: ((closure_env, unit) → option bool, closure_env)}) : Foo {z: integer}