@@ -91322,6 +91322,8 @@ val no_side_effects : Lam.t -> bool
91322
91322
91323
91323
val size : Lam.t -> int
91324
91324
91325
+ val lfunction_can_be_beta_reduced : Lam.lfunction -> bool
91326
+
91325
91327
val ok_to_inline_fun_when_app : Lam.lfunction -> Lam.t list -> bool
91326
91328
91327
91329
val small_inline_size : int
@@ -91578,6 +91580,10 @@ let destruct_pattern (body : Lam.t) params args =
91578
91580
| Some _ | None -> false)
91579
91581
| _ -> false
91580
91582
91583
+ (* Async functions cannot be beta reduced *)
91584
+ let lfunction_can_be_beta_reduced (lfunction : Lam.lfunction) =
91585
+ not lfunction.attr.async
91586
+
91581
91587
(** Hints to inlining *)
91582
91588
let ok_to_inline_fun_when_app (m : Lam.lfunction) (args : Lam.t list) =
91583
91589
match m.attr.inline with
@@ -94288,10 +94294,10 @@ val no_names_beta_reduce : Ident.t list -> Lam.t -> Lam.t list -> Lam.t
94288
94294
the obvious example is parameter
94289
94295
*)
94290
94296
94291
- val propogate_beta_reduce :
94297
+ val propagate_beta_reduce :
94292
94298
Lam_stats.t -> Ident.t list -> Lam.t -> Lam.t list -> Lam.t
94293
94299
94294
- val propogate_beta_reduce_with_map :
94300
+ val propagate_beta_reduce_with_map :
94295
94301
Lam_stats.t ->
94296
94302
Lam_var_stats.stats Map_ident.t ->
94297
94303
Ident.t list ->
@@ -94367,7 +94373,7 @@ end = struct
94367
94373
]}
94368
94374
we can bound [x] to [100] in a single step
94369
94375
*)
94370
- let propogate_beta_reduce (meta : Lam_stats.t) (params : Ident.t list)
94376
+ let propagate_beta_reduce (meta : Lam_stats.t) (params : Ident.t list)
94371
94377
(body : Lam.t) (args : Lam.t list) =
94372
94378
match Lam_beta_reduce_util.simple_beta_reduce params body args with
94373
94379
| Some x -> x
@@ -94396,7 +94402,7 @@ let propogate_beta_reduce (meta : Lam_stats.t) (params : Ident.t list)
94396
94402
| _ -> ());
94397
94403
Lam_util.refine_let ~kind:Strict param arg l)
94398
94404
94399
- let propogate_beta_reduce_with_map (meta : Lam_stats.t)
94405
+ let propagate_beta_reduce_with_map (meta : Lam_stats.t)
94400
94406
(map : Lam_var_stats.stats Map_ident.t) params body args =
94401
94407
match Lam_beta_reduce_util.simple_beta_reduce params body args with
94402
94408
| Some x -> x
@@ -99765,14 +99771,14 @@ and compile_external_field_apply (appinfo : Lam.apply) (module_id : Ident.t)
99765
99771
in
99766
99772
let ap_args = appinfo.ap_args in
99767
99773
match ident_info.persistent_closed_lambda with
99768
- | Some (Lfunction { params; body; _ })
99769
- when Ext_list.same_length params ap_args ->
99774
+ | Some (Lfunction ( { params; body; _ } as lfunction) )
99775
+ when Ext_list.same_length params ap_args && Lam_analysis.lfunction_can_be_beta_reduced lfunction ->
99770
99776
(* TODO: serialize it when exporting to save compile time *)
99771
99777
let _, param_map =
99772
99778
Lam_closure.is_closed_with_map Set_ident.empty params body
99773
99779
in
99774
99780
compile_lambda lambda_cxt
99775
- (Lam_beta_reduce.propogate_beta_reduce_with_map lambda_cxt.meta
99781
+ (Lam_beta_reduce.propagate_beta_reduce_with_map lambda_cxt.meta
99776
99782
param_map params body ap_args)
99777
99783
| _ ->
99778
99784
let args_code, args =
@@ -257925,8 +257931,8 @@ let collect_occurs lam : occ_tbl =
257925
257931
List.iter (fun (_v, l) -> count bv l) bindings;
257926
257932
count bv body
257927
257933
(* Note there is a difference here when do beta reduction for *)
257928
- | Lapply { ap_func = Lfunction { params; body }; ap_args = args; _ }
257929
- when Ext_list.same_length params args ->
257934
+ | Lapply { ap_func = Lfunction ( { params; body } as lfunction) ; ap_args = args; _ }
257935
+ when Ext_list.same_length params args && Lam_analysis.lfunction_can_be_beta_reduced lfunction ->
257930
257936
count bv (Lam_beta_reduce.no_names_beta_reduce params body args)
257931
257937
(* | Lapply{fn = Lfunction{function_kind = Tupled; params; body}; *)
257932
257938
(* args = [Lprim {primitive = Pmakeblock _; args; _}]; _} *)
@@ -258306,8 +258312,8 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
258306
258312
end
258307
258313
| Lsequence(l1, l2) -> Lam.seq (simplif l1) (simplif l2)
258308
258314
258309
- | Lapply{ap_func = Lfunction{params; body}; ap_args = args; _}
258310
- when Ext_list.same_length params args ->
258315
+ | Lapply{ap_func = Lfunction ( {params; body} as lfunction) ; ap_args = args; _}
258316
+ when Ext_list.same_length params args && Lam_analysis.lfunction_can_be_beta_reduced lfunction ->
258311
258317
simplif (Lam_beta_reduce.no_names_beta_reduce params body args)
258312
258318
(* | Lapply{ fn = Lfunction{function_kind = Tupled; params; body}; *)
258313
258319
(* args = [Lprim {primitive = Pmakeblock _; args; _}]; _} *)
@@ -258606,7 +258612,7 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
258606
258612
| Some v -> v <> Parameter
258607
258613
| None -> true)
258608
258614
| _ -> true) ->
258609
- simpl (Lam_beta_reduce.propogate_beta_reduce meta params body args)
258615
+ simpl (Lam_beta_reduce.propagate_beta_reduce meta params body args)
258610
258616
| _ -> Lam.apply (simpl l1) (Ext_list.map args simpl) ap_info)
258611
258617
(* Function inlining interact with other optimizations...
258612
258618
@@ -258628,7 +258634,7 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
258628
258634
Some
258629
258635
( Lfunction ({ params; body; attr = { is_a_functor } } as m),
258630
258636
rec_flag );
258631
- }) ->
258637
+ }) when Lam_analysis.lfunction_can_be_beta_reduced m ->
258632
258638
if Ext_list.same_length ap_args params (* && false *) then
258633
258639
if
258634
258640
is_a_functor
@@ -258642,7 +258648,7 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
258642
258648
(* Check: recursive applying may result in non-termination *)
258643
258649
(* Ext_log.dwarn __LOC__ "beta .. %s/%d" v.name v.stamp ; *)
258644
258650
simpl
258645
- (Lam_beta_reduce.propogate_beta_reduce meta params body
258651
+ (Lam_beta_reduce.propagate_beta_reduce meta params body
258646
258652
ap_args)
258647
258653
else if
258648
258654
(* Lam_analysis.size body < Lam_analysis.small_inline_size *)
@@ -258662,7 +258668,7 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
258662
258668
| false, (_, param_map) | true, (true, param_map) -> (
258663
258669
match rec_flag with
258664
258670
| Lam_rec ->
258665
- Lam_beta_reduce.propogate_beta_reduce_with_map meta
258671
+ Lam_beta_reduce.propagate_beta_reduce_with_map meta
258666
258672
param_map params body ap_args
258667
258673
| Lam_self_rec -> normal ()
258668
258674
| Lam_non_rec ->
@@ -258673,15 +258679,15 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
258673
258679
then normal ()
258674
258680
else
258675
258681
simpl
258676
- (Lam_beta_reduce.propogate_beta_reduce_with_map meta
258682
+ (Lam_beta_reduce.propagate_beta_reduce_with_map meta
258677
258683
param_map params body ap_args))
258678
258684
| _ -> normal ()
258679
258685
else normal ()
258680
258686
else normal ()
258681
258687
| Some _ | None -> normal ())
258682
- | Lapply { ap_func = Lfunction { params; body }; ap_args = args; _ }
258683
- when Ext_list.same_length params args ->
258684
- simpl (Lam_beta_reduce.propogate_beta_reduce meta params body args)
258688
+ | Lapply { ap_func = Lfunction ( { params; body } as lfunction) ; ap_args = args; _ }
258689
+ when Ext_list.same_length params args && Lam_analysis.lfunction_can_be_beta_reduced lfunction ->
258690
+ simpl (Lam_beta_reduce.propagate_beta_reduce meta params body args)
258685
258691
(* | Lapply{ fn = Lfunction{function_kind = Tupled; params; body}; *)
258686
258692
(* args = [Lprim {primitive = Pmakeblock _; args; _}]; _} *)
258687
258693
(* (\** TODO: keep track of this parameter in ocaml trunk, *)
0 commit comments