Skip to content

fix several edge cases between optimizer and recursive values #5294

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 10 commits into from
Sep 16, 2021
Merged

fix several edge cases between optimizer and recursive values #5294

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
a8919eb
format
bobzhang Sep 15, 2021
b3a896a
add exn suffix to indicate that it is gonna raise
bobzhang Sep 15, 2021
2bc9676
avoid an edge case where a function happens to be the parameter
bobzhang Sep 16, 2021
a6960bd
also catch exception raised by find_param_exn
bobzhang Sep 16, 2021
361a382
simplify args first
bobzhang Sep 16, 2021
017dc62
tweak
bobzhang Sep 16, 2021
01ab7eb
fix an edge case of non-termination `g (g)`
bobzhang Sep 16, 2021
0dde294
add a crashed case
bobzhang Sep 15, 2021
4f96ca6
snapshot build
bobzhang Sep 16, 2021
a486a38
snapshot
bobzhang Sep 16, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 10 additions & 1 deletion jscomp/core/js_dump.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -319,7 +319,16 @@ and pp_function ~return_unit ~is_method cxt (f : P.t) ~fn_state
{[ function(x,y){ return u(x,y) } ]}
it can be optimized in to either [u] or [Curry.__n(u)]
*)
(not is_method) && Ext_list.for_all2_no_exn ls l is_var -> (
(not is_method)
&& Ext_list.for_all2_no_exn ls l is_var
&&
match v with
(* This check is needed to avoid some edge cases
{[function(x){return x(x)}]}
here the function is also called `x`
*)
| Id id -> not (Ext_list.exists l (fun x -> Ident.same x id))
| Qualified _ -> true -> (
let optimize len ~p cxt f v =
if p then try_optimize_curry cxt f len function_id else vident cxt f v
in
Expand Down
158 changes: 72 additions & 86 deletions jscomp/core/lam_beta_reduce.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,15 +22,6 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)










(*
A naive beta reduce would break the invariants of the optmization.

Expand All @@ -53,85 +44,80 @@
]}
we can bound [x] to [100] in a single step
*)
let propogate_beta_reduce
(meta : Lam_stats.t) (params : Ident.t list) (body : Lam.t) (args : Lam.t list) =
match Lam_beta_reduce_util.simple_beta_reduce params body args with
| Some x -> x
| None ->
let rest_bindings, rev_new_params =
Ext_list.fold_left2 params args ([],[]) (fun old_param arg (rest_bindings, acc) ->
match arg with
| Lconst _
| Lvar _ -> rest_bindings , arg :: acc
| _ ->
let p = Ident.rename old_param in
(p,arg) :: rest_bindings , (Lam.var p) :: acc
) in
let new_body = Lam_bounded_vars.rewrite (Hash_ident.of_list2 (List.rev params) (rev_new_params)) body in
Ext_list.fold_right rest_bindings new_body
(fun (param, arg ) l ->
begin match arg with
| Lprim {primitive = Pmakeblock (_, _, Immutable) ;args ; _} ->
Hash_ident.replace meta.ident_tbl param
(Lam_util.kind_of_lambda_block args )
| Lprim {primitive = Psome | Psome_not_nest; args = [v]; _} ->
Hash_ident.replace meta.ident_tbl param
(Normal_optional(v))
| _ -> () end;
Lam_util.refine_let ~kind:Strict param arg l)


let propogate_beta_reduce_with_map
(meta : Lam_stats.t) (map : Lam_var_stats.stats Map_ident.t ) params body args =
let propogate_beta_reduce (meta : Lam_stats.t) (params : Ident.t list)
(body : Lam.t) (args : Lam.t list) =
match Lam_beta_reduce_util.simple_beta_reduce params body args with
| Some x -> x
| None ->
let rest_bindings, rev_new_params =
Ext_list.fold_left2 params args ([],[])
(fun old_param arg (rest_bindings, acc) ->
match arg with
| Lconst _
| Lvar _ -> rest_bindings , arg :: acc
| Lglobal_module _
->
let p = Ident.rename old_param in
(p,arg) :: rest_bindings , (Lam.var p) :: acc

| _ ->
if Lam_analysis.no_side_effects arg then
match Map_ident.find_exn map old_param with
| stat ->
if Lam_var_stats.top_and_used_zero_or_one stat then
rest_bindings, arg :: acc
else
let p = Ident.rename old_param in
(p,arg) :: rest_bindings , (Lam.var p) :: acc
else
let p = Ident.rename old_param in
(p,arg) :: rest_bindings , (Lam.var p) :: acc ) in
let new_body = Lam_bounded_vars.rewrite (Hash_ident.of_list2 (List.rev params) (rev_new_params)) body in
Ext_list.fold_right rest_bindings new_body
(fun (param, (arg : Lam.t)) l ->
begin match arg with
| Lprim {primitive = Pmakeblock (_, _, Immutable ) ; args} ->
Hash_ident.replace meta.ident_tbl param
(Lam_util.kind_of_lambda_block args )

| Lprim {primitive = Psome | Psome_not_nest; args = [v]} ->
Hash_ident.replace meta.ident_tbl param
(Normal_optional(v));

| _ -> () end;
Lam_util.refine_let ~kind:Strict param arg l)



let rest_bindings, rev_new_params =
Ext_list.fold_left2 params args ([], [])
(fun old_param arg (rest_bindings, acc) ->
match arg with
| Lconst _ | Lvar _ -> (rest_bindings, arg :: acc)
| _ ->
let p = Ident.rename old_param in
((p, arg) :: rest_bindings, Lam.var p :: acc))
in
let new_body =
Lam_bounded_vars.rewrite
(Hash_ident.of_list2 (List.rev params) rev_new_params)
body
in
Ext_list.fold_right rest_bindings new_body (fun (param, arg) l ->
(match arg with
| Lprim { primitive = Pmakeblock (_, _, Immutable); args; _ } ->
Hash_ident.replace meta.ident_tbl param
(Lam_util.kind_of_lambda_block args)
| Lprim { primitive = Psome | Psome_not_nest; args = [ v ]; _ } ->
Hash_ident.replace meta.ident_tbl param (Normal_optional v)
| _ -> ());
Lam_util.refine_let ~kind:Strict param arg l)

let propogate_beta_reduce_with_map (meta : Lam_stats.t)
(map : Lam_var_stats.stats Map_ident.t) params body args =
match Lam_beta_reduce_util.simple_beta_reduce params body args with
| Some x -> x
| None ->
let rest_bindings, rev_new_params =
Ext_list.fold_left2 params args ([], [])
(fun old_param arg (rest_bindings, acc) ->
match arg with
| Lconst _ | Lvar _ -> (rest_bindings, arg :: acc)
| Lglobal_module _ ->
let p = Ident.rename old_param in
((p, arg) :: rest_bindings, Lam.var p :: acc)
| _ ->
if Lam_analysis.no_side_effects arg then
match Map_ident.find_exn map old_param with
| stat ->
if Lam_var_stats.top_and_used_zero_or_one stat then
(rest_bindings, arg :: acc)
else
let p = Ident.rename old_param in
((p, arg) :: rest_bindings, Lam.var p :: acc)
else
let p = Ident.rename old_param in
((p, arg) :: rest_bindings, Lam.var p :: acc))
in
let new_body =
Lam_bounded_vars.rewrite
(Hash_ident.of_list2 (List.rev params) rev_new_params)
body
in
Ext_list.fold_right rest_bindings new_body
(fun (param, (arg : Lam.t)) l ->
(match arg with
| Lprim { primitive = Pmakeblock (_, _, Immutable); args } ->
Hash_ident.replace meta.ident_tbl param
(Lam_util.kind_of_lambda_block args)
| Lprim { primitive = Psome | Psome_not_nest; args = [ v ] } ->
Hash_ident.replace meta.ident_tbl param (Normal_optional v)
| _ -> ());
Lam_util.refine_let ~kind:Strict param arg l)

let no_names_beta_reduce params body args =
match Lam_beta_reduce_util.simple_beta_reduce params body args with
| Some x -> x
| None ->
Ext_list.fold_left2 params args body
(fun param arg l ->
Lam_util.refine_let ~kind:Strict param arg l)

match Lam_beta_reduce_util.simple_beta_reduce params body args with
| Some x -> x
| None ->
Ext_list.fold_left2 params args body (fun param arg l ->
Lam_util.refine_let ~kind:Strict param arg l)
140 changes: 66 additions & 74 deletions jscomp/core/lam_beta_reduce_util.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,11 +22,6 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)






(*
Principle: since in ocaml, the apply order is not specified
rules:
Expand All @@ -36,12 +31,9 @@
other wise the evaluation order is tricky (make sure eval order is correct)
*)

type value =
{ mutable used : bool ;
lambda : Lam.t
}
let param_hash : _ Hash_ident.t = Hash_ident.create 20
type value = { mutable used : bool; lambda : Lam.t }

let param_hash : _ Hash_ident.t = Hash_ident.create 20

(* optimize cases like
(fun f (a,b){ g (a,b,1)} (e0, e1))
Expand All @@ -57,74 +49,74 @@ let param_hash : _ Hash_ident.t = Hash_ident.create 20
| _ -> false ) params args'
]}
*)
let simple_beta_reduce params body args =
let simple_beta_reduce params body args =
let exception Not_simple_apply in
let find_param v opt =
match Hash_ident.find_opt param_hash v with
| Some exp ->
if exp.used then raise_notrace Not_simple_apply
else
exp.used <- true; exp.lambda
let find_param_exn v opt =
match Hash_ident.find_opt param_hash v with
| Some exp ->
if exp.used then raise_notrace Not_simple_apply else exp.used <- true;
exp.lambda
| None -> opt
in
let rec aux acc (us : Lam.t list) =
match us with
in
let rec aux_exn acc (us : Lam.t list) =
match us with
| [] -> List.rev acc
| (Lvar x as a ) :: rest
->
aux (find_param x a :: acc) rest
| (Lconst _ as u) :: rest
-> aux (u :: acc) rest
| _ :: _ -> raise_notrace Not_simple_apply
in
match (body : Lam.t) with
| Lprim { primitive ; args = ap_args ; loc = ap_loc} (* There is no lambda in primitive *)
-> (* catch a special case of primitives *)

let () =
List.iter2 (fun p a -> Hash_ident.add param_hash p {lambda = a; used = false }) params args
in
begin match aux [] ap_args with
| new_args ->
let result =
Hash_ident.fold param_hash (Lam.prim ~primitive ~args:new_args ap_loc) (fun _param {lambda; used} acc ->
if not used then
Lam.seq lambda acc
else acc) in
| (Lvar x as a) :: rest -> aux_exn (find_param_exn x a :: acc) rest
| (Lconst _ as u) :: rest -> aux_exn (u :: acc) rest
| _ :: _ -> raise_notrace Not_simple_apply
in
match (body : Lam.t) with
| Lprim { primitive; args = ap_args; loc = ap_loc }
(* There is no lambda in primitive *) -> (
(* catch a special case of primitives *)
let () =
List.iter2
(fun p a -> Hash_ident.add param_hash p { lambda = a; used = false })
params args
in
try
let new_args = aux_exn [] ap_args in
let result =
Hash_ident.fold param_hash (Lam.prim ~primitive ~args:new_args ap_loc)
(fun _param { lambda; used } acc ->
if not used then Lam.seq lambda acc else acc)
in
Hash_ident.clear param_hash;
Some result
with Not_simple_apply ->
Hash_ident.clear param_hash;
Some result
| exception _ ->
Hash_ident.clear param_hash ;
None
end
| Lapply { ap_func =
(Lvar _ | Lprim {primitive = Pfield _; args = [Lglobal_module _ ]} as f) ; ap_args ; ap_info }
->
let () =
List.iter2 (fun p a -> Hash_ident.add param_hash p {lambda = a; used = false }) params args
in
(*since we adde each param only once,
iff it is removed once, no exception,
if it is removed twice there will be exception.
if it is never removed, we have it as rest keys
*)
begin match aux [] ap_args with
| new_args ->
let f =
match f with
| Lvar fn_name -> find_param fn_name f
| _ -> f in
let result =
Hash_ident.fold param_hash (Lam.apply f new_args ap_info )
(fun _param {lambda; used} acc ->
if not used then
Lam.seq lambda acc
else acc )
None)
| Lapply
{
ap_func =
(Lvar _ | Lprim { primitive = Pfield _; args = [ Lglobal_module _ ] })
as f;
ap_args;
ap_info;
} -> (
let () =
List.iter2
(fun p a -> Hash_ident.add param_hash p { lambda = a; used = false })
params args
in
(*since we adde each param only once,
iff it is removed once, no exception,
if it is removed twice there will be exception.
if it is never removed, we have it as rest keys
*)
try
let new_args = aux_exn [] ap_args in
let f =
match f with Lvar fn_name -> find_param_exn fn_name f | _ -> f
in
let result =
Hash_ident.fold param_hash (Lam.apply f new_args ap_info)
(fun _param { lambda; used } acc ->
if not used then Lam.seq lambda acc else acc)
in
Hash_ident.clear param_hash;
Some result
with Not_simple_apply ->
Hash_ident.clear param_hash;
Some result
| exception _ ->
Hash_ident.clear param_hash;
None
end
None)
| _ -> None
Loading