Flip fold_right2 order

Author: bobzhang

jscomp/bin/all_ounit_tests.ml

@@ -6150,7 +6150,11 @@ val map_append :  ('b -> 'a) -> 'b list -> 'a list -> 'a list
 
 val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
 
-val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
+val fold_right2 : 
+  'a list -> 
+  'b list -> 
+  'c -> 
+  ('a -> 'b -> 'c -> 'c) ->  'c
 
 val map2 : 
   ('a -> 'b -> 'c) ->
@@ -6159,10 +6163,11 @@ val map2 :
   'c list
 
 val fold_left_with_offset : 
-  (int -> 'acc -> 'a -> 'acc) -> 
-  int -> 
+  'a list -> 
   'acc -> 
-  'a list -> 'acc 
+  int -> 
+  ('a -> 'acc ->  int ->  'acc) ->   
+  'acc 
 
 
 (** @unused *)
@@ -6511,7 +6516,7 @@ let rec fold_right f l acc =
   | a0::a1::a2::a3::a4::rest -> 
     f a0 (f a1 (f a2 (f a3 (f a4 (fold_right f rest acc)))))  
 
-let rec fold_right2 f l r acc = 
+let rec fold_right2 l r acc f = 
   match l,r  with  
   | [],[] -> acc 
   | [a0],[b0] -> f a0 b0 acc 
@@ -6522,7 +6527,7 @@ let rec fold_right2 f l r acc =
   | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> 
     f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc))))
   | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> 
-    f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 f arest brest acc)))))  
+    f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 arest brest acc f )))))  
   | _, _ -> invalid_arg "Ext_list.fold_right2"
 
 let rec map2 f l r = 
@@ -6560,10 +6565,15 @@ let rec map2 f l r =
     c0::c1::c2::c3::c4::map2 f arest brest
   | _, _ -> invalid_arg "Ext_list.map2"
 
-let rec fold_left_with_offset f i accu l =
+let rec fold_left_with_offset l accu i f =
   match l with
   | [] -> accu
-  | a::l -> fold_left_with_offset f (succ i) (f i accu a) l
+  | a::l -> 
+    fold_left_with_offset 
+    l     
+    (f  a accu  i)  
+    (i + 1)
+    f  
 
 
 let rec filter_map (f: 'a -> 'b option) xs = 

jscomp/core/js_pass_tailcall_inline.ml

@@ -212,10 +212,9 @@ let subst name export_set stats  =
             Js_op_util.update_used_stats v.ident_info Dead_pure;
             let block  = 
               Ext_list.fold_right2 
+              params args  ( self#block block) (* see #278 before changes*)
               (fun param arg acc ->  
-                S.define_variable ~kind:Variable param arg :: acc)
-                params args  ( self#block block) (* see #278 before changes*)
-                                
+                S.define_variable ~kind:Variable param arg :: acc)                                                
             in
             (* Mark a function as dead means it will never be scanned, 
                here we inline the function

jscomp/core/lam_coercion.ml

@@ -92,7 +92,9 @@ let handle_exports (meta : Lam_stats.t)
   let len = List.length original_exports in
   let tbl = String_hash_set.create len in
   let ({export_list ; export_set  ;  groups = coercion_groups } as result)  =
-    Ext_list.fold_right2
+    Ext_list.fold_right2 original_exports
+      lambda_exports
+      {export_list = []; export_set = original_export_set; export_map = Ident_map.empty; groups = []}
       (fun  (original_export_id : Ident.t) (lam : Lam.t) (acc : t)  ->
          let original_name = original_export_id.name in
          if not @@ String_hash_set.check_add tbl original_name then
@@ -151,9 +153,7 @@ let handle_exports (meta : Lam_stats.t)
               groups = Single(Strict, newid, lam) :: acc.groups
             })
       )
-      original_exports
-      lambda_exports
-      {export_list = []; export_set = original_export_set; export_map = Ident_map.empty; groups = []}
+      
 
   in
 

jscomp/core/lam_compile.ml

@@ -1315,8 +1315,10 @@ and
       (* [i] is the jump table, [largs] is the arguments passed to [Lstaticcatch]*)
       begin
         match Lam_compile_context.find_exn i cxt  with
-        | {exit_id; args ; order_id} ->
-          Ext_list.fold_right2
+        | {exit_id; bindings ; order_id} ->
+          Ext_list.fold_right2 largs bindings
+           (Js_output.make [S.assign exit_id (E.small_int  order_id)]
+              ~value:E.undefined)
            (fun (x : Lam.t) (arg: Ident.t) acc ->
             let new_output =
                 match x with
@@ -1327,9 +1329,7 @@ and
                   compile_lambda {cxt with st = Assign arg ; should_return =  ReturnFalse} x
             in Js_output.append_output new_output acc
            )
-           largs args
-           (Js_output.make [S.assign exit_id (E.small_int  order_id)]
-              ~value:E.undefined)
+           
         | exception Not_found ->
           assert false
           (* staticraise is always enclosed by catch  *)

jscomp/core/lam_compile_context.ml

@@ -30,7 +30,7 @@ type jbl_label = int
 module HandlerMap = Int_map
 type value = {
   exit_id : Ident.t ;
-  args : Ident.t list ;
+  bindings : Ident.t list ;
   order_id : int
 }
 
@@ -85,17 +85,20 @@ type handler = {
 
 (* always keep key id positive, specifically no [0] generated *)
 let add_jmps 
-    m 
+    (m  : jmp_table)
     exit_id code_table
     = 
   let map, handlers = 
-    Ext_list.fold_left_with_offset
-      (fun order_id (acc,handlers)
-        { label = l; handler = lam; bindings = args}
+    Ext_list.fold_left_with_offset 
+      code_table (m,[]) 
+      (HandlerMap.cardinal m + 1 ) 
+      (fun { label; handler; bindings}
+        (acc,handlers)        
+        order_id 
         ->     
-          HandlerMap.add l {exit_id;args; order_id } acc, 
-          (order_id,lam)::handlers
-      ) (HandlerMap.cardinal m + 1 )  (m,[]) code_table in 
+          HandlerMap.add label {exit_id; bindings; order_id } acc, 
+          (order_id,handler)::handlers
+      )   in 
   map, List.rev handlers
 
 

jscomp/core/lam_compile_context.mli

@@ -42,7 +42,7 @@ type jbl_label = int
 
 type value = {
     exit_id : Ident.t ; 
-    args : Ident.t list ;
+    bindings : Ident.t list ;
     order_id : int
   }
 

jscomp/core/lam_pass_deep_flatten.ml

@@ -155,29 +155,29 @@ let deep_flatten
            ..
         ]}
       *)
-      let (res,l) = flatten acc arg  in
+      let (res,accux) = flatten acc arg  in
       begin match id.name, str, res with
         | ("match" | "include"| "param"),
           (Alias | Strict | StrictOpt),
           Lprim {primitive = Pmakeblock(_,_, Immutable); args} ->
           begin match eliminate_tuple id body Int_map.empty with
             | Some (tuple_mapping, body) ->
               flatten (
-                Ext_list.fold_left_with_offset
-                  (fun i acc (arg : Lam.t) ->
+                Ext_list.fold_left_with_offset args accux  0
+                  (fun arg  acc i ->
                      match Int_map.find_opt i tuple_mapping with
                      | None ->
                         Lam_group.nop_cons arg acc
                      | Some key ->
                        Lam_group.single str key arg :: acc
                   )
-                  0
-                  l args
+                  
+                  
               ) body
             | None ->
-              flatten (Single(str, id, res ) :: l) body
+              flatten (Single(str, id, res ) :: accux) body
           end
-        | _ -> flatten (Single(str, id, res ) :: l) body
+        | _ -> flatten (Single(str, id, res ) :: accux) body
       end
     | Lletrec (bind_args, body) ->
 

jscomp/core/lam_pass_exits.ml

@@ -247,13 +247,11 @@ let subst_helper (subst : subst_tbl) (query : int -> int) lam =
           let handler = to_lam handler in 
           let ys = Ext_list.map xs Ident.rename in
           let env =
-            Ext_list.fold_right2
+            Ext_list.fold_right2 xs ys Ident_map.empty 
               (fun x y t -> Ident_map.add x (Lam.var y) t)
-              xs ys Ident_map.empty in
-          Ext_list.fold_right2
+              in
+          Ext_list.fold_right2 ys ls (Lam_subst.subst  env  handler)
             (fun y l r -> Lam.let_ Strict y l r)
-            ys ls 
-            (Lam_subst.subst  env  handler)
         | None -> Lam.staticraise i ls
       end
     | Lstaticcatch (l1,(i,xs),l2) ->

jscomp/ext/ext_list.ml

@@ -190,7 +190,7 @@ let rec fold_right f l acc =
   | a0::a1::a2::a3::a4::rest -> 
     f a0 (f a1 (f a2 (f a3 (f a4 (fold_right f rest acc)))))  
 
-let rec fold_right2 f l r acc = 
+let rec fold_right2 l r acc f = 
   match l,r  with  
   | [],[] -> acc 
   | [a0],[b0] -> f a0 b0 acc 
@@ -201,7 +201,7 @@ let rec fold_right2 f l r acc =
   | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> 
     f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc))))
   | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> 
-    f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 f arest brest acc)))))  
+    f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 arest brest acc f )))))  
   | _, _ -> invalid_arg "Ext_list.fold_right2"
 
 let rec map2 f l r = 
@@ -239,10 +239,15 @@ let rec map2 f l r =
     c0::c1::c2::c3::c4::map2 f arest brest
   | _, _ -> invalid_arg "Ext_list.map2"
 
-let rec fold_left_with_offset f i accu l =
+let rec fold_left_with_offset l accu i f =
   match l with
   | [] -> accu
-  | a::l -> fold_left_with_offset f (succ i) (f i accu a) l
+  | a::l -> 
+    fold_left_with_offset 
+    l     
+    (f  a accu  i)  
+    (i + 1)
+    f  
 
 
 let rec filter_map (f: 'a -> 'b option) xs = 

jscomp/ext/ext_list.mli

@@ -46,7 +46,11 @@ val map_append :  ('b -> 'a) -> 'b list -> 'a list -> 'a list
 
 val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
 
-val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
+val fold_right2 : 
+  'a list -> 
+  'b list -> 
+  'c -> 
+  ('a -> 'b -> 'c -> 'c) ->  'c
 
 val map2 : 
   ('a -> 'b -> 'c) ->
@@ -55,10 +59,11 @@ val map2 :
   'c list
 
 val fold_left_with_offset : 
-  (int -> 'acc -> 'a -> 'acc) -> 
-  int -> 
+  'a list -> 
   'acc -> 
-  'a list -> 'acc 
+  int -> 
+  ('a -> 'acc ->  int ->  'acc) ->   
+  'acc 
 
 
 (** @unused *)

jscomp/syntax/ast_core_type.ml

@@ -131,9 +131,10 @@ let from_labels ~loc arity labels
       (Ast_compatible.object_ ~loc
          (Ext_list.map2 (fun x y -> x.Asttypes.txt ,[], y) labels tyvars) Closed)
   in
-  Ext_list.fold_right2
-    (fun {Asttypes.loc ; txt = label }
-      tyvar acc -> Ast_compatible.label_arrow ~loc label tyvar acc) labels tyvars  result_type
+  Ext_list.fold_right2 labels tyvars  result_type
+    (fun label (* {loc ; txt = label }*)
+      tyvar acc -> 
+      Ast_compatible.label_arrow ~loc:label.loc label.txt tyvar acc) 
 
 
 let make_obj ~loc xs =

jscomp/syntax/ast_tuple_pattern_flatten.ml

@@ -100,7 +100,7 @@ let flattern_tuple_pattern_vb
           Ext_list.same_length es xs
         ->
         Bs_ast_invariant.warn_unused_attributes tuple_attributes ; (* will be dropped*)
-        (Ext_list.fold_right2 (fun pat exp acc->
+        Ext_list.fold_right2 xs es acc (fun pat exp acc->
              {Parsetree.
                pvb_pat =
                  pat;
@@ -120,7 +120,7 @@ let flattern_tuple_pattern_vb
                pvb_attributes;
                pvb_loc ;
              } :: acc
-           ) xs es) acc
+           ) 
       | _ ->
         {pvb_pat ;
          pvb_expr ;

jscomp/syntax/ast_util.ml

@@ -609,13 +609,13 @@ let ocaml_obj_as_js_object
           Location.raise_errorf ~loc "Only method support currently"
       ) clfs  ([], [], [], false) in
   let pval_type =
-    Ext_list.fold_right2
+    Ext_list.fold_right2  labels label_types public_obj_type
       (fun label label_type acc ->
          Ast_compatible.label_arrow
            ~loc:label.Asttypes.loc
            label.Asttypes.txt
            label_type acc           
-      ) labels label_types public_obj_type in
+      ) in
   Ast_external_mk.local_extern_cont
     loc
     ~pval_prim:(External_process.pval_prim_of_labels labels)

lib/bsb.ml

@@ -2363,7 +2363,11 @@ val map_append :  ('b -> 'a) -> 'b list -> 'a list -> 'a list
 
 val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
 
-val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
+val fold_right2 : 
+  'a list -> 
+  'b list -> 
+  'c -> 
+  ('a -> 'b -> 'c -> 'c) ->  'c
 
 val map2 : 
   ('a -> 'b -> 'c) ->
@@ -2372,10 +2376,11 @@ val map2 :
   'c list
 
 val fold_left_with_offset : 
-  (int -> 'acc -> 'a -> 'acc) -> 
-  int -> 
+  'a list -> 
   'acc -> 
-  'a list -> 'acc 
+  int -> 
+  ('a -> 'acc ->  int ->  'acc) ->   
+  'acc 
 
 
 (** @unused *)
@@ -2724,7 +2729,7 @@ let rec fold_right f l acc =
   | a0::a1::a2::a3::a4::rest -> 
     f a0 (f a1 (f a2 (f a3 (f a4 (fold_right f rest acc)))))  
 
-let rec fold_right2 f l r acc = 
+let rec fold_right2 l r acc f = 
   match l,r  with  
   | [],[] -> acc 
   | [a0],[b0] -> f a0 b0 acc 
@@ -2735,7 +2740,7 @@ let rec fold_right2 f l r acc =
   | [a0;a1;a2;a3;a4], [b0;b1;b2;b3;b4] -> 
     f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 acc))))
   | a0::a1::a2::a3::a4::arest, b0::b1::b2::b3::b4::brest -> 
-    f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 f arest brest acc)))))  
+    f a0 b0 (f a1 b1 (f a2 b2 (f a3 b3 (f a4 b4 (fold_right2 arest brest acc f )))))  
   | _, _ -> invalid_arg "Ext_list.fold_right2"
 
 let rec map2 f l r = 
@@ -2773,10 +2778,15 @@ let rec map2 f l r =
     c0::c1::c2::c3::c4::map2 f arest brest
   | _, _ -> invalid_arg "Ext_list.map2"
 
-let rec fold_left_with_offset f i accu l =
+let rec fold_left_with_offset l accu i f =
   match l with
   | [] -> accu
-  | a::l -> fold_left_with_offset f (succ i) (f i accu a) l
+  | a::l -> 
+    fold_left_with_offset 
+    l     
+    (f  a accu  i)  
+    (i + 1)
+    f  
 
 
 let rec filter_map (f: 'a -> 'b option) xs =