small enhancement to cross inlining: TODO: 1. add comments if we can, for example, cross module constants, 2. specialize some functions as early as we can

Author: Hongbo Zhang

jscomp/lam_compile.ml

@@ -51,8 +51,38 @@ type default_case =
   | Complete
   | NonComplete
 
+
 let rec  
-  compile_let flag (cxt : Lam_compile_defs.cxt) id (arg : Lambda.lambda) : Js_output.t =
+  get_exp_with_index (cxt : Lam_compile_defs.cxt) lam 
+    ((id : Ident.t), (pos : int),env) : Js_output.t = 
+  let f =   Js_output.handle_name_tail cxt.st cxt.should_return lam in    
+  Lam_compile_env.find_and_add_if_not_exist (id,pos) env 
+    ~not_found:(fun id -> 
+        f (E.str ~pure:false (Printf.sprintf "Err %s %d %d" id.name id.flags pos))
+        (* E.index m (pos + 1) *) (** shift by one *)
+        (** This can not happen since this id should be already consulted by type checker *)
+      )
+    ~found:(fun {id; name; closed_lambda } ->
+        match id, name, closed_lambda with 
+        | {name = "Sys"; _}, "os_type" , _
+          (** We drop the ability of cross-compiling
+              the compiler has to be the same running 
+          *)
+          ->  f (E.str Sys.os_type)
+        | _, _, Some lam when Lam_util.not_function lam
+          (* since it's only for alias, there is no arguments, 
+             we should not inline function definition here, even though
+             it is very small             
+             TODO: add comment here, we should try to add comment for 
+             cross module inlining             
+          *)              
+          ->  
+          compile_lambda cxt lam
+        | _ -> 
+          f (E.ml_var_dot id name)
+      ) 
+
+and  compile_let flag (cxt : Lam_compile_defs.cxt) id (arg : Lambda.lambda) : Js_output.t =
 
 
   match flag, arg  with 
@@ -296,7 +326,7 @@ and
                     for the function, generative module or functor can be a function,
                     however it can not be global -- global can only module
                 *)
-                [], Lam_compile_global.get_exp (QueryGlobal (i, env,true))
+                [], Lam_compile_global.get_exp  (i, env,true)
               | _ ->
                 begin
                   match compile_lambda
@@ -326,7 +356,7 @@ and
                       for the function, generative module or functor can be a function, 
                       however it can not be global -- global can only module 
                   *)
-                  [], Lam_compile_global.get_exp (QueryGlobal (ident, env,true))
+                  [], Lam_compile_global.get_exp  (ident, env,true)
                 | _ ->
                   begin
                     match compile_lambda 
@@ -438,8 +468,7 @@ and
       Js_output.handle_name_tail st should_return lam (Lam_compile_const.translate c)
 
     | Lprim(Pfield n, [ Lprim(Pgetglobal id,[])]) -> (* should be before Pgetglobal *)
-      Js_output.handle_name_tail st should_return lam 
-        (Lam_compile_global.get_exp (GetGlobal (id,n, env)))
+        get_exp_with_index cxt lam  (id,n, env)
 
     | Lprim(Praise _raise_kind, [ e ]) -> 
       begin
@@ -1075,7 +1104,7 @@ and
         |> List.map (fun (x : Lambda.lambda) -> 
             match x with 
             | Lprim (Pgetglobal i, []) -> 
-              [], Lam_compile_global.get_exp (QueryGlobal (i, env, true))
+              [], Lam_compile_global.get_exp  (i, env, true)
             | _ -> 
               begin
                 match compile_lambda {cxt with st = NeedValue; should_return = False}

jscomp/lam_compile_env.ml

@@ -46,9 +46,9 @@ type module_info = {
 type primitive_description = Types.type_expr option Primitive.description
 
 type key = 
-  | GetGlobal of Ident.t * int * Env.t 
-  | QueryGlobal of Ident.t * Env.t  * bool (** we need register which global variable is an dependency *)
-  | CamlRuntimePrimitive of primitive_description * J.expression list
+
+  Ident.t * Env.t  * bool (** we need register which global variable is an dependency *)
+
 
 type ident_info = {
   id : Ident.t;

jscomp/lam_compile_env.mli

@@ -25,15 +25,14 @@
 type primitive_description = Types.type_expr option Primitive.description
 
 type key = 
-  | GetGlobal of Ident.t * int * Env.t 
-  | QueryGlobal of Ident.t * Env.t * bool 
+  Ident.t * Env.t * bool 
   (** the boolean is expand or not
       when it's passed as module, it should be expanded, 
       otherwise for alias, [include Array], it's okay to return an identifier
       TODO: be more clear about its concept
   *)
   (** we need register which global variable is an dependency *)
-  | CamlRuntimePrimitive of primitive_description * J.expression list  
+
 
 type ident_info = {
   id : Ident.t;

jscomp/lam_compile_external_call.ml

@@ -288,7 +288,7 @@ let translate
           in 
           E.obj kvs 
         | None -> assert false 
-        (* Lam_compile_global.get_exp (CamlRuntimePrimitive (prim, args))  *)
+
       end
     | Js_call{ external_module_name = module_name; 
                txt = { name = fn; splice = js_splice ; 
@@ -375,8 +375,8 @@ let translate
         | _ -> assert false 
       end
 
-    | Normal -> 
-      Lam_compile_global.get_exp (CamlRuntimePrimitive (prim, args))
+    | Normal -> Lam_dispatch_primitive.query prim args 
+
 
   end
 

jscomp/lam_compile_global.ml

@@ -41,28 +41,11 @@ let query_lambda id env =
                            Lambda.Lprim(Pfield i, [Lprim(Pgetglobal id,[])])))
                         sigs))
 
+
 (* Given an module name and position, find its corresponding name  *)  
 let get_exp (key : Lam_compile_env.key) : J.expression = 
   match key with 
-  | GetGlobal ((id : Ident.t), (pos : int),env) -> 
-    Lam_compile_env.find_and_add_if_not_exist (id,pos) env 
-      ~not_found:(fun id -> 
-          E.str ~pure:false (Printf.sprintf "Err %s %d %d" id.name id.flags pos)
-          (* E.index m (pos + 1) *) (** shift by one *)
-          (** This can not happen since this id should be already consulted by type checker *)
-        )
-      ~found:(fun {id; name;_} ->
-          match id, name with 
-          | {name = "Sys"; _}, "os_type" 
-            (** We drop the ability of cross-compiling
-                the compiler has to be the same running 
-            *)
-            ->  E.str Sys.os_type
-          | _ -> 
-            E.ml_var_dot id name
-        ) 
-
-  | QueryGlobal (id, env, expand) -> 
+   (id, env, expand) -> 
     if Ident.is_predef_exn id 
     then 
       begin 
@@ -83,9 +66,7 @@ let get_exp (key : Lam_compile_env.key) : J.expression =
             else 
               E.ml_var id)
 
-  | CamlRuntimePrimitive (prim, args)    -> 
-    Lam_dispatch_primitive.query prim args
-
+  
 
 (* TODO: how nested module call would behave,
    In the future, we should keep in track  of if 

jscomp/lam_compile_group.ml

@@ -354,7 +354,7 @@ let lambda_as_module
     (lam : Lambda.lambda) = 
   begin 
     Lam_current_unit.set_file filename ;  
-    Lam_current_unit.iset_debug_file "ari_regress_test.ml";
+    Lam_current_unit.iset_debug_file "pervasives.ml";
     Ext_pervasives.with_file_as_chan 
       (Ext_filename.chop_extension ~loc:__LOC__ filename ^  ".js")
       (fun chan -> Js_dump.dump_program (compile ~filename false env sigs lam) chan)

jscomp/lam_compile_primitive.ml

@@ -298,7 +298,7 @@ let translate
         1. include Array --> let include  = Array 
         2. get exception
     *)
-    Lam_compile_global.get_exp (QueryGlobal (i,env,false))
+    Lam_compile_global.get_exp (i,env,false)
 
     (** only when Lapply -> expand = true*)
   | Praise _raise_kind -> assert false (* handled before here *)

jscomp/lam_inline_util.ml

@@ -24,6 +24,10 @@
 let maybe_functor (name : string) = 
   name.[0] >= 'A' && name.[0] <= 'Z'
 
+
+let should_be_functor (name : string) lam = 
+  maybe_functor name  && (function | Lambda.Lfunction _ -> true | _ -> false) lam
+
 (* TODO: add a context, like 
     [args]
     [Lfunction(params,body)]

jscomp/lam_inline_util.mli

@@ -23,3 +23,5 @@
 (** Utilities for lambda inlining *)
 
 val maybe_functor : string -> bool
+
+val should_be_functor : string -> Lambda.lambda -> bool 

jscomp/lam_stats_util.ml

@@ -250,11 +250,21 @@ let export_to_cmj
       (fun acc (x : Ident.t)  (lambda : Lambda.lambda) ->
          let arity =  get_arity meta (Lvar x) in
          let closed_lambda = 
-           if Lam_inline_util.maybe_functor x.name 
+           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 
+           if Lam_analysis.size lambda < Lam_analysis.small_inline_size 
+              && 
+              Lam_analysis.is_closed lambda 
+              (* global need re-assocate when do the beta reduction *)
+           then 
+             begin
+               Ext_log.dwarn __LOC__ "%s recorded for inlining @." x.name ;
+               Some lambda
+             end
            else None in 
          String_map.add x.name  Js_cmj_format.{arity ; closed_lambda } acc 
       )

jscomp/lam_util.ml

@@ -316,3 +316,7 @@ let mk_apply_info ?(loc = Location.none)  apply_status : Lambda.apply_info =
 let lam_true : Lambda.lambda = Lconst (Const_pointer ( 1, NullConstructor "true")) 
 
 let lam_false : Lambda.lambda = Lconst (Const_pointer( 0, NullConstructor "false"))
+
+let not_function (lam : Lambda.lambda) = 
+  match lam with 
+  | Lfunction _ -> false | _ -> true 

jscomp/lam_util.mli

@@ -61,3 +61,4 @@ val mk_apply_info : ?loc:Location.t -> Lambda.apply_status -> Lambda.apply_info
 
 val lam_true : Lambda.lambda
 val lam_false : Lambda.lambda
+val not_function : Lambda.lambda -> bool 

jscomp/stdlib/camlinternalFormat.js

@@ -34,7 +34,7 @@ function rev_char_set(char_set) {
   for(var i = 0; i<= 31; ++i){
     char_set$prime[i] = Pervasives.char_of_int(char_set.charCodeAt(i) ^ 255);
   }
-  return Bytes.unsafe_to_string(char_set$prime);
+  return Caml_string.bytes_to_string(char_set$prime);
 }
 
 function is_in_char_set(char_set, c) {
@@ -3309,7 +3309,7 @@ function fix_padding(padty, width, str) {
           break;
 
     }
-    return Bytes.unsafe_to_string(res);
+    return Caml_string.bytes_to_string(res);
   }
 }
 
@@ -3350,7 +3350,7 @@ function fix_int_precision(prec, str) {
               var res = Bytes.make(prec$1 + 2, /* "0" */48);
               res[1] = str.charCodeAt(1);
               $$String.blit(str, 2, res, prec$1 - len + 4, len - 2);
-              return Bytes.unsafe_to_string(res);
+              return Caml_string.bytes_to_string(res);
             }
             else {
               exit = 2;
@@ -3383,7 +3383,7 @@ function fix_int_precision(prec, str) {
           var res$1 = Bytes.make(prec$1 + 1, /* "0" */48);
           res$1[0] = c;
           $$String.blit(str, 1, res$1, prec$1 - len + 2, len - 1);
-          return Bytes.unsafe_to_string(res$1);
+          return Caml_string.bytes_to_string(res$1);
         }
         else {
           return str;
@@ -3393,7 +3393,7 @@ function fix_int_precision(prec, str) {
         if (prec$1 > len) {
           var res$2 = Bytes.make(prec$1, /* "0" */48);
           $$String.blit(str, 0, res$2, prec$1 - len, len);
-          return Bytes.unsafe_to_string(res$2);
+          return Caml_string.bytes_to_string(res$2);
         }
         else {
           return str;

jscomp/stdlib/camlinternalLazy.js

@@ -2,7 +2,6 @@
 'use strict';
 
 var Caml_obj_runtime = require("../runtime/caml_obj_runtime");
-var Obj              = require("./obj");
 var Caml_exceptions  = require("../runtime/caml_exceptions");
 
 var Undefined = [
@@ -21,7 +20,7 @@ function force_lazy_block(blk) {
   try {
     var result = closure(/* () */0);
     blk[0] = result;
-    Caml_obj_runtime.caml_obj_set_tag(blk, Obj.forward_tag);
+    Caml_obj_runtime.caml_obj_set_tag(blk, 250);
     return result;
   }
   catch (e){
@@ -37,16 +36,16 @@ function force_val_lazy_block(blk) {
   blk[0] = raise_undefined;
   var result = closure(/* () */0);
   blk[0] = result;
-  Caml_obj_runtime.caml_obj_set_tag(blk, Obj.forward_tag);
+  Caml_obj_runtime.caml_obj_set_tag(blk, 250);
   return result;
 }
 
 function force(lzv) {
   var t = Caml_obj_runtime.caml_obj_tag(lzv);
-  if (t === Obj.forward_tag) {
+  if (t === 250) {
     return lzv[0];
   }
-  else if (t !== Obj.lazy_tag) {
+  else if (t !== 246) {
     return lzv;
   }
   else {
@@ -56,10 +55,10 @@ function force(lzv) {
 
 function force_val(lzv) {
   var t = Caml_obj_runtime.caml_obj_tag(lzv);
-  if (t === Obj.forward_tag) {
+  if (t === 250) {
     return lzv[0];
   }
-  else if (t !== Obj.lazy_tag) {
+  else if (t !== 246) {
     return lzv;
   }
   else {

jscomp/stdlib/camlinternalMod.js

@@ -2,7 +2,6 @@
 'use strict';
 
 var Caml_obj_runtime = require("../runtime/caml_obj_runtime");
-var Obj              = require("./obj");
 var Caml_exceptions  = require("../runtime/caml_exceptions");
 var CamlinternalOO   = require("./camlinternalOO");
 var $$Array          = require("./array");
@@ -67,7 +66,7 @@ function update_mod(shape, o, n) {
   if (typeof shape === "number") {
     switch (shape) {
       case 0 : 
-          if (Caml_obj_runtime.caml_obj_tag(n) === Obj.closure_tag && n.length <= o.length) {
+          if (Caml_obj_runtime.caml_obj_tag(n) === 247 && n.length <= o.length) {
             overwrite(o, n);
             return Caml_obj_runtime.caml_obj_truncate(o, n.length);
           }
@@ -77,17 +76,17 @@ function update_mod(shape, o, n) {
                       });
           }
       case 1 : 
-          if (Caml_obj_runtime.caml_obj_tag(n) === Obj.lazy_tag) {
+          if (Caml_obj_runtime.caml_obj_tag(n) === 246) {
             o[0] = n[0];
             return /* () */0;
           }
-          else if (Caml_obj_runtime.caml_obj_tag(n) === Obj.forward_tag) {
-            Caml_obj_runtime.caml_obj_set_tag(o, Obj.forward_tag);
+          else if (Caml_obj_runtime.caml_obj_tag(n) === 250) {
+            Caml_obj_runtime.caml_obj_set_tag(o, 250);
             o[0] = n[0];
             return /* () */0;
           }
           else {
-            Caml_obj_runtime.caml_obj_set_tag(o, Obj.forward_tag);
+            Caml_obj_runtime.caml_obj_set_tag(o, 250);
             o[0] = n;
             return /* () */0;
           }

jscomp/stdlib/camlinternalOO.js

@@ -815,7 +815,7 @@ function inherits(cla, vals, virt_meths, concr_meths, param, top) {
   narrow(cla, vals, virt_meths, concr_meths);
   var init = top ? $$super(cla, param[4]) : $$super(cla);
   widen(cla);
-  return $$Array.concat([
+  return Caml_array.caml_array_concat([
               /* :: */0,
               /* array */[init],
               [