enhance cross module inlining, add a stream test case

Author: Hongbo Zhang

jscomp/compiler.mllib

@@ -32,6 +32,7 @@ lam_compile_env
 lam_dispatch_primitive
 lam_stats
 lam_stats_util
+lam_stats_export
 lam_util
 lam_pass_alpha_conversion
 lam_pass_remove_alias

jscomp/lam_analysis.ml

@@ -457,3 +457,11 @@ let is_closed  lam =
   Ident_map.for_all (fun k _ -> Ident.global k)
     (free_variables Ident_set.empty Ident_map.empty lam)  
 
+(* 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) = 
+  match lam with 
+  | Lfunction _ ->  true
+  | Lconst (Const_pointer _  | Const_immstring _ ) -> true
+  | _ -> false

jscomp/lam_analysis.mli

@@ -65,3 +65,4 @@ val small_inline_size : int
 val exit_inline_size : int 
 
 
+val safe_to_inline : Lambda.lambda -> bool

jscomp/lam_compile.ml

@@ -75,7 +75,26 @@ let rec
              it is very small             
              TODO: add comment here, we should try to add comment for 
              cross module inlining             
-          *)              
+          
+             if we do too agressive inlining here: 
+
+             if we inline {!List.length} which will call {!A_list.length}, 
+             then we if we try inline {!A_list.length}, this means if {!A_list} 
+             is rebuilt, this module should also be rebuilt,
+
+             But if the build system is content-based, suppose {!A_list} 
+             is changed, cmj files in {!List} is unchnaged, however, 
+             {!List.length} call {!A_list.length} which is changed, since
+             [ocamldep] only detect that we depend on {!List}, it will not 
+             get re-built, then we are screwed.                   
+
+             This is okay for stamp based build system.
+
+             Another solution is that we add dependencies in the compiler
+
+             -: we should not do functor application inlining in a 
+                non-toplevel, it will explode code very quickly              
+          *)               
           ->  
           compile_lambda cxt lam
         | _ -> 
@@ -145,8 +164,6 @@ and get_exp_with_args (cxt : Lam_compile_defs.cxt)  lam args_lambda
           (match id, name,  args with 
            | {name = "Pervasives"; _}, "^", [ e0 ; e1] ->  
              E.string_append e0 e1 
-           | {name = "Pervasives"; _}, "string_of_int", [e] 
-             -> E.int_to_string e 
            | {name = "Pervasives"; _}, "print_endline", ([ _ ] as args) ->  
              E.seq (E.dump Log args) (E.unit ())
            | {name = "Pervasives"; _}, "prerr_endline", ([ _ ] as args) ->  

jscomp/lam_compile_group.ml

@@ -182,10 +182,9 @@ let compile  ~filename non_export env _sigs lam   =
     let lam = Lam_pass_remove_alias.simplify_alias meta lam  in
     let lam = Lam_group.deep_flatten lam in
     let ()  = Lam_pass_collect.collect_helper meta lam in
-    let () = ignore @@ _d lam  in
-
     let lam = 
       lam
+      |> _d
       |> Lam_pass_alpha_conversion.alpha_conversion meta
       |> Lam_pass_exits.simplify_exits in    
     let () = Lam_pass_collect.collect_helper meta lam in
@@ -215,19 +214,39 @@ let compile  ~filename non_export env _sigs lam   =
 
   begin 
     match (lam : Lambda.lambda) with
-    | Lprim(Psetglobal id, [biglambda])  (* ATT: might be wrong in toplevel *) ->
+    | Lprim(Psetglobal id, [biglambda])
+      -> 
+      (* Invariant: The last one is always [exports]
+         Compile definitions
+         Compile exports
+         Assume Pmakeblock(_,_),
+         lambda_exports are pure
+         compile each binding with a return value
+         This might be wrong in toplevel
+      *)
+
       begin 
         match Lam_group.flatten [] biglambda with 
         | Lprim( (Pmakeblock (_,_,_), lambda_exports)),  rest ->
-          let coercion_groups, new_exports = 
+          let coercion_groups, new_exports, new_export_set,  export_map = 
             if non_export then 
-              [], []
+              [], [], Ident_set.empty, Ident_map.empty
             else
               List.fold_right2 
-                (fun  eid lam (coercions, new_exports) ->
+                (fun  eid lam (coercions, new_exports, new_export_set,  export_map) ->
                    match (lam : Lambda.lambda) with 
-                   | Lvar id when Ident.name id = Ident.name eid -> 
-                     (coercions, id :: new_exports)
+                   | Lvar id 
+                     when Ident.name id = Ident.name eid -> 
+                     (* {[ Ident.same id eid]} is more  correct, 
+                        however, it will introduce 
+                        a coercion, which is not necessary, 
+                        as long as its name is the same, we want to avoid 
+                        another coercion                        
+                     *)
+                     (coercions, 
+                      id :: new_exports, 
+                      Ident_set.add id new_export_set,
+                      export_map)
                    | _ -> (** TODO : bug 
                               check [map.ml] here coercion, we introduced 
                               rebound which is not corrrect 
@@ -243,15 +262,25 @@ let compile  ~filename non_export env _sigs lam   =
                               however
                           *)
                      (Lam_group.Single(Strict ,eid,  lam) :: coercions, 
-                      eid :: new_exports))
-                meta.exports lambda_exports ([],[])
+                      eid :: new_exports,
+                      Ident_set.add eid new_export_set, 
+                      Ident_map.add eid lam export_map))
+                meta.exports lambda_exports 
+                ([],[], Ident_set.empty, Ident_map.empty)
           in
 
           let meta = { meta with 
-                       export_idents = Lam_util.ident_set_of_list new_exports;
+                       export_idents = new_export_set;
                        exports = new_exports
                      } in 
-          let rest = List.rev_append rest coercion_groups in
+          let (export_map, rest) = 
+            List.fold_left 
+              (fun (export_map, acc) x ->
+                 (match (x : Lam_group.t)  with 
+                 | Single (_,id,lam) when Ident_set.mem id new_export_set 
+                   -> Ident_map.add id lam export_map
+                 | _ -> export_map), x :: acc ) (export_map, coercion_groups) rest in
+
           let () =
             if not @@ Ext_string.is_empty filename 
             then
@@ -261,13 +290,6 @@ let compile  ~filename non_export env _sigs lam   =
               Format.pp_print_list ~pp_sep:Format.pp_print_newline
                 (Lam_group.pp_group env) fmt rest ;
           in
-          (* Invariant: The last one is always [exports]
-             Compile definitions
-             Compile exports
-             Assume Pmakeblock(_,_),
-             lambda_exports are pure
-             compile each binding with a return value
-          *)
           let rest = Lam_dce.remove meta.exports rest 
           in
           let module  E = struct exception  Not_pure of string end in
@@ -335,8 +357,8 @@ let compile  ~filename non_export env _sigs lam   =
 
             (* Exporting ... *)
             let v = 
-              Lam_stats_util.export_to_cmj meta  maybe_pure external_module_ids
-                (if non_export then [] else lambda_exports) 
+              Lam_stats_export.export_to_cmj meta  maybe_pure external_module_ids
+                (if non_export then Ident_map.empty else export_map) 
             in
             (if not @@ Ext_string.is_empty filename then
                Js_cmj_format.to_file 

jscomp/lam_dispatch_primitive.ml

@@ -517,16 +517,22 @@ let query (prim : Lam_compile_env.primitive_description)
       E.runtime_call Js_config.obj_runtime prim.prim_name args 
 
     | "caml_format_float"
-    | "caml_format_int"
+
     | "caml_nativeint_format"
     | "caml_int32_format"
     | "caml_float_of_string"
     | "caml_int_of_string" (* what is the semantics?*)
     | "caml_int32_of_string"
     | "caml_nativeint_of_string" -> 
       E.runtime_call Js_config.format prim.prim_name args
-
-
+    | "caml_format_int" -> 
+      begin match args with 
+      | [ {expression_desc = Str (_, "%d"); _}; v] 
+        ->
+        E.int_to_string v 
+      | _ -> 
+        E.runtime_call Js_config.format prim.prim_name args
+      end
     (*   "caml_alloc_dummy"; *)
     (* TODO:   "caml_alloc_dummy_float"; *)
     | "caml_update_dummy"

jscomp/lam_stats_export.ml

@@ -0,0 +1,147 @@
+(* OCamlScript compiler
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+(* Author: Hongbo Zhang  *)
+
+let pp = Format.fprintf 
+(* we should exclude meaninglist names and do the convert as well *)
+
+let meaningless_names  = ["*opt*"; "param";]
+
+let rec dump_ident fmt (id : Ident.t) (arity : Lam_stats.function_arities)  = 
+  pp fmt  "@[<2>export var %s:@ %a@ ;@]" (Ext_ident.convert id.name ) dump_arity arity
+
+and dump_arity fmt (arity : Lam_stats.function_arities) = 
+  match arity with 
+  | NA -> pp fmt "any"
+  | Determin (_, [], _) -> pp fmt "any"
+  | Determin (_, (_,args)::xs, _) -> 
+    pp fmt "@[(%a)@ =>@ any@]" 
+      (Format.pp_print_list  
+         ~pp_sep:(fun fmt _ -> 
+             Format.pp_print_string fmt ",";
+             Format.pp_print_space fmt ();
+           )
+         (fun fmt ident -> pp fmt "@[%s@ :@ any@]" 
+             (Ext_ident.convert @@ Ident.name ident))
+      ) args 
+
+
+(* Note that 
+   [lambda_exports] is 
+   lambda expression to be exported
+   for the js backend, we compile to js 
+   for the inliner, we try to seriaize it -- 
+   relies on other optimizations to make this happen
+   {[
+     exports.Make = function () {.....}
+   ]}
+   TODO: check that we don't do this in browser environment
+*)
+let export_to_cmj 
+    (meta : Lam_stats.meta ) 
+    maybe_pure
+    external_ids 
+    export_map
+
+  : Js_cmj_format.cmj_table = 
+  let values = 
+
+    List.fold_left
+      (fun   acc (x : Ident.t)  ->
+         let arity =  Lam_stats_util.get_arity meta (Lvar x) in
+         match Ident_map.find x export_map with 
+         | lambda  -> 
+           if Lam_analysis.safe_to_inline lambda
+           (* when inlning a non function, we have to be very careful,
+              only truly immutable values can be inlined
+           *)
+           then
+             let closed_lambda = 
+               if Lam_inline_util.should_be_functor x.name lambda (* can also be submodule *)
+               then
+                 if Lam_analysis.is_closed lambda (* TODO: seriealize more*)
+                 then Some lambda
+                 else None
+               else 
+                 let lam_size = Lam_analysis.size lambda in
+                 let free_variables =
+                   Lam_analysis.free_variables Ident_set.empty Ident_map.empty 
+                     lambda in
+                 if  lam_size < Lam_analysis.small_inline_size && 
+                     Ident_map.is_empty free_variables
+                     (* TODO:
+                        1. global need re-assocate when do the beta reduction 
+                        2. [lambda_exports] is not precise
+                     *)
+                 then 
+                   begin
+                     (* Ext_log.dwarn __LOC__ "%s recorded for inlining @." x.name ; *)
+                     Some lambda
+                   end
+                 else 
+                   begin
+                     (* Ext_log.dwarn __LOC__ "%s : %d : {%s} not inlined @."  *)
+                     (*   x.name lam_size   *)
+                     (*   (String.concat ", " @@  *)
+                     (*    List.map (fun x -> x.Ident.name) @@ Ident_map.keys free_variables) ; *)
+                     None 
+                   end
+             in 
+             String_map.add x.name  Js_cmj_format.{arity ; closed_lambda } acc 
+           else
+             String_map.add x.name  Js_cmj_format.{arity ; closed_lambda = None } acc 
+         | exception Not_found 
+           -> String_map.add x.name  Js_cmj_format.{arity ; closed_lambda = None} acc  
+      )
+      String_map.empty
+      meta.exports 
+
+
+  in
+
+  let rec dump fmt ids = 
+    (* TODO: also use {[Ext_pp]} module instead *)
+    match ids with 
+    | [] -> ()
+    | x::xs -> 
+      dump_ident fmt x (Lam_stats_util.get_arity meta (Lvar x)) ; 
+      Format.pp_print_space fmt ();
+      dump fmt xs in
+
+  let () =
+    if not @@ Ext_string.is_empty meta.filename then
+      Ext_pervasives.with_file_as_pp 
+        (Ext_filename.chop_extension ~loc:__LOC__ meta.filename ^ ".d.ts")
+      @@ fun fmt -> 
+        pp fmt "@[<v>%a@]@." dump meta.exports
+  in
+  let pure = 
+    match maybe_pure with
+    | None ->  
+      Ext_option.bind ( Ext_list.for_all_ret 
+                          (fun (id : Lam_module_ident.t) -> 
+                             Lam_compile_env.query_and_add_if_not_exist id meta.env 
+                               ~not_found:(fun _ -> false ) ~found:(fun i -> 
+                                   i.pure)
+                          ) external_ids) (fun x -> Lam_module_ident.name x)
+    | Some _ -> maybe_pure
+
+  in
+  {values; pure }
+

jscomp/lam_stats_export.mli

@@ -0,0 +1,26 @@
+(* OCamlScript compiler
+ * 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, with linking exception;
+ * either version 2.1 of the License, or (at your option) any 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.
+ *)
+
+(* Author: Hongbo Zhang  *)
+
+val export_to_cmj : 
+  Lam_stats.meta ->
+  Js_cmj_format.effect ->
+  Lam_module_ident.t list ->
+  Lambda.lambda Ident_map.t -> Js_cmj_format.cmj_table
+