refactoring using apply_info

jscomp/lam.ml

@@ -33,10 +33,16 @@ and prim_info =
   { primitive : primitive ; 
     args : t list ; 
   }
+and apply_info = 
+  { fn : t ; 
+    args : t list ; 
+    loc : Location.t;
+    status : Lambda.apply_status
+  }
 and t = 
   | Lvar of Ident.t
   | Lconst of Lambda.structured_constant
-  | Lapply of t * t list * Lambda.apply_info
+  | Lapply of apply_info
   | Lfunction of int * Lambda.function_kind  * Ident.t list * t
   | Llet of Lambda.let_kind * Ident.t * t * t
   | Lletrec of (Ident.t * t) list * t
@@ -104,7 +110,9 @@ type unop = t -> t
 
 let var id : t = Lvar id
 let const ct : t = Lconst ct 
-let apply fn args info : t = Lapply(fn,args, info)
+let apply fn args loc status : t = 
+  Lapply { fn; args;  loc  ;
+           status }
 let function_ arity kind ids body : t = 
   Lfunction(arity, kind, ids, body)
 
@@ -379,7 +387,8 @@ let rec convert (lam : Lambda.lambda) : t =
   | Lconst x -> 
     Lconst x 
   | Lapply (fn,args,info) 
-    -> Lapply(convert fn,List.map convert args,info)
+    ->  apply (convert fn) (List.map convert args) 
+          info.apply_loc info.apply_status
   | Lfunction (kind,ids,body)
     ->  function_ (List.length ids) kind ids (convert body)
   | Llet (kind,id,e,body) 

jscomp/lam.mli

@@ -31,14 +31,21 @@ type switch  =
     sw_numblocks: int;
     sw_blocks: (int * t) list;
     sw_failaction : t option}
+and apply_info = private
+  { fn : t ; 
+    args : t list ; 
+    loc : Location.t;
+    status : Lambda.apply_status
+  }
+
 and prim_info = private
   { primitive : primitive ; 
     args : t list ; 
   }
 and  t =  private
   | Lvar of Ident.t
   | Lconst of Lambda.structured_constant
-  | Lapply of t * t list * Lambda.apply_info
+  | Lapply of apply_info
   | Lfunction of int (* length *) * Lambda.function_kind * Ident.t list * t
   | Llet of Lambda.let_kind * Ident.t * t * t
   | Lletrec of (Ident.t * t) list * t
@@ -74,7 +81,8 @@ type unop = t ->  t
 
 val var : Ident.t -> t
 val const : Lambda.structured_constant -> t
-val apply : t -> t list -> Lambda.apply_info -> t
+
+val apply : t -> t list -> Location.t -> Lambda.apply_status -> t
 val function_ : int -> Lambda.function_kind -> Ident.t list -> t -> t
 val let_ : Lambda.let_kind -> Ident.t -> t -> t -> t
 val letrec : (Ident.t * t) list -> t -> t

jscomp/lam_analysis.ml

@@ -252,8 +252,8 @@ let rec size (lam : Lam.t) =
         {var $$let=Make(funarg);
         return [0, $$let[5],... $$let[16]]}
      *)      
-    | Lapply(f,
-             args, _) -> size_lams (size f) args
+    | Lapply{ fn;
+             args; _} -> size_lams (size fn) args
     (* | Lfunction(_, params, l) -> really_big () *)
     | Lfunction(_, _ ,_params,body) -> size body 
     | Lswitch(_, _) -> really_big ()
@@ -294,7 +294,7 @@ let rec eq_lambda (l1 : Lam.t) (l2 : Lam.t) =
   match (l1, l2) with
   | Lvar i1, Lvar i2 -> Ident.same i1 i2
   | Lconst c1, Lconst c2 -> c1 = c2 (* *)
-  | Lapply (l1,args1,_), Lapply(l2,args2,_) ->
+  | Lapply {fn = l1; args = args1; _}, Lapply {fn = l2; args = args2; _} ->
     eq_lambda l1 l2  && List.for_all2 eq_lambda args1 args2
   | Lfunction _ , Lfunction _ -> false (* TODO -- simple functions ?*)
   | Lassign(v0,l0), Lassign(v1,l1) -> Ident.same v0 v1 && eq_lambda l0 l1
@@ -402,7 +402,7 @@ let free_variables (export_idents : Ident_set.t ) (params : stats Ident_map.t )
     match lam with 
     | Lvar v -> map_use top v 
     | Lconst _ -> ()
-    | Lapply(fn, args, _) ->
+    | Lapply {fn; args; _} ->
       iter top  fn; 
       let top = new_env fn top in
       List.iter (iter top ) args  

jscomp/lam_beta_reduce.ml

@@ -118,10 +118,10 @@ let rewrite (map :   (Ident.t, _) Hashtbl.t)
     | Lprim {primitive; args } ->
       (* here it makes sure that global vars are not rebound *)      
       Lam.prim primitive (List.map aux  args)
-    | Lapply(fn, args, info) ->
+    | Lapply {fn;  args; loc;  status } ->
       let fn = aux fn in       
       let args = List.map aux  args in 
-      Lam.apply fn  args info
+      Lam.apply fn  args loc status
     | Lswitch(l, {sw_failaction; 
                   sw_consts; 
                   sw_blocks;

jscomp/lam_beta_reduce_util.ml

@@ -87,7 +87,7 @@ let simple_beta_reduce params body args =
       Hashtbl.clear param_hash ;
       None
     end
-  | Lapply (Lvar fn_name as f , args', info)
+  | Lapply { fn = Lvar fn_name as f ; args =  args';  loc; status}
     ->  
     let () = 
       List.iter2 (fun p a -> Hashtbl.add param_hash p {lambda = a; used = false }) params args  
@@ -106,7 +106,7 @@ let simple_beta_reduce params body args =
                if not used then 
                  Lam.seq lambda code
                else code )
-            param_hash (Lam.apply  f us  info) in
+            param_hash (Lam.apply  f us  loc status) in
         Hashtbl.clear param_hash;
         Some result 
       | exception _ -> 

jscomp/lam_compile.ml

@@ -500,28 +500,29 @@ and
                              jmp_table = Lam_compile_defs.empty_handler_map}  body)))
 
 
-    | Lapply(
-        Lapply(an, args', ({apply_status = App_na} as _info1)),
-        args, 
-        ({apply_status = App_na} as _info2))
+    | Lapply{
+        fn = Lapply{ fn = an; args =  args'; status = App_na ; };
+        args;  
+        status = App_na; loc }
       ->    
       (* After inlining we can generate such code, 
          see {!Ari_regress_test}         
       *)      
       compile_lambda  cxt  
-        (Lam.apply an (args' @ args) (Lam_util.mk_apply_info App_na))
+        (Lam.apply an (args' @ args)  loc  App_na )
     (* External function calll *)
-    | Lapply(Lprim{primitive = Pfield (n,_); 
-                   args = [ Lprim {primitive = Pgetglobal id; args = []}];_},
-             args_lambda,
-             {apply_status = App_na | App_ml_full}) ->
+    | Lapply{ fn = 
+                Lprim{primitive = Pfield (n,_); 
+                      args = [ Lprim {primitive = Pgetglobal id; args = []}];_};
+             args = args_lambda;
+             status = App_na | App_ml_full} ->
       (* Note we skip [App_js_full] since [get_exp_with_args] dont carry 
          this information, we should fix [get_exp_with_args]
       *)
       get_exp_with_args cxt lam  args_lambda id n  env
 
 
-    | Lapply(fn,args_lambda,  info) -> 
+    | Lapply{ fn; args = args_lambda;   status} -> 
       (* TODO: --- 
          1. check arity, can be simplified for pure expression
          2. no need create names
@@ -623,12 +624,12 @@ and
           | _ -> 
 
             Js_output.handle_block_return st should_return lam args_code 
-              (E.call ~info:(match fn, info with 
-                   | _, { apply_status = App_ml_full} -> 
+              (E.call ~info:(match fn, status with 
+                   | _,  App_ml_full -> 
                      {arity = Full ; call_info = Call_ml}
-                   | _, { apply_status = App_js_full} -> 
+                   | _,  App_js_full -> 
                      {arity = Full ; call_info = Call_na}
-                   | _,  { apply_status = App_na} -> 
+                   | _,   App_na -> 
                      {arity = NA; call_info = Call_ml }
                  ) fn_code args) 
         end;
@@ -863,8 +864,8 @@ and
               if not @@ Ext_string.ends_with setter Literals.setter_suffix then 
                 compile_lambda cxt @@ 
                 Lam.apply fn [arg]  
-                  {apply_loc = Location.none;
-                   apply_status = App_js_full}
+                   Location.none (* TODO *)
+                   App_js_full
               else 
                 let property =
                   String.sub setter 0 
@@ -884,8 +885,8 @@ and
         | fn :: rest -> 
           compile_lambda cxt 
             (Lam.apply fn rest 
-                     {apply_loc = Location.none;
-                      apply_status = App_js_full})
+                      Location.none (*TODO*)
+                      App_js_full)
         | _ -> assert false 
       else 
         begin match args_lambda with 
@@ -917,7 +918,7 @@ and
                      @@ 
                        Lam.apply fn
                          [Lam.unit]
-                     Lam_util.default_apply_info
+                         Location.none App_na
                     )
               end
             else 
@@ -933,7 +934,8 @@ and
                          kind first (Lam.function_ (len - arity) kind rest body))
                   else 
                     compile_lambda cxt 
-                      (Lam_util.eta_conversion arity Lam_util.default_apply_info  
+                      (Lam_util.eta_conversion arity 
+                         Location.none App_na
                          fn  [] )
                 (* let extra_args = Ext_list.init (arity - len) (fun _ ->   (Ident.create Literals.param)) in *)
                 (* let extra_lambdas = List.map (fun x -> Lambda.Lvar x) extra_args in *)
@@ -952,7 +954,8 @@ and
                 *)
                 | _ -> 
                   compile_lambda cxt 
-                    (Lam_util.eta_conversion arity Lam_util.default_apply_info  fn  [] )
+                    (Lam_util.eta_conversion arity
+                       Location.none App_na  fn  [] )
               end
           | _ -> assert false 
         end

jscomp/lam_exit_code.ml

@@ -33,7 +33,7 @@ let rec has_exit_code exits  (lam : Lam.t)  : bool =
   | Lconst _ 
   | Lfunction _ (* static exit can not across function boundary *)
     -> false
-  | Lapply (l,args,_apply_info) 
+  | Lapply {fn = l; args; _ } 
     -> has_exit_code exits l || List.exists (fun x -> has_exit_code exits x ) args 
 
   | Llet (_kind,_id,v,body) 

jscomp/lam_group.ml

@@ -284,8 +284,8 @@ let deep_flatten
     (*   when  List.length params = List.length args -> *)
     (*       aux (beta_reduce params body args) *)
 
-    | Lapply(l1, ll, info) -> 
-      Lam.apply (aux l1) (List.map aux ll) info
+    | Lapply{fn = l1; args  = ll; loc; status} -> 
+      Lam.apply (aux l1) (List.map aux ll) loc status
 
     (* This kind of simple optimizations should be done each time
        and as early as possible *) 
@@ -308,17 +308,17 @@ let deep_flatten
         let ll = List.map aux ll in
         match p, ll with
         (* Simplify %revapply, for n-ary functions with n > 1 *)
-        | Prevapply loc, [x; Lapply (f, args, _)]
-        | Prevapply loc, [x; Levent (Lapply (f, args, _),_)] ->
-          Lam.apply f (args@[x]) (Lambda.default_apply_info ~loc ())
+        | Prevapply loc, [x; Lapply {fn = f;  args; _}]
+        | Prevapply loc, [x; Levent (Lapply {fn = f;  args; _},_)] ->
+          Lam.apply f (args@[x]) loc App_na
         | Prevapply loc, [x; f] -> 
-          Lam.apply f [x] (Lambda.default_apply_info ~loc ())
+          Lam.apply f [x] loc App_na
         (* Simplify %apply, for n-ary functions with n > 1 *)
-        | Pdirapply loc, [Lapply(f, args, _); x]
-        | Pdirapply loc, [Levent (Lapply (f, args, _),_); x] ->
-          Lam.apply f (args@[x]) (Lambda.default_apply_info ~loc ())
+        | Pdirapply loc, [Lapply{fn = f;  args; _}; x]
+        | Pdirapply loc, [Levent (Lapply {fn = f;  args;  _},_); x] ->
+          Lam.apply f (args@[x]) loc App_na
         | Pdirapply loc, [f; x] -> 
-          Lam.apply f [x] (Lambda.default_apply_info ~loc ())
+          Lam.apply f [x] loc App_na
         | _ -> Lam.prim p ll
       end
     | Lfunction(arity, kind, params, l) -> 

jscomp/lam_pass_alpha_conversion.ml

@@ -34,11 +34,12 @@ let alpha_conversion (meta : Lam_stats.meta) (lam : Lam.t) : Lam.t =
     match lam with 
     | Lconst _ -> lam
     | Lvar _ -> lam 
-    | Lapply (l1, ll, info) -> (* detect functor application *)
+    | Lapply {fn = l1; args =  ll;  loc ; status} 
+      -> (* detect functor application *)
       begin 
         match Lam_stats_util.get_arity meta l1 with 
         | NA -> 
-          Lam.apply (simpl  l1) (List.map simpl  ll) info
+          Lam.apply (simpl  l1) (List.map simpl  ll) loc status
         | Determin (b, args, tail) -> 
           let len = List.length ll in 
           let rec take args = 
@@ -47,25 +48,22 @@ let alpha_conversion (meta : Lam_stats.meta) (lam : Lam.t) : Lam.t =
               if x = len 
               then 
                 Lam.apply (simpl l1)
-                  (List.map simpl ll)
-                  {info with apply_status = App_ml_full} 
+                  (List.map simpl ll) loc App_ml_full
               else if x > len  
               then 
                 let fn = simpl l1 in
                 let args = List.map simpl ll in
-                Lam_util.eta_conversion (x - len) 
-                  {info with  apply_status = App_ml_full}
+                Lam_util.eta_conversion (x - len) loc App_ml_full
                   fn args 
               else 
                 let first,rest = Ext_list.take x ll in 
                 Lam.apply (
                   Lam.apply (simpl l1) 
                          (List.map simpl first) 
-                         {
-                           info with apply_status = App_ml_full
-                         })
-                  (List.map simpl rest) info (* TODO refien *)
-            | _ -> Lam.apply (simpl l1) (List.map simpl ll)  info 
+                         loc App_ml_full
+                )
+                  (List.map simpl rest) loc status (* TODO refien *)
+            | _ -> Lam.apply (simpl l1) (List.map simpl ll)  loc status
           in take args
       end
 

jscomp/lam_pass_collect.ml

@@ -143,7 +143,7 @@ let collect_helper  (meta : Lam_stats.meta) (lam : Lam.t)  =
          *)
     | Lconst _ -> ()
     | Lvar _ -> ()
-    | Lapply(l1, ll, _) ->
+    | Lapply{fn = l1; args =  ll; _} ->
         collect  l1; List.iter collect  ll
     | Lfunction(_arity, _kind, params, l) -> (* functor ? *)
         List.iter (fun p -> Hashtbl.add meta.ident_tbl p Parameter ) params;

jscomp/lam_pass_exits.ml

@@ -83,7 +83,7 @@ let count_helper  (lam : Lam.t) : (int, int ref) Hashtbl.t  =
           (* end *)
       end
     | Lvar _| Lconst _ -> ()
-    | Lapply(l1, ll, _) -> count l1; List.iter count ll
+    | Lapply{fn = l1; args =  ll; _} -> count l1; List.iter count ll
     | Lfunction(_, _, _, l) -> count l
     | Llet(_, _, l1, l2) ->
       count l2; count l1
@@ -249,8 +249,8 @@ let subst_helper (subst : subst_tbl) query lam =
       end
 
     | Lvar _|Lconst _  -> lam
-    | Lapply (l1, ll, loc) -> 
-      Lam.apply (simplif l1) (List.map simplif ll) loc
+    | Lapply {fn = l1; args =  ll;  loc; status } -> 
+      Lam.apply (simplif l1) (List.map simplif ll) loc status
     | Lfunction (arity, kind, params, l) -> 
       Lam.function_ arity kind params (simplif l)
     | Llet (kind, v, l1, l2) -> 
@@ -264,17 +264,17 @@ let subst_helper (subst : subst_tbl) query lam =
         let ll = List.map simplif ll in
         match p, ll with
         (* Simplify %revapply, for n-ary functions with n > 1 *)
-        | Prevapply loc, [x; Lapply (f, args, _)]
-        | Prevapply loc, [x; Levent (Lapply (f, args, _),_)] ->
-          Lam.apply f (args@[x]) (Lambda.default_apply_info ~loc ())
+        | Prevapply loc, [x; Lapply {fn = f;  args;  _}]
+        | Prevapply loc, [x; Levent (Lapply {fn = f; args;  _},_)] ->
+          Lam.apply f (args@[x]) loc App_na
         | Prevapply loc, [x; f] 
-          -> Lam.apply f [x] (Lambda.default_apply_info ~loc ())
+          -> Lam.apply f [x] loc App_na
         (* Simplify %apply, for n-ary functions with n > 1 *)
-        | Pdirapply loc, [Lapply(f, args, _); x]
-        | Pdirapply loc, [Levent (Lapply (f, args, _),_); x] ->
-          Lam.apply f (args@[x]) (Lambda.default_apply_info ~loc ())
+        | Pdirapply loc, [Lapply{fn = f;  args;  _}; x]
+        | Pdirapply loc, [Levent (Lapply {fn = f;  args;  _},_); x] ->
+          Lam.apply f (args@[x]) loc App_na
         | Pdirapply loc, [f; x] -> 
-          Lam.apply f [x] (Lambda.default_apply_info ~loc ())
+          Lam.apply f [x] loc App_na
         | _ -> Lam.prim p ll
       end
     | Lswitch(l, sw) ->