Skip to content

Commit

Permalink
separate forced/unforced lazy functions
Browse files Browse the repository at this point in the history
  • Loading branch information
Simn committed Dec 12, 2024
1 parent 7315c8e commit 4f076e4
Show file tree
Hide file tree
Showing 3 changed files with 21 additions and 17 deletions.
14 changes: 14 additions & 0 deletions src/context/common.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1143,3 +1143,17 @@ let get_entry_point com =
let e = Option.get com.main.main_expr in (* must be present at this point *)
(snd path, c, e)
) com.main.main_class

let make_unforced_lazy t_proc f where =
let r = ref (lazy_available t_dynamic) in
r := lazy_wait (fun() ->
try
r := lazy_processing t_proc;
let t = f () in
r := lazy_available t;
t
with
| Error.Error e ->
raise (Error.Fatal_error e)
);
r
20 changes: 5 additions & 15 deletions src/context/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -503,19 +503,9 @@ let make_pass ctx f = f
let enter_field_typing_pass g info =
flush_pass g PConnectField info

let make_lazy ?(force=true) ctx t_proc f where =
let r = ref (lazy_available t_dynamic) in
r := lazy_wait (fun() ->
try
r := lazy_processing t_proc;
let t = f () in
r := lazy_available t;
t
with
| Error e ->
raise (Fatal_error e)
);
if force then delay ctx PForce (fun () -> ignore(lazy_type r));
let make_lazy ctx t_proc f where =
let r = make_unforced_lazy t_proc f where in
delay ctx PForce (fun () -> ignore(lazy_type r));
r

let is_removable_field com f =
Expand Down Expand Up @@ -893,7 +883,7 @@ let make_where ctx where =
let inf = ctx_pos ctx in
where ^ " (" ^ String.concat "." inf ^ ")",inf
let make_lazy ?(force=true) ctx t f (where:string) =
let make_lazy ctx t f (where:string) =
let r = ref (lazy_available t_dynamic) in
r := lazy_wait (make_pass ~inf:(make_where ctx where) ctx (fun() ->
try
Expand All @@ -905,7 +895,7 @@ let make_lazy ?(force=true) ctx t f (where:string) =
| Error e ->
raise (Fatal_error e)
));
if force then delay ctx PForce (fun () -> ignore(lazy_type r));
delay ctx PForce (fun () -> ignore(lazy_type r));
r
*)
Expand Down
4 changes: 2 additions & 2 deletions src/typing/typeloadFields.ml
Original file line number Diff line number Diff line change
Expand Up @@ -748,7 +748,7 @@ module TypeBinding = struct
mk_cast e cf.cf_type e.epos
end
in
let r = make_lazy ~force:false ctx.g t (fun () ->
let r = make_unforced_lazy t (fun () ->
(* type constant init fields (issue #1956) *)
if not ctx.g.return_partial_type || (match fst e with EConst _ -> true | _ -> false) then begin
enter_field_typing_pass ctx.g ("bind_var_expression",fst ctx.c.curclass.cl_path @ [snd ctx.c.curclass.cl_path;ctx.f.curfield.cf_name]);
Expand Down Expand Up @@ -877,7 +877,7 @@ module TypeBinding = struct
if not ctx.g.return_partial_type then bind ();
t
in
let r = make_lazy ~force:false ctx.g t maybe_bind "type_fun" in
let r = make_unforced_lazy t maybe_bind "type_fun" in
bind_type ctx cctx fctx cf r p
end

Expand Down

0 comments on commit 4f076e4

Please sign in to comment.