mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-19 16:28:12 +03:00
Better type translation in closure conversion
This commit is contained in:
parent
50a9e15906
commit
9358ad945e
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user