Skip to content

Commit c6e7459

Browse files
bobzhangbobzhang
committed
better fold_right2
1 parent 018629a commit c6e7459

15 files changed

+147
-69
lines changed

‎jscomp/all.depend

+2-1
Original file line numberDiff line numberDiff line change
@@ -633,7 +633,8 @@ core/lam_pass_remove_alias.cmx : core/lam_util.cmx core/lam_stats.cmx \
633633
core/lam_coercion.cmx : ext/string_hash_set.cmx core/lam_util.cmx \
634634
core/lam_stats_util.cmx core/lam_stats.cmx core/lam_group.cmx \
635635
core/lam_dce.cmx core/lam.cmx ext/ident_set.cmx ext/ident_map.cmx \
636-
ext/ident_hashtbl.cmx depends/bs_exception.cmx core/lam_coercion.cmi
636+
ext/ident_hashtbl.cmx ext/ext_list.cmx depends/bs_exception.cmx \
637+
core/lam_coercion.cmi
637638
core/lam_compile_main.cmx : ext/literals.cmx core/lam_util.cmx \
638639
core/lam_stats_export.cmx core/lam_stats.cmx \
639640
core/lam_pass_remove_alias.cmx core/lam_pass_lets_dce.cmx \

‎jscomp/bin/all_ounit_tests.ml

+18-7
Original file line numberDiff line numberDiff line change
@@ -3252,6 +3252,8 @@ val map_append : ('b -> 'a) -> 'b list -> 'a list -> 'a list
32523252

32533253
val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
32543254

3255+
val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
3256+
32553257
(** Extension to the standard library [List] module *)
32563258

32573259
(** TODO some function are no efficiently implemented. *)
@@ -3502,6 +3504,22 @@ let rec fold_right f l acc =
35023504
| a0::a1::a2::a3::a4::rest ->
35033505
f a0 (f a1 (f a2 (f a3 (f a4 (fold_right f rest acc)))))
35043506

3507+
let rec fold_right2 f l r acc =
3508+
match l,r with
3509+
| [],[] -> acc
3510+
| [a0],[b0] -> f a0 b0 acc
3511+
| [a0;a1],[b0;b1] -> f a0 b0 (f a1 b1 acc)
3512+
| [a0;a1;a2],[b0;b1;b2] -> f a0 b0 (f a1 b1 (f a2 b2 acc))
3513+
| [a0;a1;a2;a3],[b0;b1;b2;b3] ->
3514+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 acc)))
3515+
| [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] ->
3516+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc))))
3517+
| a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest ->
3518+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 f arest brest acc)))))
3519+
| _, _ -> invalid_arg "Ext_list.fold_right2"
3520+
3521+
3522+
35053523
let rec filter_map (f: 'a -> 'b option) xs =
35063524
match xs with
35073525
| [] -> []
@@ -3641,13 +3659,6 @@ let rec map_last f l1 =
36413659
| a1::l1 -> let r = f false a1 in r :: map_last f l1
36423660

36433661

3644-
(* let rec fold_right2_last f l1 l2 accu =
3645-
match (l1, l2) with
3646-
| ([], []) -> accu
3647-
| [last1], [last2] -> f true last1 last2 accu
3648-
| (a1::l1, a2::l2) -> f false a1 a2 (fold_right2_last f l1 l2 accu)
3649-
| (_, _) -> invalid_arg "List.fold_right2" *)
3650-
36513662

36523663
let init n f =
36533664
Array.to_list (Array.init n f)

‎jscomp/bin/bsb.ml

+18-7
Original file line numberDiff line numberDiff line change
@@ -2327,6 +2327,8 @@ val map_append : ('b -> 'a) -> 'b list -> 'a list -> 'a list
23272327

23282328
val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
23292329

2330+
val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
2331+
23302332
(** Extension to the standard library [List] module *)
23312333

23322334
(** TODO some function are no efficiently implemented. *)
@@ -2577,6 +2579,22 @@ let rec fold_right f l acc =
25772579
| a0::a1::a2::a3::a4::rest ->
25782580
f a0 (f a1 (f a2 (f a3 (f a4 (fold_right f rest acc)))))
25792581

2582+
let rec fold_right2 f l r acc =
2583+
match l,r with
2584+
| [],[] -> acc
2585+
| [a0],[b0] -> f a0 b0 acc
2586+
| [a0;a1],[b0;b1] -> f a0 b0 (f a1 b1 acc)
2587+
| [a0;a1;a2],[b0;b1;b2] -> f a0 b0 (f a1 b1 (f a2 b2 acc))
2588+
| [a0;a1;a2;a3],[b0;b1;b2;b3] ->
2589+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 acc)))
2590+
| [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] ->
2591+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc))))
2592+
| a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest ->
2593+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 f arest brest acc)))))
2594+
| _, _ -> invalid_arg "Ext_list.fold_right2"
2595+
2596+
2597+
25802598
let rec filter_map (f: 'a -> 'b option) xs =
25812599
match xs with
25822600
| [] -> []
@@ -2716,13 +2734,6 @@ let rec map_last f l1 =
27162734
| a1::l1 -> let r = f false a1 in r :: map_last f l1
27172735

27182736

2719-
(* let rec fold_right2_last f l1 l2 accu =
2720-
match (l1, l2) with
2721-
| ([], []) -> accu
2722-
| [last1], [last2] -> f true last1 last2 accu
2723-
| (a1::l1, a2::l2) -> f false a1 a2 (fold_right2_last f l1 l2 accu)
2724-
| (_, _) -> invalid_arg "List.fold_right2" *)
2725-
27262737

27272738
let init n f =
27282739
Array.to_list (Array.init n f)

‎jscomp/bin/bsb_helper.ml

+18-7
Original file line numberDiff line numberDiff line change
@@ -860,6 +860,8 @@ val map_append : ('b -> 'a) -> 'b list -> 'a list -> 'a list
860860

861861
val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
862862

863+
val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
864+
863865
(** Extension to the standard library [List] module *)
864866

865867
(** TODO some function are no efficiently implemented. *)
@@ -1110,6 +1112,22 @@ let rec fold_right f l acc =
11101112
| a0::a1::a2::a3::a4::rest ->
11111113
f a0 (f a1 (f a2 (f a3 (f a4 (fold_right f rest acc)))))
11121114

1115+
let rec fold_right2 f l r acc =
1116+
match l,r with
1117+
| [],[] -> acc
1118+
| [a0],[b0] -> f a0 b0 acc
1119+
| [a0;a1],[b0;b1] -> f a0 b0 (f a1 b1 acc)
1120+
| [a0;a1;a2],[b0;b1;b2] -> f a0 b0 (f a1 b1 (f a2 b2 acc))
1121+
| [a0;a1;a2;a3],[b0;b1;b2;b3] ->
1122+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 acc)))
1123+
| [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] ->
1124+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc))))
1125+
| a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest ->
1126+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 f arest brest acc)))))
1127+
| _, _ -> invalid_arg "Ext_list.fold_right2"
1128+
1129+
1130+
11131131
let rec filter_map (f: 'a -> 'b option) xs =
11141132
match xs with
11151133
| [] -> []
@@ -1249,13 +1267,6 @@ let rec map_last f l1 =
12491267
| a1::l1 -> let r = f false a1 in r :: map_last f l1
12501268

12511269

1252-
(* let rec fold_right2_last f l1 l2 accu =
1253-
match (l1, l2) with
1254-
| ([], []) -> accu
1255-
| [last1], [last2] -> f true last1 last2 accu
1256-
| (a1::l1, a2::l2) -> f false a1 a2 (fold_right2_last f l1 l2 accu)
1257-
| (_, _) -> invalid_arg "List.fold_right2" *)
1258-
12591270

12601271
let init n f =
12611272
Array.to_list (Array.init n f)

‎jscomp/bin/bsdep.ml

+20-9
Original file line numberDiff line numberDiff line change
@@ -23925,6 +23925,8 @@ val map_append : ('b -> 'a) -> 'b list -> 'a list -> 'a list
2392523925

2392623926
val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
2392723927

23928+
val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
23929+
2392823930
(** Extension to the standard library [List] module *)
2392923931

2393023932
(** TODO some function are no efficiently implemented. *)
@@ -24175,6 +24177,22 @@ let rec fold_right f l acc =
2417524177
| a0::a1::a2::a3::a4::rest ->
2417624178
f a0 (f a1 (f a2 (f a3 (f a4 (fold_right f rest acc)))))
2417724179

24180+
let rec fold_right2 f l r acc =
24181+
match l,r with
24182+
| [],[] -> acc
24183+
| [a0],[b0] -> f a0 b0 acc
24184+
| [a0;a1],[b0;b1] -> f a0 b0 (f a1 b1 acc)
24185+
| [a0;a1;a2],[b0;b1;b2] -> f a0 b0 (f a1 b1 (f a2 b2 acc))
24186+
| [a0;a1;a2;a3],[b0;b1;b2;b3] ->
24187+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 acc)))
24188+
| [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] ->
24189+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc))))
24190+
| a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest ->
24191+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 f arest brest acc)))))
24192+
| _, _ -> invalid_arg "Ext_list.fold_right2"
24193+
24194+
24195+
2417824196
let rec filter_map (f: 'a -> 'b option) xs =
2417924197
match xs with
2418024198
| [] -> []
@@ -24314,13 +24332,6 @@ let rec map_last f l1 =
2431424332
| a1::l1 -> let r = f false a1 in r :: map_last f l1
2431524333

2431624334

24317-
(* let rec fold_right2_last f l1 l2 accu =
24318-
match (l1, l2) with
24319-
| ([], []) -> accu
24320-
| [last1], [last2] -> f true last1 last2 accu
24321-
| (a1::l1, a2::l2) -> f false a1 a2 (fold_right2_last f l1 l2 accu)
24322-
| (_, _) -> invalid_arg "List.fold_right2" *)
24323-
2432424335

2432524336
let init n f =
2432624337
Array.to_list (Array.init n f)
@@ -27190,7 +27201,7 @@ let from_labels ~loc arity labels
2719027201
(Typ.object_ ~loc
2719127202
(List.map2 (fun x y -> x.Asttypes.txt ,[], y) labels tyvars) Closed)
2719227203
in
27193-
List.fold_right2
27204+
Ext_list.fold_right2
2719427205
(fun {Asttypes.loc ; txt = label }
2719527206
tyvar acc -> Typ.arrow ~loc label tyvar acc) labels tyvars result_type
2719627207

@@ -33670,7 +33681,7 @@ let ocaml_obj_as_js_object
3367033681
Location.raise_errorf ~loc "Only method support currently"
3367133682
) clfs ([], [], [], false) in
3367233683
let pval_type =
33673-
List.fold_right2
33684+
Ext_list.fold_right2
3367433685
(fun label label_type acc ->
3367533686
Typ.arrow
3367633687
~loc:label.Asttypes.loc

‎jscomp/bin/bsppx.ml

+20-9
Original file line numberDiff line numberDiff line change
@@ -5874,6 +5874,8 @@ val map_append : ('b -> 'a) -> 'b list -> 'a list -> 'a list
58745874

58755875
val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
58765876

5877+
val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
5878+
58775879
(** Extension to the standard library [List] module *)
58785880

58795881
(** TODO some function are no efficiently implemented. *)
@@ -6124,6 +6126,22 @@ let rec fold_right f l acc =
61246126
| a0::a1::a2::a3::a4::rest ->
61256127
f a0 (f a1 (f a2 (f a3 (f a4 (fold_right f rest acc)))))
61266128

6129+
let rec fold_right2 f l r acc =
6130+
match l,r with
6131+
| [],[] -> acc
6132+
| [a0],[b0] -> f a0 b0 acc
6133+
| [a0;a1],[b0;b1] -> f a0 b0 (f a1 b1 acc)
6134+
| [a0;a1;a2],[b0;b1;b2] -> f a0 b0 (f a1 b1 (f a2 b2 acc))
6135+
| [a0;a1;a2;a3],[b0;b1;b2;b3] ->
6136+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 acc)))
6137+
| [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] ->
6138+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc))))
6139+
| a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest ->
6140+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 f arest brest acc)))))
6141+
| _, _ -> invalid_arg "Ext_list.fold_right2"
6142+
6143+
6144+
61276145
let rec filter_map (f: 'a -> 'b option) xs =
61286146
match xs with
61296147
| [] -> []
@@ -6263,13 +6281,6 @@ let rec map_last f l1 =
62636281
| a1::l1 -> let r = f false a1 in r :: map_last f l1
62646282

62656283

6266-
(* let rec fold_right2_last f l1 l2 accu =
6267-
match (l1, l2) with
6268-
| ([], []) -> accu
6269-
| [last1], [last2] -> f true last1 last2 accu
6270-
| (a1::l1, a2::l2) -> f false a1 a2 (fold_right2_last f l1 l2 accu)
6271-
| (_, _) -> invalid_arg "List.fold_right2" *)
6272-
62736284

62746285
let init n f =
62756286
Array.to_list (Array.init n f)
@@ -9139,7 +9150,7 @@ let from_labels ~loc arity labels
91399150
(Typ.object_ ~loc
91409151
(List.map2 (fun x y -> x.Asttypes.txt ,[], y) labels tyvars) Closed)
91419152
in
9142-
List.fold_right2
9153+
Ext_list.fold_right2
91439154
(fun {Asttypes.loc ; txt = label }
91449155
tyvar acc -> Typ.arrow ~loc label tyvar acc) labels tyvars result_type
91459156

@@ -16788,7 +16799,7 @@ let ocaml_obj_as_js_object
1678816799
Location.raise_errorf ~loc "Only method support currently"
1678916800
) clfs ([], [], [], false) in
1679016801
let pval_type =
16791-
List.fold_right2
16802+
Ext_list.fold_right2
1679216803
(fun label label_type acc ->
1679316804
Typ.arrow
1679416805
~loc:label.Asttypes.loc

‎jscomp/bin/whole_compiler.ml

+24-13
Original file line numberDiff line numberDiff line change
@@ -22375,6 +22375,8 @@ val map_append : ('b -> 'a) -> 'b list -> 'a list -> 'a list
2237522375

2237622376
val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
2237722377

22378+
val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
22379+
2237822380
(** Extension to the standard library [List] module *)
2237922381

2238022382
(** TODO some function are no efficiently implemented. *)
@@ -22625,6 +22627,22 @@ let rec fold_right f l acc =
2262522627
| a0::a1::a2::a3::a4::rest ->
2262622628
f a0 (f a1 (f a2 (f a3 (f a4 (fold_right f rest acc)))))
2262722629

22630+
let rec fold_right2 f l r acc =
22631+
match l,r with
22632+
| [],[] -> acc
22633+
| [a0],[b0] -> f a0 b0 acc
22634+
| [a0;a1],[b0;b1] -> f a0 b0 (f a1 b1 acc)
22635+
| [a0;a1;a2],[b0;b1;b2] -> f a0 b0 (f a1 b1 (f a2 b2 acc))
22636+
| [a0;a1;a2;a3],[b0;b1;b2;b3] ->
22637+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 acc)))
22638+
| [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] ->
22639+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc))))
22640+
| a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest ->
22641+
f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 f arest brest acc)))))
22642+
| _, _ -> invalid_arg "Ext_list.fold_right2"
22643+
22644+
22645+
2262822646
let rec filter_map (f: 'a -> 'b option) xs =
2262922647
match xs with
2263022648
| [] -> []
@@ -22764,13 +22782,6 @@ let rec map_last f l1 =
2276422782
| a1::l1 -> let r = f false a1 in r :: map_last f l1
2276522783

2276622784

22767-
(* let rec fold_right2_last f l1 l2 accu =
22768-
match (l1, l2) with
22769-
| ([], []) -> accu
22770-
| [last1], [last2] -> f true last1 last2 accu
22771-
| (a1::l1, a2::l2) -> f false a1 a2 (fold_right2_last f l1 l2 accu)
22772-
| (_, _) -> invalid_arg "List.fold_right2" *)
22773-
2277422785

2277522786
let init n f =
2277622787
Array.to_list (Array.init n f)
@@ -26460,7 +26471,7 @@ let from_labels ~loc arity labels
2646026471
(Typ.object_ ~loc
2646126472
(List.map2 (fun x y -> x.Asttypes.txt ,[], y) labels tyvars) Closed)
2646226473
in
26463-
List.fold_right2
26474+
Ext_list.fold_right2
2646426475
(fun {Asttypes.loc ; txt = label }
2646526476
tyvar acc -> Typ.arrow ~loc label tyvar acc) labels tyvars result_type
2646626477

@@ -90765,7 +90776,7 @@ let subst name export_set stats =
9076590776
(* (Js_dump.string_of_block [st]); *)
9076690777
Js_op_util.update_used_stats v.ident_info Dead_pure;
9076790778
let block =
90768-
List.fold_right2 (fun param arg acc -> S.define ~kind:Variable param arg :: acc)
90779+
Ext_list.fold_right2 (fun param arg acc -> S.define ~kind:Variable param arg :: acc)
9076990780
params args ( self#block block) (* see #278 before changes*)
9077090781

9077190782
in
@@ -91971,7 +91982,7 @@ let handle_exports (meta : Lam_stats.t)
9197191982
let len = List.length original_exports in
9197291983
let tbl = String_hash_set.create len in
9197391984
let ({export_list ; export_set ; groups = coercion_groups } as result) =
91974-
List.fold_right2
91985+
Ext_list.fold_right2
9197591986
(fun (original_export_id : Ident.t) (lam : Lam.t) (acc : t) ->
9197691987
let original_name = original_export_id.name in
9197791988
if not @@ String_hash_set.check_add tbl original_name then
@@ -100726,10 +100737,10 @@ let subst_helper (subst : subst_tbl) (query : int -> int) lam =
100726100737
let handler = to_lam handler in
100727100738
let ys = Ext_list.map Ident.rename xs in
100728100739
let env =
100729-
List.fold_right2
100740+
Ext_list.fold_right2
100730100741
(fun x y t -> Ident_map.add x (Lam.var y) t)
100731100742
xs ys Ident_map.empty in
100732-
List.fold_right2
100743+
Ext_list.fold_right2
100733100744
(fun y l r -> Lam.let_ Alias y l r)
100734100745
ys ls
100735100746
(Lam_subst.subst env handler)
@@ -107947,7 +107958,7 @@ let ocaml_obj_as_js_object
107947107958
Location.raise_errorf ~loc "Only method support currently"
107948107959
) clfs ([], [], [], false) in
107949107960
let pval_type =
107950-
List.fold_right2
107961+
Ext_list.fold_right2
107951107962
(fun label label_type acc ->
107952107963
Typ.arrow
107953107964
~loc:label.Asttypes.loc

‎jscomp/core/js_pass_tailcall_inline.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -211,7 +211,7 @@ let subst name export_set stats =
211211
(* (Js_dump.string_of_block [st]); *)
212212
Js_op_util.update_used_stats v.ident_info Dead_pure;
213213
let block =
214-
List.fold_right2 (fun param arg acc -> S.define ~kind:Variable param arg :: acc)
214+
Ext_list.fold_right2 (fun param arg acc -> S.define ~kind:Variable param arg :: acc)
215215
params args ( self#block block) (* see #278 before changes*)
216216

217217
in

‎jscomp/core/lam_coercion.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -92,7 +92,7 @@ let handle_exports (meta : Lam_stats.t)
9292
let len = List.length original_exports in
9393
let tbl = String_hash_set.create len in
9494
let ({export_list ; export_set ; groups = coercion_groups } as result) =
95-
List.fold_right2
95+
Ext_list.fold_right2
9696
(fun (original_export_id : Ident.t) (lam : Lam.t) (acc : t) ->
9797
let original_name = original_export_id.name in
9898
if not @@ String_hash_set.check_add tbl original_name then

0 commit comments

Comments
 (0)