better string processing

bobzhang · Hongbo Zhang · commit 87d375b1b59d · 2016-08-08T13:50:52.000-04:00
diff --git a/jscomp/Makefile b/jscomp/Makefile
@@ -57,14 +57,6 @@ releasebuild:
 stdlib:
 	cd stdlib && ./build.sh
 
-
-
-
-# Example:
-# MODULE_FLAGS='-bs-module amdjs' make world
-# MODULE_FLAGS='-bs-module commonjs' make world
-# MODULE_FLAGS='-bs-module goog:buckle' make world
-
 world:
 	@echo "Making compiler"		
 	$(NATIVE) -g -inline 1000 -linkall  -w -a -I +compiler-libs -I bin ocamlcommon.cmxa  bin/compiler.mli bin/compiler.ml -o bin/bsc
diff --git a/jscomp/lam.ml b/jscomp/lam.ml
@@ -268,8 +268,25 @@ let if_ (a : t) (b : t) c =
     end
   | _ ->  Lifthenelse (a,b,c)
 
-let switch lam lam_switch : t = 
-  Lswitch(lam,lam_switch)
+let switch lam (lam_switch : switch) : t =
+  match lam with
+  | Lconst ((Const_pointer (i,_) | Const_base (Const_int i)))
+    ->
+    begin try List.assoc i lam_switch.sw_consts
+      with  Not_found ->
+      match lam_switch.sw_failaction with
+      | Some x -> x
+      | None -> assert false
+    end
+  | Lconst (Const_block (i,_,_)) ->
+    begin try List.assoc i lam_switch.sw_blocks
+      with  Not_found ->
+      match lam_switch.sw_failaction with
+      | Some x -> x
+      | None -> assert false
+    end
+  | _ -> 
+    Lswitch(lam,lam_switch)
 
 let stringswitch (lam : t) cases default : t = 
   match lam with
@@ -410,9 +427,10 @@ let prim ~primitive:(prim : Prim.t) ~args:(ll : t list)  : t =
         -> Lift.bool (comparison cmp a b)
       | Pfloatcomp  cmp, Const_base (Const_nativeint a), Const_base (Const_nativeint b)
         -> Lift.bool (comparison cmp a b)
-      | Pintcomp cmp , Const_base (Const_int a), Const_base (Const_int b)
+      | Pintcomp cmp ,
+        (Const_base (Const_int a) | Const_pointer (a,_)),
+        (Const_base (Const_int b) | Const_pointer (b,_))
         -> Lift.bool (comparison cmp a b)
-
       | (Paddint
         | Psubint
         | Pmulint
diff --git a/jscomp/lam_analysis.ml b/jscomp/lam_analysis.ml
@@ -286,12 +286,50 @@ let args_all_const args =
 let exit_inline_size = 7 
 let small_inline_size = 5
 
+(** destruct pattern will work better 
+    if it is closed lambda, otherwise
+    you can not do full evaluation
+
+    We still should avoid inline too big code, 
+
+    ideally we should also evaluate its size after inlining, 
+    since after partial evaluation, it might still be *very big*
+*)
+let destruct_pattern (body : Lam.t) params args =
+  let rec aux v params args =
+    match params, args with
+    | x::xs, b::bs ->
+      if Ident.same x v then Some b
+      else aux v xs bs
+    | [] , _ -> None
+    | x::xs, [] -> assert false                  
+  in   
+  match body with
+  | Lswitch (Lvar v , switch)
+    ->
+    begin match aux v params args with
+      | Some (Lam.Lconst _ as lam) ->
+        size (Lam.switch lam switch) < small_inline_size
+      | Some _ | None -> false
+    end        
+  | Lifthenelse(Lvar v, then_, else_)
+    ->
+    begin match aux v params args with
+      | Some (Lconst _ as lam) ->
+        size (Lam.if_ lam then_ else_) < small_inline_size
+      | Some _ | None -> false          
+    end      
+  | _ -> false
+    
 (** 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) *)
-  
+let ok_to_inline ~body params args =
+  let s = size body in
+  s < small_inline_size ||
+  (destruct_pattern body params args) ||  
+  (args_all_const args &&
+   (s < 10 && no_side_effects body )) 
+
+
 (* 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
diff --git a/jscomp/lam_analysis.mli b/jscomp/lam_analysis.mli
@@ -34,7 +34,8 @@ val no_side_effects : Lam.t -> bool
 
 val size : Lam.t -> int
 
-val ok_to_inline : Lam.t -> Lam.t list -> bool
+val ok_to_inline : body:Lam.t -> Lam.ident list -> 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
diff --git a/jscomp/lam_pass_remove_alias.ml b/jscomp/lam_pass_remove_alias.ml
@@ -172,7 +172,7 @@ let simplify_alias
               end
             else 
             if (* Lam_analysis.size body < Lam_analysis.small_inline_size *)
-              Lam_analysis.ok_to_inline body args              
+              Lam_analysis.ok_to_inline ~body params args 
             then 
 
                 (* let param_map =  *)
diff --git a/jscomp/test/.depend b/jscomp/test/.depend
@@ -292,6 +292,8 @@ inline_regression_test.cmj : ../stdlib/string.cmi mt.cmi \
     ../stdlib/filename.cmi
 inline_regression_test.cmx : ../stdlib/string.cmx mt.cmx \
     ../stdlib/filename.cmx
+inline_string_test.cmj : ../runtime/js.cmj
+inline_string_test.cmx : ../runtime/js.cmx
 int32_test.cmj : mt.cmi ../stdlib/int32.cmi ../stdlib/format.cmi \
     ext_array.cmj ../stdlib/array.cmi
 int32_test.cmx : mt.cmx ../stdlib/int32.cmx ../stdlib/format.cmx \
@@ -1036,6 +1038,8 @@ inline_regression_test.cmo : ../stdlib/string.cmi mt.cmi \
     ../stdlib/filename.cmi
 inline_regression_test.cmj : ../stdlib/string.cmj mt.cmj \
     ../stdlib/filename.cmj
+inline_string_test.cmo : ../runtime/js.cmo
+inline_string_test.cmj : ../runtime/js.cmj
 int32_test.cmo : mt.cmi ../stdlib/int32.cmi ../stdlib/format.cmi \
     ext_array.cmo ../stdlib/array.cmi
 int32_test.cmj : mt.cmj ../stdlib/int32.cmj ../stdlib/format.cmj \
diff --git a/jscomp/test/Makefile b/jscomp/test/Makefile
@@ -57,8 +57,8 @@ OTHERS := a test_ari test_export2 test_internalOO test_obj_simple_ffi test_scope
 	derive_dyntype derive_type_test nested_include simple_derive_test simple_derive_use\
 	mutual_non_recursive_type external_ppx \
 	optional_ffi_test poly_variant_test \
-	bs_rest_test infer_type_test fs_test module_as_function	\
-	test_case_set test_mutliple string_bound_get_test		
+	bs_rest_test infer_type_test fs_test module_as_function\
+	test_case_set test_mutliple string_bound_get_test inline_string_test
 
 
 SOURCE_LIST := js_dyn $(OTHERS) 
diff --git a/jscomp/test/ari_regress_test.js b/jscomp/test/ari_regress_test.js
@@ -8,13 +8,6 @@ var g = 7;
 
 var h = [0];
 
-function gg(x, y) {
-  var u = x + y | 0;
-  return function (z) {
-    return u + z | 0;
-  };
-}
-
 function g1(x, y) {
   var u = x + y | 0;
   h[0] = h[0] + 1 | 0;
@@ -23,7 +16,11 @@ function g1(x, y) {
   };
 }
 
-var x = gg(3, 5)(6);
+var u = 8;
+
+var x = function (z) {
+    return u + z | 0;
+  }(6);
 
 var partial_arg = g1(3, 4);
 
diff --git a/jscomp/test/ext_pervasives.js b/jscomp/test/ext_pervasives.js
@@ -165,9 +165,6 @@ function dump(r) {
               ];
       }
     };
-    var opaque = function (name) {
-      return "<" + (name + ">");
-    };
     var s = r.length;
     var t = r.tag | 0;
     if (is_list(r)) {
@@ -176,10 +173,10 @@ function dump(r) {
     }
     else if (t !== 0) {
       if (t === Obj.lazy_tag) {
-        return opaque("lazy");
+        return "<lazy>";
       }
       else if (t === Obj.closure_tag) {
-        return opaque("closure");
+        return "<closure>";
       }
       else if (t === Obj.object_tag) {
         var fields$1 = get_fields(/* [] */0, s);
@@ -217,10 +214,10 @@ function dump(r) {
         return "Object #" + (dump(match[1]) + (" (" + ($$String.concat(", ", List.map(dump, match[2])) + ")")));
       }
       else if (t === Obj.infix_tag) {
-        return opaque("infix");
+        return "<infix>";
       }
       else if (t === Obj.forward_tag) {
-        return opaque("forward");
+        return "<forward>";
       }
       else if (t < Obj.no_scan_tag) {
         var fields$2 = get_fields(/* [] */0, s);
@@ -233,38 +230,39 @@ function dump(r) {
         return Pervasives.string_of_float(r);
       }
       else if (t === Obj.abstract_tag) {
-        return opaque("abstract");
+        return "<abstract>";
       }
       else if (t === Obj.custom_tag) {
-        return opaque("custom");
+        return "<custom>";
       }
       else if (t === Obj.custom_tag) {
-        return opaque("final");
+        return "<final>";
       }
       else if (t === Obj.double_array_tag) {
         return "[|" + ($$String.concat(";", $$Array.to_list($$Array.map(Pervasives.string_of_float, r))) + "|]");
       }
       else {
-        return opaque(Curry._2(Printf.sprintf(/* Format */[
-                            /* String_literal */Block.__(11, [
-                                "unknown: tag ",
-                                /* Int */Block.__(4, [
-                                    /* Int_d */0,
-                                    /* No_padding */0,
-                                    /* No_precision */0,
-                                    /* String_literal */Block.__(11, [
-                                        " size ",
-                                        /* Int */Block.__(4, [
-                                            /* Int_d */0,
-                                            /* No_padding */0,
-                                            /* No_precision */0,
-                                            /* End_of_format */0
-                                          ])
-                                      ])
-                                  ])
-                              ]),
-                            "unknown: tag %d size %d"
-                          ]), t, s));
+        var name = Curry._2(Printf.sprintf(/* Format */[
+                  /* String_literal */Block.__(11, [
+                      "unknown: tag ",
+                      /* Int */Block.__(4, [
+                          /* Int_d */0,
+                          /* No_padding */0,
+                          /* No_precision */0,
+                          /* String_literal */Block.__(11, [
+                              " size ",
+                              /* Int */Block.__(4, [
+                                  /* Int_d */0,
+                                  /* No_padding */0,
+                                  /* No_precision */0,
+                                  /* End_of_format */0
+                                ])
+                            ])
+                        ])
+                    ]),
+                  "unknown: tag %d size %d"
+                ]), t, s);
+        return "<" + (name + ">");
       }
     }
     else {
diff --git a/jscomp/test/inline_string_test.js b/jscomp/test/inline_string_test.js
@@ -0,0 +1,28 @@
+'use strict';
+
+
+console.log("list");
+
+console.log("list");
+
+function f(param) {
+  if (param) {
+    return "Some";
+  }
+  else {
+    return "None";
+  }
+}
+
+console.log(/* tuple */[
+      f(/* Some */[3]),
+      "None",
+      "Some"
+    ]);
+
+console.log(/* tuple */[
+      "A",
+      "A"
+    ]);
+
+/*  Not a pure module */
diff --git a/jscomp/test/inline_string_test.ml b/jscomp/test/inline_string_test.ml
@@ -0,0 +1,59 @@
+[@@@bs.config{no_export}]
+type t =
+  | A_list 
+  | A_hashtable
+    
+let string_of_associative_type = function
+  | A_list -> "list"
+  | A_hashtable -> "Hashtbl.t"
+
+
+;; Js.log (string_of_associative_type A_list)
+
+
+type t2 =
+  | A_list 
+  | A_hashtable
+  | A_bad
+let string_of_associative_type = function
+  | A_list -> "list"
+  | A_hashtable -> "Hashtbl.t"
+  | A_bad -> "bad"
+
+
+;; Js.log (string_of_associative_type A_list)
+
+
+let v = Some 3
+
+let f = function
+  | Some _ -> "Some"
+  | None -> "None"
+let u v =  f (Some v )
+;; Js.log (f v, f None, f (Some 3))
+
+type v =
+  | A of int
+  | B of int
+  | C of int
+  | D of int
+  | E of int
+  | F of int
+  | G of int
+  | H of int      
+
+let ff = function
+  | A _ -> "A"
+  | B _ -> "B"
+  | C _ -> "C"
+  | D _ -> "D"
+  | E _ -> "E"
+  | F _ -> "F"
+  | G _ -> "G"
+  | H _ -> "H"    
+
+
+;; Js.log (ff (A 3), (function
+  | A _ -> "A"
+  | B _ -> "B"
+  | _ -> "?"  ) (A 3))
diff --git a/jscomp/test/module_parameter_test.js b/jscomp/test/module_parameter_test.js
@@ -58,7 +58,7 @@ var suites_001 = /* :: */[
     function () {
       return /* Eq */Block.__(0, [
                 3,
-                v("abc")
+                3
               ]);
     }
   ],
diff --git a/jscomp/test/ocaml_proto_test.js b/jscomp/test/ocaml_proto_test.js
diff --git a/jscomp/test/test_demo.js b/jscomp/test/test_demo.js
diff --git a/lib/js/random.js b/lib/js/random.js
