Merge pull request #442 from bloomberg/bs_lambda

Bs lambda

Author: bobzhang

jscomp/core.mllib

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

jscomp/idents_analysis.ml

@@ -29,7 +29,7 @@
 
 
 
-module Ident_set = Lambda.IdentSet 
+
 
 (* 
     We have a current ident set 

jscomp/idents_analysis.mli

@@ -36,4 +36,4 @@
  *)
 
 val calculate_used_idents :
-    (Ident.t, Lambda.IdentSet.t) Hashtbl.t -> Ident.t list -> Lambda.IdentSet.t
+    (Ident.t, Ident_set.t) Hashtbl.t -> Ident.t list -> Ident_set.t

jscomp/lam.ml

@@ -23,20 +23,36 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 type primitive = Lambda.primitive
-type switch = Lambda.lambda_switch = 
+type switch = 
   { sw_numconsts: int;
     sw_consts: (int * t) list;
     sw_numblocks: int;
     sw_blocks: (int * t) list;
     sw_failaction : t option}
-and t = Lambda.lambda = 
+and prim_info = 
+  { primitive : primitive ; 
+    args : t list ; 
+  }
+and apply_info = 
+  { fn : t ; 
+    args : t list ; 
+    loc : Location.t;
+    status : Lambda.apply_status
+  }
+and function_info = 
+  { arity : int ; 
+   kind : Lambda.function_kind ; 
+   params : Ident.t list ;
+   body : t 
+  }
+and t = 
   | Lvar of Ident.t
   | Lconst of Lambda.structured_constant
-  | Lapply of t * t list * Lambda.apply_info
-  | Lfunction of Lambda.function_kind * Ident.t list * t
+  | Lapply of apply_info
+  | Lfunction of function_info
   | Llet of Lambda.let_kind * Ident.t * t * t
   | Lletrec of (Ident.t * t) list * t
-  | Lprim of primitive * t list
+  | Lprim of prim_info
   | Lswitch of t * switch
   | Lstringswitch of t * (string * t) list * t option
   | Lstaticraise of int * t list
@@ -100,9 +116,11 @@ 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 function_ kind ids body : t = 
-  Lfunction(kind, ids, body)
+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 let_ kind id e body :  t 
   = Llet (kind,id,e,body)
@@ -223,8 +241,8 @@ 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 default () : t = Lprim(prim,ll) in 
+let prim (prim : Prim.t) (ll : t list)  : t = 
+  let default () : t = Lprim { primitive = prim ;args =  ll } in 
   match ll with 
   | [Lconst a] -> 
     begin match prim, a  with 
@@ -366,9 +384,66 @@ let prim (prim : Prim.t) (ll : t list) : t =
 
 
 let not x : t = 
-  prim Pnot [x]
-
-
-let free_variables  = Lambda.free_variables
-
-let subst_lambda = Lambda.subst_lambda
+  prim Pnot [x] 
+
+
+let rec convert (lam : Lambda.lambda) : t = 
+  match lam with 
+  | Lvar x -> Lvar x 
+  | Lconst x -> 
+    Lconst x 
+  | 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)
+  | Llet (kind,id,e,body) 
+    -> Llet(kind,id,convert e, convert body)
+  | Lletrec (bindings,body)
+    -> 
+    Lletrec (List.map (fun (id, e) -> id, convert e) bindings, convert body)
+  | Lprim (primitive,args) 
+    -> 
+    Lprim {primitive ; args = List.map convert args }
+  | Lswitch (e,s) -> 
+    Lswitch (convert e, convert_switch s)
+  | Lstringswitch (e, cases, default) -> 
+    Lstringswitch (convert e, List.map (fun (x, b) -> x, convert b ) cases, 
+                   match default with 
+                   | None -> None
+                   | Some x -> Some (convert x)
+                  )    
+
+  | Lstaticraise (id, args) -> 
+    Lstaticraise (id, List.map convert args)
+  | Lstaticcatch (b, (i, ids), handler) -> 
+    Lstaticcatch (convert b, (i,ids), convert handler)
+  | Ltrywith (b, id, handler) -> 
+    Ltrywith (convert b, id, convert handler)
+  | Lifthenelse (b,then_,else_) -> 
+    Lifthenelse (convert b, convert then_, convert else_)
+  | Lsequence (a,b) 
+    -> Lsequence (convert a, convert b)
+  | Lwhile (b,body) -> 
+    Lwhile (convert b, convert body)
+  | Lfor (id, from_, to_, dir, loop) -> 
+    Lfor (id, convert from_, convert to_, dir, convert loop)
+  | Lassign (id, body) -> 
+    Lassign (id, convert body)    
+  | Lsend (kind, a,b,ls, loc) -> 
+    Lsend(kind, convert a, convert b, List.map convert ls, loc )
+
+  | Levent (e, event) -> 
+    Levent (convert e, event)
+  | Lifused (id, e) -> Lifused(id, convert e)
+
+and convert_switch (s : Lambda.lambda_switch) : switch = 
+  { sw_numconsts = s.sw_numconsts ; 
+    sw_consts = List.map (fun (i, lam) -> i, convert lam) s.sw_consts;
+    sw_numblocks = s.sw_numblocks;
+    sw_blocks = List.map (fun (i,lam) -> i, convert lam ) s.sw_blocks;
+    sw_failaction = 
+      match s.sw_failaction with 
+      | None -> None 
+      | Some a -> Some (convert a)
+  }  

jscomp/lam.mli

@@ -25,20 +25,37 @@
 type primitive = Lambda.primitive
 
 
-type switch = Lambda.lambda_switch =
+type switch  =
   { sw_numconsts: int;
     sw_consts: (int * t) list;
     sw_numblocks: int;
     sw_blocks: (int * t) list;
     sw_failaction : t option}
-and  t = Lambda.lambda =  private
+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 function_info = private
+  { arity : int ; 
+   kind : Lambda.function_kind ; 
+   params : Ident.t list ;
+   body : t 
+  }
+and  t =  private
   | Lvar of Ident.t
   | Lconst of Lambda.structured_constant
-  | Lapply of t * t list * Lambda.apply_info
-  | Lfunction of Lambda.function_kind * Ident.t list * t
+  | Lapply of apply_info
+  | Lfunction of function_info
   | Llet of Lambda.let_kind * Ident.t * t * t
   | Lletrec of (Ident.t * t) list * t
-  | Lprim of primitive * t list
+  | Lprim of prim_info
   | Lswitch of t * switch
   | Lstringswitch of t * (string * t) list * t option
   | Lstaticraise of int * t list
@@ -70,8 +87,9 @@ 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 function_ : Lambda.function_kind -> Ident.t list -> t -> 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
 val if_ : triop
@@ -96,7 +114,9 @@ val send :
   Lambda.meth_kind ->
   t -> t -> t list -> 
   Location.t -> t 
-val prim : Lambda.primitive -> t list -> t
+
+val prim : Lambda.primitive -> t list ->  t
+
 val staticcatch : 
   t -> int * Ident.t list -> t -> t
 
@@ -108,6 +128,8 @@ val for_ :
   t  ->
   t -> Asttypes.direction_flag -> t -> t 
 
-val free_variables : t -> Lambda.IdentSet.t
 
-val subst_lambda : t Ident.tbl -> t -> t
+
+
+
+val convert : Lambda.lambda -> t 

jscomp/lam_analysis.ml

@@ -32,7 +32,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
   | Lvar _ 
   | Lconst _ 
   | Lfunction _ -> true
-  | Lprim (primitive, args) -> 
+  | Lprim {primitive;  args; _} -> 
     List.for_all no_side_effects args && 
     (
       match primitive with 
@@ -186,10 +186,12 @@ let rec no_side_effects (lam : Lam.t) : bool =
       if it [Not_found], there are no other exceptions 
       can be thrown
   *)
-  | Ltrywith (Lprim(Pccall{prim_name = "caml_sys_getenv"}, 
-                    [Lconst _]),exn,
-              Lifthenelse(Lprim(_, [Lvar exn1; 
-                                    Lprim(Pgetglobal ({name="Not_found"}),[])]),
+  | Ltrywith (Lprim { primitive = Pccall{prim_name = "caml_sys_getenv"};
+                    args = [Lconst _]; _},exn,
+              Lifthenelse(Lprim{args =  
+                                  [Lvar exn1; 
+                                   Lprim {primitive = Pgetglobal ({name="Not_found"}); args = []; _}]
+                               ; _},
                           then_, _)) when Ident.same exn1 exn
     (** we might put this in an optimization pass 
         also make sure when we wrap this in [js] we 
@@ -234,11 +236,13 @@ let rec size (lam : Lam.t) =
     | Lconst c -> size_constant c
     | Llet(_, _, l1, l2) -> 1 + size l1 + size l2 
     | Lletrec _ -> really_big ()
-    | Lprim(Pfield _, [Lprim(Pgetglobal _, [  ])])
+    | Lprim{primitive = Pfield _; 
+            args =  [Lprim { primitive = Pgetglobal _; args =  [  ];  _}]
+           ;  _}
       -> 1
-    | Lprim (Praise _, [l ]) 
+    | Lprim {primitive = Praise _; args =  [l ];  _} 
       -> size l
-    | Lprim(_, ll) -> size_lams 1 ll
+    | Lprim {args = ll; _} -> size_lams 1 ll
 
     (** complicated 
         1. inline this function
@@ -248,10 +252,10 @@ 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 
+    | Lfunction {body} -> size body 
     | Lswitch(_, _) -> really_big ()
     | Lstringswitch(_,_,_) -> really_big ()
     | Lstaticraise (i,ls) -> 
@@ -290,15 +294,16 @@ 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
   | Lstaticraise(id,ls), Lstaticraise(id1,ls1) -> 
     id = id1 && List.for_all2 eq_lambda ls ls1 
   | Llet (_,_,_,_), Llet (_,_,_,_) -> false 
   | Lletrec _, Lletrec _ -> false 
-  | Lprim (p,ls), Lprim (p1,ls1) -> 
+  | Lprim {primitive = p; args = ls; } ,
+    Lprim {primitive = p1; args = ls1} -> 
     eq_primitive p p1 && List.for_all2 eq_lambda ls ls1
   | Lswitch _, Lswitch _ -> false  
   | Lstringswitch _ , Lstringswitch _ -> false 
@@ -397,14 +402,14 @@ 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  
-    | Lprim(_p, args) -> 
+    | Lprim {args ; _} -> 
       (* Check: can top be propoaged for all primitives *)
       List.iter (iter top) args
-    | Lfunction(_kind, params, body) ->
+    | Lfunction{ params; body} ->
       local_add_list params;
       iter no_substitute body 
     | Llet(_let_kind, id, arg, body) ->