clean up, improve lam_iter, and free variables

jscomp/core.mllib

@@ -8,6 +8,7 @@ config_util
 
 
 lam
+lam_iter
 lam_print
 lam_compile_env
 lam_dispatch_primitive

jscomp/lam.ml

@@ -119,8 +119,8 @@ let const ct : t = Lconst ct
 let apply fn args loc status : t = 
   Lapply { fn; args;  loc  ;
            status }
-let function_ arity kind ids body : t = 
-  Lfunction { arity; kind; params = ids; body}
+let function_ ~arity ~kind ~params ~body : t = 
+  Lfunction { arity; kind; params ; body}
 
 let let_ kind id e body :  t 
   = Llet (kind,id,e,body)
@@ -241,7 +241,7 @@ let lift_int32 b : t =
 let lift_int64 b : t =
   Lconst (Const_base (Const_int64 b))
 
-let prim (prim : Prim.t) (ll : t list)  : t = 
+let prim ~primitive:(prim : Prim.t) ~args:(ll : t list)  : t = 
   let default () : t = Lprim { primitive = prim ;args =  ll } in 
   match ll with 
   | [Lconst a] -> 
@@ -395,8 +395,10 @@ let rec convert (lam : Lambda.lambda) : t =
   | Lapply (fn,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)
+  | Lfunction (kind,  params,body)
+    ->  function_ 
+          ~arity:(List.length params) ~kind ~params 
+          ~body:(convert body)
   | Llet (kind,id,e,body) 
     -> Llet(kind,id,convert e, convert body)
   | Lletrec (bindings,body)

jscomp/lam.mli

@@ -89,7 +89,10 @@ val var : Ident.t -> t
 val const : Lambda.structured_constant -> t
 
 val apply : t -> t list -> Location.t -> Lambda.apply_status -> t
-val function_ : int -> Lambda.function_kind -> Ident.t list -> t -> t
+val function_ : 
+  arity:int ->
+  kind:Lambda.function_kind -> params:Ident.t list -> body:t -> t
+
 val let_ : Lambda.let_kind -> Ident.t -> t -> t -> t
 val letrec : (Ident.t * t) list -> t -> t
 val if_ : triop
@@ -115,7 +118,7 @@ val send :
   t -> t -> t list -> 
   Location.t -> t 
 
-val prim : Lambda.primitive -> t list ->  t
+val prim : primitive:Lambda.primitive -> args:t list ->  t
 
 val staticcatch : 
   t -> int * Ident.t list -> t -> t

jscomp/lam_beta_reduce.ml

@@ -102,7 +102,7 @@ let rewrite (map :   (Ident.t, _) Hashtbl.t)
     | Lfunction{arity; kind; params; body} -> 
       let params =  List.map rebind params in
       let body = aux body in      
-      Lam.function_ arity kind params body
+      Lam.function_ ~arity ~kind ~params ~body
     | Lstaticcatch(l1, (i,xs), l2) -> 
       let l1 = aux l1 in
       let xs = List.map rebind xs in
@@ -117,7 +117,7 @@ let rewrite (map :   (Ident.t, _) Hashtbl.t)
     | Lconst _ -> lam
     | Lprim {primitive; args } ->
       (* here it makes sure that global vars are not rebound *)      
-      Lam.prim primitive (List.map aux  args)
+      Lam.prim ~primitive ~args:(List.map aux  args)
     | Lapply {fn;  args; loc;  status } ->
       let fn = aux fn in       
       let args = List.map aux  args in 

jscomp/lam_beta_reduce_util.ml

@@ -75,12 +75,12 @@ let simple_beta_reduce params body args =
       List.iter2 (fun p a -> Hashtbl.add param_hash p {lambda = a; used = false }) params args  
     in 
     begin match aux [] args' with 
-    | us -> 
+    | args -> 
       let result = 
         Hashtbl.fold (fun _param {lambda; used} code -> 
             if not used then
               Lam.seq lambda code
-            else code) param_hash (Lam.prim primitive us ) in 
+            else code) param_hash (Lam.prim ~primitive ~args) in 
       Hashtbl.clear param_hash;
       Some result 
     | exception _ -> 

jscomp/lam_compile.ml

@@ -911,15 +911,22 @@ and
               begin 
                 match fn with 
                 | Lfunction {params =  [_]; body}
-                  -> compile_lambda cxt (Lam.function_ 0 Curried [] body)
+                  ->
+                  compile_lambda cxt 
+                    (Lam.function_ 
+                       ~arity:0 
+                       ~kind:Curried
+                       ~params:[]
+                       ~body)
                 | _ -> 
                   compile_lambda cxt  
-                    (Lam.function_ 0 Curried [] 
-                     @@ 
-                       Lam.apply fn
-                         [Lam.unit]
-                         Location.none App_na
-                    )
+                    (Lam.function_ ~arity:0 
+                       ~kind:Curried ~params:[] 
+                       ~body:(
+                         Lam.apply fn
+                           [Lam.unit]
+                           Location.none App_na
+                       ))
               end
             else 
               begin match fn with
@@ -928,10 +935,14 @@ and
                   if len = arity then
                     compile_lambda cxt fn 
                   else if len > arity then 
-                    let first, rest  = Ext_list.take arity args  in 
+                    let params, rest  = Ext_list.take arity args  in 
                     compile_lambda cxt 
-                      (Lam.function_ arity
-                         kind first (Lam.function_ (len - arity) kind rest body))
+                      (Lam.function_ 
+                         ~arity
+                         ~kind ~params
+                         ~body:(Lam.function_ ~arity:(len - arity)
+                                  ~kind ~params:rest ~body)
+                      )
                   else 
                     compile_lambda cxt 
                       (Lam_util.eta_conversion arity 

jscomp/lam_compile_global.ml

@@ -44,13 +44,19 @@ let query_lambda id env =
   Lam_compile_env.query_and_add_if_not_exist (Lam_module_ident.of_ml id) 
     (Has_env env)
     ~not_found:(fun id -> assert false)
-    ~found:(fun {signature = sigs; _} -> 
-        Lam.prim (Pmakeblock(0, Blk_module None, Immutable))  
-                      (List.mapi (fun i _ -> 
-                           Lam.prim (Pfield (i, Lambda.Fld_na)) 
-                             [Lam.prim (Pgetglobal id) [] ]  )
-                        sigs) 
-      )
+    ~found:(fun {signature = sigs; _} 
+             -> 
+               Lam.prim
+                 ~primitive:(Pmakeblock(0, Blk_module None, Immutable))  
+                 ~args:(
+                   List.mapi (fun i _ -> 
+                       Lam.prim
+                         ~primitive:(Pfield (i, Lambda.Fld_na)) 
+                         ~args:[
+                           Lam.prim 
+                             ~primitive:(Pgetglobal id)
+                             ~args:[]])
+                     sigs))
 
 
 (* Given an module name and position, find its corresponding name  *)  

jscomp/lam_group.ml

@@ -140,7 +140,10 @@ let deep_flatten
       let id' = Ident.rename id in 
       flatten acc 
         (Lam.let_ str id' arg 
-               (Lam.let_ Alias id (Lam.prim (Pccall p)  [Lam.var id'])
+               (Lam.let_ Alias id 
+                  (Lam.prim 
+                     ~primitive:(Pccall p)
+                     ~args: [Lam.var id'])
                   body)
               )
     | Llet (str,id,arg,body) -> 
@@ -302,11 +305,11 @@ let deep_flatten
       (* TODO: note when int is too big, [caml_int64_to_float] is unsafe *)
       Lam.const 
         (Const_base (Const_float (Js_number.to_string (Int64.to_float i) )))
-    | Lprim {primitive = p; args =  ll}
+    | Lprim {primitive ; args }
       -> 
       begin
-        let ll = List.map aux ll in
-        match p, ll with
+        let args = List.map aux args in
+        match primitive, args with
         (* Simplify %revapply, for n-ary functions with n > 1 *)
         | Prevapply loc, [x; Lapply {fn = f;  args; _}]
         | Prevapply loc, [x; Levent (Lapply {fn = f;  args; _},_)] ->
@@ -319,10 +322,10 @@ let deep_flatten
           Lam.apply f (args@[x]) loc App_na
         | Pdirapply loc, [f; x] -> 
           Lam.apply f [x] loc App_na
-        | _ -> Lam.prim p ll
+        | _ -> Lam.prim ~primitive ~args
       end
     | Lfunction{arity; kind; params;  body = l} -> 
-      Lam.function_ arity kind params  (aux  l)
+      Lam.function_ ~arity ~kind ~params  ~body:(aux  l)
     | Lswitch(l, {sw_failaction; 
                   sw_consts; 
                   sw_blocks;

jscomp/lam_inline_util.ml

@@ -28,41 +28,18 @@
 
 
 
+(* TODO: add a context, like 
+    [args]
+    [Lfunction(params,body)]
+ *)
 
 
 let maybe_functor (name : string) = 
   name.[0] >= 'A' && name.[0] <= 'Z'
 
 
-let should_be_functor (name : string) lam = 
-  maybe_functor name  && 
-  (function | Lam.Lfunction _ -> true | _ -> false) lam
+let should_be_functor (name : string) (lam : Lam.t) = 
+  maybe_functor name  &&
+  (match lam with Lfunction _ -> true | _ -> false)
 
-(* TODO: add a context, like 
-    [args]
-    [Lfunction(params,body)]
- *)
 
-(* HONGBO .. doe snot look like this function is used (not in .mli) *) 
-(* let app_definitely_inlined (body : Lam.t) =  *)
-(*   match body with  *)
-(*   | Lvar _  *)
-(*   | Lconst _ *)
-(*   | Lprim _  *)
-(*   | Lapply _ -> true  *)
-(*   | Llet _  *)
-(*   | Lletrec  _ *)
-(*   | Lstringswitch _  *)
-(*   | Lswitch _  *)
-(*   | Lstaticraise _ *)
-(*   | Lfunction _  *)
-(*   | Lstaticcatch _  *)
-(*   | Ltrywith _  *)
-(*   | Lifthenelse _  *)
-(*   | Lsequence _  *)
-(*   | Lwhile _ *)
-(*   | Lfor _  *)
-(*   | Lassign _  *)
-(*   | Lsend _  *)
-(*   | Levent _ *)
-(*   | Lifused _ -> false *)

jscomp/lam_iter.ml

@@ -0,0 +1,78 @@
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+
+let inner_iter f l = 
+  match (l : Lam.t) with 
+    Lvar _
+  | Lconst _ -> ()
+  | Lapply{fn; args; _} ->
+      f fn; List.iter f args
+  | Lfunction{body;_} ->
+      f body
+  | Llet(str, id, arg, body) ->
+      f arg; f body
+  | Lletrec(decl, body) ->
+      f body;
+      List.iter (fun (id, exp) -> f exp) decl
+  | Lprim {args; _} ->
+      List.iter f args
+  | Lswitch(arg, sw) ->
+      f arg;
+      List.iter (fun (key, case) -> f case) sw.sw_consts;
+      List.iter (fun (key, case) -> f case) sw.sw_blocks;
+      begin match sw.sw_failaction with 
+      | None -> ()
+      | Some a -> f a 
+      end
+  | Lstringswitch (arg,cases,default) ->
+      f arg ;
+      List.iter (fun (_,act) -> f act) cases ;
+      begin match default with 
+      | None -> ()
+      | Some a -> f a 
+      end
+  | Lstaticraise (_,args) ->
+      List.iter f args
+  | Lstaticcatch(e1, (_,vars), e2) ->
+      f e1; f e2
+  | Ltrywith(e1, exn, e2) ->
+      f e1; f e2
+  | Lifthenelse(e1, e2, e3) ->
+      f e1; f e2; f e3
+  | Lsequence(e1, e2) ->
+      f e1; f e2
+  | Lwhile(e1, e2) ->
+      f e1; f e2
+  | Lfor(v, e1, e2, dir, e3) ->
+      f e1; f e2; f e3
+  | Lassign(id, e) ->
+      f e
+  | Lsend (k, met, obj, args, _) ->
+      List.iter f (met::obj::args)
+  | Levent (lam, evt) ->
+      f lam
+  | Lifused (v, e) ->
+      f e
+

jscomp/lam_iter.mli

@@ -0,0 +1,25 @@
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+val inner_iter : (Lam.t -> unit) -> Lam.t -> unit

jscomp/lam_pass_alpha_conversion.ml

@@ -73,10 +73,10 @@ let alpha_conversion (meta : Lam_stats.meta) (lam : Lam.t) : Lam.t =
       let bindings = List.map (fun (k,l) -> (k, simpl l)) bindings in 
       Lam.letrec bindings (simpl body) 
     | Lprim {primitive; args } -> 
-      Lam.prim primitive (List.map simpl  args)
+      Lam.prim ~primitive ~args:(List.map simpl  args)
     | Lfunction {arity; kind; params; body = l} ->
       (* Lam_mk.lfunction kind params (simpl l) *)
-      Lam.function_ arity kind params  (simpl  l)
+      Lam.function_ ~arity ~kind ~params  ~body:(simpl  l)
     | Lswitch (l, {sw_failaction; 
                   sw_consts; 
                   sw_blocks;