CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-09-19 00:15:39 +03:00
Code Issues Projects Releases Wiki Activity

Better type translation in closure conversion

Browse Source
This commit is contained in:
Denis Merigoux 2023-12-18 15:45:25 +01:00
parent 50a9e15906
commit 9358ad945e
No known key found for this signature in database
GPG Key ID: EE99DCFA365C3EE3
2 changed files with 22 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
compiler/lcalc/closure_conversion.ml
View File

@ -385,25 +385,23 @@ let transform_closures_program (p : 'm program) : 'm program Bindlib.box =
capture footprint. See
[tests/tests_func/good/scope_call_func_struct_closure.catala_en]. *)
let new_decl_ctx =
let rec type_contains_arrow t =
let rec replace_fun_typs t =
match Mark.remove t with
| TArrow _ -> true
| TAny -> true
| TDefault t' | TOption t' -> type_contains_arrow t'
| TClosureEnv | TLit _ -> false
| TArray ts -> type_contains_arrow ts
| TTuple ts -> List.exists type_contains_arrow ts
| TEnum e ->
EnumConstructor.Map.exists
(fun _ t' -> type_contains_arrow t')
(EnumName.Map.find e p.decl_ctx.ctx_enums)
| TStruct s ->
StructField.Map.exists
(fun _ t' -> type_contains_arrow t')
(StructName.Map.find s p.decl_ctx.ctx_structs)
in
let replace_fun_typs t =
if type_contains_arrow t then Mark.copy t TAny else t
| TArrow (t1, t2) ->
( TTuple
[
( TArrow
( (TClosureEnv, Pos.no_pos) :: List.map replace_fun_typs t1,
replace_fun_typs t2 ),
Pos.no_pos );
TClosureEnv, Pos.no_pos;
],
Mark.get t )
| TDefault t' -> TDefault (replace_fun_typs t'), Mark.get t
| TOption t' -> TOption (replace_fun_typs t'), Mark.get t
| TAny | TClosureEnv | TLit _ | TEnum _ | TStruct _ -> t
| TArray ts -> TArray (replace_fun_typs ts), Mark.get t
| TTuple ts -> TTuple (List.map replace_fun_typs ts), Mark.get t
in
{
p.decl_ctx with

9
tests/test_func/good/scope_call_func_struct_closure.catala_en
View File

@ -88,7 +88,7 @@ type SubFoo2 = {
y: ((closure_env, integer) → integer * closure_env);
}
type Foo_in = { b_in: ((any, unit) → eoption bool * any); }
type Foo_in = { b_in: ((closure_env, unit) → eoption bool * closure_env); }
type Foo = { z: integer; }
@ -137,10 +137,13 @@ let topval closure_r : (closure_env, integer) → integer =
in
code_and_env.0 code_and_env.1 param0
let scope Foo
(Foo_in: Foo_in {b_in: ((any, unit) → eoption bool * any)})
(Foo_in:
Foo_in {b_in: ((closure_env, unit) → eoption bool * closure_env)})
: Foo {z: integer}
=
let get b : ((any, unit) → eoption bool * any) = Foo_in.b_in in
let get b : ((closure_env, unit) → eoption bool * closure_env) =
Foo_in.b_in
in
let set b : bool =
match
(handle_default_opt