Apply suggestions by @altgr

This commit is contained in:
Denis Merigoux 2023-06-19 17:29:51 +02:00
parent 10cd3b0fc8
commit 9007eb4204
No known key found for this signature in database
GPG Key ID: EE99DCFA365C3EE3
4 changed files with 22 additions and 21 deletions

View File

@ -10,8 +10,6 @@ RUN sudo apk add python3
RUN sudo ln -s /usr/bin/python3 /usr/bin/python
RUN sudo apk add g++
RUN sudo apk add make
# We also need bash to build JaneStreet's base
RUN sudo apk add bash
RUN mkdir catala
WORKDIR catala

View File

@ -75,7 +75,7 @@ let print_time_marker =
time := new_time;
let delta = (new_time -. old_time) *. 1000. in
if delta > 50. then
Format.fprintf ppf "@{<bold;black>[TIME] %.0fms@}@\n" delta
Format.fprintf ppf "@{<bold;black>[TIME] %.0fms@}@ " delta
let pp_marker target ppf =
let open Ocolor_types in
@ -108,7 +108,7 @@ module Content = struct
let internal_error_prefix =
"Internal Error, please report to \
https://github.com/CatalaLang/catala/issues: "
https://github.com/CatalaLang/catala/issues : "
let prepend_message (content : t) prefix : t =
{

View File

@ -166,10 +166,11 @@ let rec transform_closures_expr :
as f;
args;
} ->
(* Special case for some operators: its arguments closures thunks because if
you want to extract it as a function you need these closures to preserve
evaluation order, but backends that don't support closures will simply
extract these operators in a inlined way and skip the thunks. *)
(* Special case for some operators: its arguments shall remain thunks (which
are closures) because if you want to extract it as a function you need
these closures to preserve evaluation order, but backends that don't
support closures will simply extract these operators in a inlined way and
skip the thunks. *)
let free_vars, new_args =
List.fold_right
(fun (arg : (lcalc, m) gexpr) (free_vars, new_args) ->
@ -308,15 +309,17 @@ let transform_closures_program (p : 'm program) : 'm program Bindlib.box =
in
(* Now we need to further tweak [decl_ctx] because some of the user-defined
types can have closures in them and these closured might have changed type.
So we reset them to [TAny] in the hopes that the transformation applied
will not yield to type unification conflicts. Indeed, consider the
following closure: [let f = if ... then fun v -> x + v else fun v -> v]. To
be typed correctly once converted, this closure needs an existential type
but the Catala typechecker doesn't have them. However, this kind of type
conflict is difficult to produce using the Catala surface language: it can
only happen if you store a closure which is the output of a scope inside a
user-defined data structure, and if you do it in two different places in
the code with two closures that don't have the same capture footprint. *)
So we reset them to [TAny] and leave the typechecker to figure it out. This
will not yield any type unification conflicts because of the special type
[TClosureEnv]. Indeed, consider the following closure: [let f = if ... then
fun v -> x + v else fun v -> v]. To be typed correctly once converted, this
closure needs an existential type, this is what [TClosureEnv] is for. This
kind of situation is difficult to produce using the Catala surface
language: it can only happen if you store a closure which is the output of
a scope inside a user-defined data structure, and if you do it in two
different places in the code with two closures that don't have the same
capture footprint. See
[tests/tests_func/good/scope_call_func_struct_closure.catala_en]. *)
let new_decl_ctx =
let rec type_contains_arrow t =
match Mark.remove t with
@ -463,7 +466,6 @@ let rec hoist_closures_expr :
| EVar _ ->
Expr.map_gather ~acc:[] ~join:( @ ) ~f:(hoist_closures_expr name_context) e
| _ -> .
[@@warning "-32"]
(* Here I have to reimplement Scope.map_exprs_in_lets because I'm changing the
type *)

View File

@ -233,9 +233,10 @@ let handle_type_error ctx (A.AnyExpr e) t1 t2 =
(format_typ ctx) t2),
t2_pos );
]
"@[<v>Error during typechecking, incompatible types:@]@\n\
@[<v>@{<bold;blue>@} @[<hov>%a@]@,\
@{<bold;blue>@} @[<hov>%a@]@]" (format_typ ctx) t1 (format_typ ctx) t2
"Error during typechecking, incompatible types:@,\
@[<v>@{<bold;blue>@<3>%s@} @[<hov>%a@]@,\
@{<bold;blue>@<3>%s@} @[<hov>%a@]@]" "" (format_typ ctx) t1 ""
(format_typ ctx) t2
let lit_type (lit : A.lit) : naked_typ =
match lit with