Skip to content

Commit f8c7aa8

Browse files
bobzhangbobzhang
authored
Merge pull request #5294 from rescript-lang/unboxed_crash
fix several edge cases between optimizer and recursive values
2 parents d172b7a + a486a38 commit f8c7aa8

File tree

9 files changed

+1106
-1159
lines changed

9 files changed

+1106
-1159
lines changed

‎jscomp/core/js_dump.ml

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -319,7 +319,16 @@ and pp_function ~return_unit ~is_method cxt (f : P.t) ~fn_state
319319
{[ function(x,y){ return u(x,y) } ]}
320320
it can be optimized in to either [u] or [Curry.__n(u)]
321321
*)
322-
(not is_method) && Ext_list.for_all2_no_exn ls l is_var -> (
322+
(not is_method)
323+
&& Ext_list.for_all2_no_exn ls l is_var
324+
&&
325+
match v with
326+
(* This check is needed to avoid some edge cases
327+
{[function(x){return x(x)}]}
328+
here the function is also called `x`
329+
*)
330+
| Id id -> not (Ext_list.exists l (fun x -> Ident.same x id))
331+
| Qualified _ -> true -> (
323332
let optimize len ~p cxt f v =
324333
if p then try_optimize_curry cxt f len function_id else vident cxt f v
325334
in

‎jscomp/core/lam_beta_reduce.ml

Lines changed: 72 additions & 86 deletions
Original file line numberDiff line numberDiff line change
@@ -22,15 +22,6 @@
2222
* along with this program; if not, write to the Free Software
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

25-
26-
27-
28-
29-
30-
31-
32-
33-
3425
(*
3526
A naive beta reduce would break the invariants of the optmization.
3627
@@ -53,85 +44,80 @@
5344
]}
5445
we can bound [x] to [100] in a single step
5546
*)
56-
let propogate_beta_reduce
57-
(meta : Lam_stats.t) (params : Ident.t list) (body : Lam.t) (args : Lam.t list) =
58-
match Lam_beta_reduce_util.simple_beta_reduce params body args with
59-
| Some x -> x
60-
| None ->
61-
let rest_bindings, rev_new_params =
62-
Ext_list.fold_left2 params args ([],[]) (fun old_param arg (rest_bindings, acc) ->
63-
match arg with
64-
| Lconst _
65-
| Lvar _ -> rest_bindings , arg :: acc
66-
| _ ->
67-
let p = Ident.rename old_param in
68-
(p,arg) :: rest_bindings , (Lam.var p) :: acc
69-
) in
70-
let new_body = Lam_bounded_vars.rewrite (Hash_ident.of_list2 (List.rev params) (rev_new_params)) body in
71-
Ext_list.fold_right rest_bindings new_body
72-
(fun (param, arg ) l ->
73-
begin match arg with
74-
| Lprim {primitive = Pmakeblock (_, _, Immutable) ;args ; _} ->
75-
Hash_ident.replace meta.ident_tbl param
76-
(Lam_util.kind_of_lambda_block args )
77-
| Lprim {primitive = Psome | Psome_not_nest; args = [v]; _} ->
78-
Hash_ident.replace meta.ident_tbl param
79-
(Normal_optional(v))
80-
| _ -> () end;
81-
Lam_util.refine_let ~kind:Strict param arg l)
82-
83-
84-
let propogate_beta_reduce_with_map
85-
(meta : Lam_stats.t) (map : Lam_var_stats.stats Map_ident.t ) params body args =
47+
let propogate_beta_reduce (meta : Lam_stats.t) (params : Ident.t list)
48+
(body : Lam.t) (args : Lam.t list) =
8649
match Lam_beta_reduce_util.simple_beta_reduce params body args with
8750
| Some x -> x
8851
| None ->
89-
let rest_bindings, rev_new_params =
90-
Ext_list.fold_left2 params args ([],[])
91-
(fun old_param arg (rest_bindings, acc) ->
92-
match arg with
93-
| Lconst _
94-
| Lvar _ -> rest_bindings , arg :: acc
95-
| Lglobal_module _
96-
->
97-
let p = Ident.rename old_param in
98-
(p,arg) :: rest_bindings , (Lam.var p) :: acc
99-
100-
| _ ->
101-
if Lam_analysis.no_side_effects arg then
102-
match Map_ident.find_exn map old_param with
103-
| stat ->
104-
if Lam_var_stats.top_and_used_zero_or_one stat then
105-
rest_bindings, arg :: acc
106-
else
107-
let p = Ident.rename old_param in
108-
(p,arg) :: rest_bindings , (Lam.var p) :: acc
109-
else
110-
let p = Ident.rename old_param in
111-
(p,arg) :: rest_bindings , (Lam.var p) :: acc ) in
112-
let new_body = Lam_bounded_vars.rewrite (Hash_ident.of_list2 (List.rev params) (rev_new_params)) body in
113-
Ext_list.fold_right rest_bindings new_body
114-
(fun (param, (arg : Lam.t)) l ->
115-
begin match arg with
116-
| Lprim {primitive = Pmakeblock (_, _, Immutable ) ; args} ->
117-
Hash_ident.replace meta.ident_tbl param
118-
(Lam_util.kind_of_lambda_block args )
119-
120-
| Lprim {primitive = Psome | Psome_not_nest; args = [v]} ->
121-
Hash_ident.replace meta.ident_tbl param
122-
(Normal_optional(v));
123-
124-
| _ -> () end;
125-
Lam_util.refine_let ~kind:Strict param arg l)
126-
127-
128-
52+
let rest_bindings, rev_new_params =
53+
Ext_list.fold_left2 params args ([], [])
54+
(fun old_param arg (rest_bindings, acc) ->
55+
match arg with
56+
| Lconst _ | Lvar _ -> (rest_bindings, arg :: acc)
57+
| _ ->
58+
let p = Ident.rename old_param in
59+
((p, arg) :: rest_bindings, Lam.var p :: acc))
60+
in
61+
let new_body =
62+
Lam_bounded_vars.rewrite
63+
(Hash_ident.of_list2 (List.rev params) rev_new_params)
64+
body
65+
in
66+
Ext_list.fold_right rest_bindings new_body (fun (param, arg) l ->
67+
(match arg with
68+
| Lprim { primitive = Pmakeblock (_, _, Immutable); args; _ } ->
69+
Hash_ident.replace meta.ident_tbl param
70+
(Lam_util.kind_of_lambda_block args)
71+
| Lprim { primitive = Psome | Psome_not_nest; args = [ v ]; _ } ->
72+
Hash_ident.replace meta.ident_tbl param (Normal_optional v)
73+
| _ -> ());
74+
Lam_util.refine_let ~kind:Strict param arg l)
75+
76+
let propogate_beta_reduce_with_map (meta : Lam_stats.t)
77+
(map : Lam_var_stats.stats Map_ident.t) params body args =
78+
match Lam_beta_reduce_util.simple_beta_reduce params body args with
79+
| Some x -> x
80+
| None ->
81+
let rest_bindings, rev_new_params =
82+
Ext_list.fold_left2 params args ([], [])
83+
(fun old_param arg (rest_bindings, acc) ->
84+
match arg with
85+
| Lconst _ | Lvar _ -> (rest_bindings, arg :: acc)
86+
| Lglobal_module _ ->
87+
let p = Ident.rename old_param in
88+
((p, arg) :: rest_bindings, Lam.var p :: acc)
89+
| _ ->
90+
if Lam_analysis.no_side_effects arg then
91+
match Map_ident.find_exn map old_param with
92+
| stat ->
93+
if Lam_var_stats.top_and_used_zero_or_one stat then
94+
(rest_bindings, arg :: acc)
95+
else
96+
let p = Ident.rename old_param in
97+
((p, arg) :: rest_bindings, Lam.var p :: acc)
98+
else
99+
let p = Ident.rename old_param in
100+
((p, arg) :: rest_bindings, Lam.var p :: acc))
101+
in
102+
let new_body =
103+
Lam_bounded_vars.rewrite
104+
(Hash_ident.of_list2 (List.rev params) rev_new_params)
105+
body
106+
in
107+
Ext_list.fold_right rest_bindings new_body
108+
(fun (param, (arg : Lam.t)) l ->
109+
(match arg with
110+
| Lprim { primitive = Pmakeblock (_, _, Immutable); args } ->
111+
Hash_ident.replace meta.ident_tbl param
112+
(Lam_util.kind_of_lambda_block args)
113+
| Lprim { primitive = Psome | Psome_not_nest; args = [ v ] } ->
114+
Hash_ident.replace meta.ident_tbl param (Normal_optional v)
115+
| _ -> ());
116+
Lam_util.refine_let ~kind:Strict param arg l)
129117

130118
let no_names_beta_reduce params body args =
131-
match Lam_beta_reduce_util.simple_beta_reduce params body args with
132-
| Some x -> x
133-
| None ->
134-
Ext_list.fold_left2 params args body
135-
(fun param arg l ->
136-
Lam_util.refine_let ~kind:Strict param arg l)
137-
119+
match Lam_beta_reduce_util.simple_beta_reduce params body args with
120+
| Some x -> x
121+
| None ->
122+
Ext_list.fold_left2 params args body (fun param arg l ->
123+
Lam_util.refine_let ~kind:Strict param arg l)

‎jscomp/core/lam_beta_reduce_util.ml

Lines changed: 66 additions & 74 deletions
Original file line numberDiff line numberDiff line change
@@ -22,11 +22,6 @@
2222
* along with this program; if not, write to the Free Software
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

25-
26-
27-
28-
29-
3025
(*
3126
Principle: since in ocaml, the apply order is not specified
3227
rules:
@@ -36,12 +31,9 @@
3631
other wise the evaluation order is tricky (make sure eval order is correct)
3732
*)
3833

39-
type value =
40-
{ mutable used : bool ;
41-
lambda : Lam.t
42-
}
43-
let param_hash : _ Hash_ident.t = Hash_ident.create 20
34+
type value = { mutable used : bool; lambda : Lam.t }
4435

36+
let param_hash : _ Hash_ident.t = Hash_ident.create 20
4537

4638
(* optimize cases like
4739
(fun f (a,b){ g (a,b,1)} (e0, e1))
@@ -57,74 +49,74 @@ let param_hash : _ Hash_ident.t = Hash_ident.create 20
5749
| _ -> false ) params args'
5850
]}
5951
*)
60-
let simple_beta_reduce params body args =
52+
let simple_beta_reduce params body args =
6153
let exception Not_simple_apply in
62-
let find_param v opt =
63-
match Hash_ident.find_opt param_hash v with
64-
| Some exp ->
65-
if exp.used then raise_notrace Not_simple_apply
66-
else
67-
exp.used <- true; exp.lambda
54+
let find_param_exn v opt =
55+
match Hash_ident.find_opt param_hash v with
56+
| Some exp ->
57+
if exp.used then raise_notrace Not_simple_apply else exp.used <- true;
58+
exp.lambda
6859
| None -> opt
69-
in
70-
let rec aux acc (us : Lam.t list) =
71-
match us with
60+
in
61+
let rec aux_exn acc (us : Lam.t list) =
62+
match us with
7263
| [] -> List.rev acc
73-
| (Lvar x as a ) :: rest
74-
->
75-
aux (find_param x a :: acc) rest
76-
| (Lconst _ as u) :: rest
77-
-> aux (u :: acc) rest
78-
| _ :: _ -> raise_notrace Not_simple_apply
79-
in
80-
match (body : Lam.t) with
81-
| Lprim { primitive ; args = ap_args ; loc = ap_loc} (* There is no lambda in primitive *)
82-
-> (* catch a special case of primitives *)
83-
84-
let () =
85-
List.iter2 (fun p a -> Hash_ident.add param_hash p {lambda = a; used = false }) params args
86-
in
87-
begin match aux [] ap_args with
88-
| new_args ->
89-
let result =
90-
Hash_ident.fold param_hash (Lam.prim ~primitive ~args:new_args ap_loc) (fun _param {lambda; used} acc ->
91-
if not used then
92-
Lam.seq lambda acc
93-
else acc) in
64+
| (Lvar x as a) :: rest -> aux_exn (find_param_exn x a :: acc) rest
65+
| (Lconst _ as u) :: rest -> aux_exn (u :: acc) rest
66+
| _ :: _ -> raise_notrace Not_simple_apply
67+
in
68+
match (body : Lam.t) with
69+
| Lprim { primitive; args = ap_args; loc = ap_loc }
70+
(* There is no lambda in primitive *) -> (
71+
(* catch a special case of primitives *)
72+
let () =
73+
List.iter2
74+
(fun p a -> Hash_ident.add param_hash p { lambda = a; used = false })
75+
params args
76+
in
77+
try
78+
let new_args = aux_exn [] ap_args in
79+
let result =
80+
Hash_ident.fold param_hash (Lam.prim ~primitive ~args:new_args ap_loc)
81+
(fun _param { lambda; used } acc ->
82+
if not used then Lam.seq lambda acc else acc)
83+
in
84+
Hash_ident.clear param_hash;
85+
Some result
86+
with Not_simple_apply ->
9487
Hash_ident.clear param_hash;
95-
Some result
96-
| exception _ ->
97-
Hash_ident.clear param_hash ;
98-
None
99-
end
100-
| Lapply { ap_func =
101-
(Lvar _ | Lprim {primitive = Pfield _; args = [Lglobal_module _ ]} as f) ; ap_args ; ap_info }
102-
->
103-
let () =
104-
List.iter2 (fun p a -> Hash_ident.add param_hash p {lambda = a; used = false }) params args
105-
in
106-
(*since we adde each param only once,
107-
iff it is removed once, no exception,
108-
if it is removed twice there will be exception.
109-
if it is never removed, we have it as rest keys
110-
*)
111-
begin match aux [] ap_args with
112-
| new_args ->
113-
let f =
114-
match f with
115-
| Lvar fn_name -> find_param fn_name f
116-
| _ -> f in
117-
let result =
118-
Hash_ident.fold param_hash (Lam.apply f new_args ap_info )
119-
(fun _param {lambda; used} acc ->
120-
if not used then
121-
Lam.seq lambda acc
122-
else acc )
88+
None)
89+
| Lapply
90+
{
91+
ap_func =
92+
(Lvar _ | Lprim { primitive = Pfield _; args = [ Lglobal_module _ ] })
93+
as f;
94+
ap_args;
95+
ap_info;
96+
} -> (
97+
let () =
98+
List.iter2
99+
(fun p a -> Hash_ident.add param_hash p { lambda = a; used = false })
100+
params args
101+
in
102+
(*since we adde each param only once,
103+
iff it is removed once, no exception,
104+
if it is removed twice there will be exception.
105+
if it is never removed, we have it as rest keys
106+
*)
107+
try
108+
let new_args = aux_exn [] ap_args in
109+
let f =
110+
match f with Lvar fn_name -> find_param_exn fn_name f | _ -> f
123111
in
112+
let result =
113+
Hash_ident.fold param_hash (Lam.apply f new_args ap_info)
114+
(fun _param { lambda; used } acc ->
115+
if not used then Lam.seq lambda acc else acc)
116+
in
117+
Hash_ident.clear param_hash;
118+
Some result
119+
with Not_simple_apply ->
124120
Hash_ident.clear param_hash;
125-
Some result
126-
| exception _ ->
127-
Hash_ident.clear param_hash;
128-
None
129-
end
121+
None)
130122
| _ -> None

0 commit comments

Comments
 (0)