provide indirection for lambda -> bs_lambda

jscomp/core.mllib

@@ -7,7 +7,7 @@ config_util
 
 
 
-
+lam
 lam_mk
 lam_comb
 lam_compile_env

jscomp/js_cmj_format.ml

@@ -32,7 +32,7 @@
 (* TODO: add a magic number *)
 type cmj_value = {
   arity : Lam_stats.function_arities ;
-  closed_lambda : Lambda.lambda option ; 
+  closed_lambda : Lam.t option ; 
   (** Either constant or closed functor *)
 }
 

jscomp/js_cmj_format.mli

@@ -54,7 +54,7 @@
 
 type cmj_value = {
   arity : Lam_stats.function_arities ;
-  closed_lambda : Lambda.lambda option ; 
+  closed_lambda : Lam.t option ; 
   (* Either constant or closed functor *)
 }
 

jscomp/js_output.ml

@@ -80,7 +80,7 @@ let handle_name_tail
 let handle_block_return 
     (st : st) 
     (should_return : Lam_compile_defs.return_type)
-    (lam : Lambda.lambda) (block : J.block) exp : t = 
+    (lam : Lam.t) (block : J.block) exp : t = 
   match st, should_return with 
   | Declare (kind,n), False -> 
     make (block @ [ S.define ~kind  n exp])

jscomp/js_output.mli

@@ -68,12 +68,12 @@ val dummy : t
 val handle_name_tail :
     Lam_compile_defs.st ->
     Lam_compile_defs.return_type ->
-    Lambda.lambda ->  J.expression -> t
+    Lam.t ->  J.expression -> t
 
 val handle_block_return : 
     Lam_compile_defs.st ->
     Lam_compile_defs.return_type ->
-    Lambda.lambda ->
+    Lam.t ->
     J.block -> J.expression -> t
 
 val concat : t list -> t

jscomp/js_stmt_make.ml

@@ -347,7 +347,7 @@ let try_ ?comment   ?with_ ?finally body : t =
     comment
   }
 
-let unknown_lambda ?(comment="unknown")  (lam : Lambda.lambda ) : t = 
+let unknown_lambda ?(comment="unknown")  (lam : Lam.t ) : t = 
   exp @@ E.str ~comment ~pure:false (Lam_util.string_of_lambda lam) 
 
 (* TODO: 

jscomp/js_stmt_make.mli

@@ -95,7 +95,7 @@ val exp : ?comment:string  -> J.expression -> t
 
 val return : ?comment:string  -> J.expression -> t
 
-val unknown_lambda : ?comment:string  -> Lambda.lambda -> t
+val unknown_lambda : ?comment:string  -> Lam.t -> t
 
 val return_unit : ?comment:string -> unit -> t
 (** for ocaml function which returns unit 

jscomp/lam.ml

@@ -0,0 +1,46 @@
+(* 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. *)
+
+
+type t = Lambda.lambda = 
+  | 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
+  | Llet of Lambda.let_kind * Ident.t * t * t
+  | Lletrec of (Ident.t * t) list * t
+  | Lprim of Lambda.primitive * t list
+  | Lswitch of t * Lambda.lambda_switch
+  | Lstringswitch of t * (string * t) list * t option
+  | Lstaticraise of int * t list
+  | Lstaticcatch of t * (int * Ident.t list) * t
+  | Ltrywith of t * Ident.t * t
+  | Lifthenelse of t * t * t
+  | Lsequence of t * t
+  | Lwhile of t * t
+  | Lfor of Ident.t * t * t * Asttypes.direction_flag * t
+  | Lassign of Ident.t * t
+  | Lsend of Lambda.meth_kind * t * t * t list * Location.t
+  | Levent of t * Lambda.lambda_event
+  | Lifused of Ident.t * t

jscomp/lam.mli

@@ -0,0 +1,46 @@
+(* 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. *)
+
+
+type t = Lambda.lambda = 
+  | 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
+  | Llet of Lambda.let_kind * Ident.t * t * t
+  | Lletrec of (Ident.t * t) list * t
+  | Lprim of Lambda.primitive * t list
+  | Lswitch of t * Lambda.lambda_switch
+  | Lstringswitch of t * (string * t) list * t option
+  | Lstaticraise of int * t list
+  | Lstaticcatch of t * (int * Ident.t list) * t
+  | Ltrywith of t * Ident.t * t
+  | Lifthenelse of t * t * t
+  | Lsequence of t * t
+  | Lwhile of t * t
+  | Lfor of Ident.t * t * t * Asttypes.direction_flag * t
+  | Lassign of Ident.t * t
+  | Lsend of Lambda.meth_kind * t * t * t list * Location.t
+  | Levent of t * Lambda.lambda_event
+  | Lifused of Ident.t * t

jscomp/lam_analysis.ml

@@ -27,7 +27,7 @@
 
 
 
-let rec no_side_effects (lam : Lambda.lambda) : bool = 
+let rec no_side_effects (lam : Lam.t) : bool = 
   match lam with 
   | Lvar _ 
   | Lconst _ 
@@ -227,7 +227,7 @@ let really_big () = raise Too_big_to_inline
 
 let big_lambda = 1000
 
-let rec size (lam : Lambda.lambda) = 
+let rec size (lam : Lam.t) = 
   try 
     match lam with 
     | Lvar _ ->  1
@@ -277,7 +277,7 @@ and size_constant x =
     ->  List.fold_left (fun acc x -> acc + size_constant x ) 0 str
   | Const_float_array xs  -> List.length xs
 
-and size_lams acc (lams : Lambda.lambda list) = 
+and size_lams acc (lams : Lam.t list) = 
   List.fold_left (fun acc l -> acc  + size l ) acc lams
 
 let exit_inline_size = 7 
@@ -286,7 +286,7 @@ let small_inline_size = 5
     Actually this patten is quite common in GADT, people have to write duplicated code 
     due to the type system restriction
 *)
-let rec eq_lambda (l1 : Lambda.lambda) (l2 : Lambda.lambda) =
+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 (* *)
@@ -393,7 +393,7 @@ let free_variables (export_idents : Ident_set.t ) (params : stats Ident_map.t )
       else { env with top = false}
     else env      
   in    
-  let rec iter (top : env) (lam : Lambda.lambda) =
+  let rec iter (top : env) (lam : Lam.t) =
     match lam with 
     | Lvar v -> map_use top v 
     | Lconst _ -> ()
@@ -495,7 +495,7 @@ let is_closed_with_map exports params body =
 (* TODO:  We can relax this a bit later,
     but decide whether to inline it later in the call site
  *)
-let safe_to_inline (lam : Lambda.lambda) = 
+let safe_to_inline (lam : Lam.t) = 
   match lam with 
   | Lfunction _ ->  true
   | Lconst (Const_pointer _  | Const_immstring _ ) -> true

jscomp/lam_analysis.mli

@@ -30,21 +30,21 @@
 (** A module which provides some basic analysis over lambda expression *)
 
 (** No side effect, but it might depend on data store *)
-val no_side_effects : Lambda.lambda -> bool 
+val no_side_effects : Lam.t -> bool 
 
-val size : Lambda.lambda -> int
+val size : Lam.t -> int
 
-val eq_lambda : Lambda.lambda -> Lambda.lambda -> bool 
+val eq_lambda : Lam.t -> Lam.t -> bool 
 (** a conservative version of comparing two lambdas, mostly 
     for looking for similar cases in switch
  *)
 
 (** [is_closed_by map lam]
     return [true] if all unbound variables
     belongs to the given [map] *)
-val is_closed_by : (* Lambda. *) Ident_set.t -> Lambda.lambda -> bool
+val is_closed_by : (* Lambda. *) Ident_set.t -> Lam.t -> bool
 
-val is_closed : Lambda.lambda -> bool
+val is_closed : Lam.t -> bool
 
 
 
@@ -67,14 +67,14 @@ type stats =
 
 val is_closed_with_map : 
   Ident_set.t ->
-  Ident.t list -> Lambda.lambda -> bool * stats Ident_map.t
+  Ident.t list -> Lam.t -> bool * stats Ident_map.t
 
 val param_map_of_list : Ident.t list -> stats Ident_map.t
 
-val free_variables : Ident_set.t -> stats Ident_map.t -> Lambda.lambda -> stats Ident_map.t
+val free_variables : Ident_set.t -> stats Ident_map.t -> Lam.t -> stats Ident_map.t
 
 val small_inline_size : int 
 val exit_inline_size : int 
 
 
-val safe_to_inline : Lambda.lambda -> bool
+val safe_to_inline : Lam.t -> bool

jscomp/lam_beta_reduce.ml

@@ -69,7 +69,7 @@
    3. arguments are const or not   
 *)
 let rewrite (map :   (Ident.t, _) Hashtbl.t) 
-    (lam : Lambda.lambda) : Lambda.lambda = 
+    (lam : Lam.t) : Lam.t = 
 
   let rebind i = 
     let i' = Ident.rename i in 
@@ -81,7 +81,7 @@ let rewrite (map :   (Ident.t, _) Hashtbl.t)
     match op with 
     | None -> None 
     | Some x -> Some (aux x)
-  and aux (lam : Lambda.lambda) : Lambda.lambda = 
+  and aux (lam : Lam.t) : Lam.t = 
     match lam with 
     | Lvar v -> 
       begin 
@@ -213,7 +213,7 @@ let propogate_beta_reduce
   | None -> 
   let rest_bindings, rev_new_params  = 
     List.fold_left2 
-      (fun (rest_bindings, acc) old_param (arg : Lambda.lambda) -> 
+      (fun (rest_bindings, acc) old_param (arg : Lam.t) -> 
          match arg with          
          | Lconst _
          | Lvar _  -> rest_bindings , arg :: acc 
@@ -223,7 +223,7 @@ let propogate_beta_reduce
       )  ([],[]) params args in
   let new_body = rewrite (Ext_hashtbl.of_list2 (List.rev params) (rev_new_params)) body in
   List.fold_right
-    (fun (param, (arg : Lambda.lambda)) l -> 
+    (fun (param, (arg : Lam.t)) l -> 
        let arg = 
          match arg with 
          | Lvar v -> 
@@ -253,7 +253,7 @@ let propogate_beta_reduce_with_map
   | None ->
   let rest_bindings, rev_new_params  = 
     List.fold_left2 
-      (fun (rest_bindings, acc) old_param (arg : Lambda.lambda) -> 
+      (fun (rest_bindings, acc) old_param (arg : Lam.t) -> 
          match arg with          
          | Lconst _
          | Lvar _  -> rest_bindings , arg :: acc 
@@ -281,7 +281,7 @@ let propogate_beta_reduce_with_map
       )  ([],[]) params args in
   let new_body = rewrite (Ext_hashtbl.of_list2 (List.rev params) (rev_new_params)) body in
   List.fold_right
-    (fun (param, (arg : Lambda.lambda)) l -> 
+    (fun (param, (arg : Lam.t)) l -> 
        let arg = 
          match arg with 
          | Lvar v -> 

jscomp/lam_beta_reduce.mli

@@ -32,7 +32,7 @@
 (** Beta reduction of lambda IR *)
 
 
-val beta_reduce : Ident.t list -> Lambda.lambda -> Lambda.lambda list -> Lambda.lambda
+val beta_reduce : Ident.t list -> Lam.t -> Lam.t list -> Lam.t
 (* Compile-time beta-reduction of functions immediately applied:
       Lapply(Lfunction(Curried, params, body), args, loc) ->
         let paramN = argN in ... let param1 = arg1 in body
@@ -50,14 +50,14 @@ val beta_reduce : Ident.t list -> Lambda.lambda -> Lambda.lambda list -> Lambda.
 val propogate_beta_reduce : 
   Lam_stats.meta -> 
   Ident.t list -> 
-  Lambda.lambda -> 
-  Lambda.lambda list -> 
-  Lambda.lambda
+  Lam.t -> 
+  Lam.t list -> 
+  Lam.t
 
 
 val refresh : 
-  Lambda.lambda -> 
-  Lambda.lambda 
+  Lam.t -> 
+  Lam.t 
 
 (** 
    {[ Lam_beta_reduce.propogate_beta_reduce_with_map 
@@ -83,4 +83,4 @@ val propogate_beta_reduce_with_map :
   Lam_stats.meta ->
   Lam_analysis.stats Ident_map.t ->
   Ident.t list ->
-  Lambda.lambda -> Lambda.lambda list -> Lambda.lambda
+  Lam.t -> Lam.t list -> Lam.t

jscomp/lam_beta_reduce_util.ml

@@ -38,7 +38,7 @@
 
 type value = 
   { mutable used : bool ; 
-    lambda  : Lambda.lambda
+    lambda  : Lam.t
   }
 let param_hash : (Ident.t , value) Hashtbl.t = Hashtbl.create 20
 let simple_beta_reduce params body args = 
@@ -50,7 +50,7 @@ let simple_beta_reduce params body args =
       else exp.used <- true; exp.lambda
     | exception Not_found -> opt
   in  
-  let rec aux acc (us : Lambda.lambda list) = 
+  let rec aux acc (us : Lam.t list) = 
     match us with 
     | [] -> List.rev acc
     | (Lvar x as a ) :: rest 
@@ -60,14 +60,14 @@ let simple_beta_reduce params body args =
       -> aux (u :: acc) rest 
     | _ :: _ -> raise E.Not_simple_apply 
   in 
-  match (body : Lambda.lambda) with 
+  match (body : Lam.t) with 
   | Lprim ( primitive , args' )  (* There is no lambda in primitive *)
     -> (* catch a special case of primitives *)
     (* Note in a very special case we can avoid any allocation
        {[
          when Ext_list.for_all2_no_exn
              (fun p a ->
-                match (a : Lambda.lambda) with
+                match (a : Lam.t) with
                 | Lvar a -> Ident.same p a
                 | _ -> false ) params args'
        ]}*)

jscomp/lam_beta_reduce_util.mli

@@ -29,4 +29,4 @@
 
 
 val simple_beta_reduce : 
-  Ident.t list -> Lambda.lambda -> Lambda.lambda list -> Lambda.lambda option
+  Ident.t list -> Lam.t -> Lam.t list -> Lam.t option