generate slots beforehand (+1 squashed commits)

Squashed commits:
[b1e23bc] tweak
[6b9806e] wip

Author: Hongbo Zhang

jscomp/core.mllib

@@ -1,6 +1,7 @@
+type_int_to_string
 type_util
 ident_map
-
+ocaml_stdlib_slots
 ident_util
 idents_analysis
 config_util

jscomp/gen_slots.ml

@@ -0,0 +1,26 @@
+#directory "+compiler-libs";;
+#load "ocamlcommon.cma";;
+#mod_use "type_int_to_string.ml"
+
+let slots_of_stdlib_cmi filename : string list = 
+  let info = Cmi_format.read_cmi   (Filename.concat Config.standard_library filename) in
+  List.map (fun x -> Ident.name (Type_int_to_string.name_of_signature_item x)) @@
+  List.filter Type_int_to_string.serializable_signature info.cmi_sign 
+
+
+
+
+let code_of_array files =
+  let code =
+    List.map (fun file -> 
+        let codes = slots_of_stdlib_cmi file in 
+        Printf.sprintf "let %s = [| %s |]"
+          (Filename.chop_extension file )
+          (String.concat  ";" (List.map (Printf.sprintf "%S") codes)) ) files in
+  String.concat "\n" code
+
+(** Generate fixed slots 
+    ATTENTION: we need re-run the code when we upgrade the compiler
+    We do this to avoid dependencies
+*)
+let _ = print_endline (code_of_array ["pervasives.cmi"; "camlinternalOO.cmi"; "camlinternalMod.cmi"])

jscomp/gen_slots.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+set -e
+ocaml -w -40 gen_slots.ml > ocaml_stdlib_slots.ml

jscomp/js_cmj_format.ml

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

jscomp/js_cmj_format.mli

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

jscomp/lam.ml

@@ -35,6 +35,11 @@ type field_dbg_info = Lambda.field_dbg_info
 type set_field_dbg_info = Lambda.set_field_dbg_info
 
 type ident = Ident.t
+
+type function_arities = 
+  | Determin of bool * (int * Ident.t list option) list  * bool
+  | NA 
+               
 type primitive = 
   | Pbytes_to_string
   | Pbytes_of_string
@@ -73,6 +78,7 @@ type primitive =
   | Pstringlength 
   | Pstringrefu 
   | Pstringrefs
+  | Pstringadd  
   | Pbyteslength
   | Pbytesrefu
   | Pbytessetu 
@@ -142,7 +148,8 @@ type primitive =
   | Pjs_fn_make of int 
   | Pjs_fn_run of int 
   | Pjs_fn_method of int 
-  | Pjs_fn_runmethod of int 
+  | Pjs_fn_runmethod of int
+
 type switch = 
   { sw_numconsts: int;
     sw_consts: (int * t) list;
@@ -680,28 +687,34 @@ let rec convert (lam : Lambda.lambda) : t =
         ]
       ) -> (* replace all {!CamlinternalMod} function *)
       let args = List.map convert args in
-      if id = 0 then 
-        match args with 
-        | [_loc ; shape]  -> 
+      begin match Ocaml_stdlib_slots.camlinternalMod.(id), args  with
+      | "init_mod" ,  [_loc ; shape]  -> 
           begin match shape with 
             | Lconst (Const_block (0, _, [Const_block (0, _, [])])) 
               -> unit  (* see {!Translmod.init_shape}*)
             | _ ->  prim ~primitive:Pinit_mod ~args 
           end
-        | _ -> assert false 
-      else       
-        begin 
-          assert (id = 1);
-          match args with 
-          | [shape ;  _obj1; _obj2] -> 
+      | "update_mod", [shape ;  _obj1; _obj2] -> 
             (* here array access will have side effect .. *)
             begin match shape with 
             | Lconst (Const_block (0, _, [Const_block (0, _, [])]))
               -> unit (* see {!Translmod.init_shape}*)
             | _ -> prim ~primitive:Pupdate_mod ~args 
             end
-          | _ -> assert false
-        end
+      | _ -> assert false
+      end
+
+    | Lprim ( Pfield (id, _),
+              [Lprim (Pgetglobal ({name  = "Pervasives"} ), _)]              
+            )
+      ->
+      let args = List.map convert args in
+      begin match Ocaml_stdlib_slots.pervasives.(id) , args  with
+        | "^", [ l; r ] 
+          ->
+          prim ~primitive:Pstringadd ~args:[l;r]
+        | _ ->  apply (convert fn) args loc  App_na
+      end
     | _ -> 
         apply (convert fn) (List.map convert args) 
           loc App_na

jscomp/lam.mli

@@ -36,6 +36,16 @@ type set_field_dbg_info = Lambda.set_field_dbg_info
 
 type ident = Ident.t
 
+type function_arities = 
+  | Determin of bool * (int * Ident.t list option) list  * bool
+  (** when the first argument is true, it is for sure 
+
+      approximation sound but not complete 
+      the last one means it can take any params later, 
+      for an exception: it is (Determin (true,[], true))
+   *)
+  | NA 
+
 type primitive = 
   | Pbytes_to_string
   | Pbytes_of_string
@@ -64,6 +74,7 @@ type primitive =
   | Pstringlength 
   | Pstringrefu 
   | Pstringrefs
+  | Pstringadd    
   | Pbyteslength
   | Pbytesrefu
   | Pbytessetu 

jscomp/lam_analysis.ml

@@ -127,7 +127,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
       (* Integer to external pointer *)
 
       | Poffsetint _
-
+      | Pstringadd 
         -> true
       | Pinit_mod
       | Pupdate_mod
@@ -279,9 +279,18 @@ and size_constant x =
 
 and size_lams acc (lams : Lam.t list) = 
   List.fold_left (fun acc l -> acc  + size l ) acc lams
-
+let args_all_const args =
+  List.for_all (fun x -> match x with Lam.Lconst _ -> true | _ -> false) args
+    
 let exit_inline_size = 7 
 let small_inline_size = 5
+
+(** Hints to inlining *)
+let ok_to_inline fn args =
+  let s = size fn in
+  s < small_inline_size (* || *)
+  (* (args_all_const args && s < 10 && no_side_effects fn) *)
+  
 (* compared two lambdas in case analysis, note that we only compare some small lambdas
     Actually this patten is quite common in GADT, people have to write duplicated code 
     due to the type system restriction

jscomp/lam_analysis.mli

@@ -34,6 +34,7 @@ val no_side_effects : Lam.t -> bool
 
 val size : Lam.t -> int
 
+val ok_to_inline : Lam.t -> Lam.t list -> bool
 val eq_lambda : Lam.t -> Lam.t -> bool 
 (** a conservative version of comparing two lambdas, mostly 
     for looking for similar cases in switch

jscomp/lam_compile.ml

@@ -190,15 +190,13 @@ and get_exp_with_args (cxt : Lam_compile_defs.cxt)  lam args_lambda
         | _ ->  
           Js_output.handle_block_return cxt.st cxt.should_return lam args_code @@ 
           (match id, name,  args with 
-           | {name = "Pervasives"; _}, "^", [ e0 ; e1] ->  
-             E.string_append e0 e1 
            | {name = "Pervasives"; _}, "print_endline", ([ _ ] as args) ->  
              E.seq (E.dump Log args) E.unit
            | {name = "Pervasives"; _}, "prerr_endline", ([ _ ] as args) ->  
              E.seq (E.dump Error args) E.unit
            | _ -> 
              let rec aux (acc : J.expression)
-                 (arity : Lam_stats.function_arities) args (len : int)  =
+                 (arity : Lam.function_arities) args (len : int)  =
                match arity, len with
                | _, 0 -> 
                  acc (** All arguments consumed so far *)