Merge pull request #2400 from BuckleScript/specialize_min_max

type specialize min/max and warnings for non-specialized

jscomp/all.depend

@@ -593,8 +593,8 @@ core/lam_compile_global.cmx : core/ocaml_types.cmx core/lam_module_ident.cmx \
 core/lam_dispatch_primitive.cmx : core/js_stmt_make.cmx \
     core/js_runtime_modules.cmx core/js_of_lam_tuple.cmx \
     core/js_of_lam_exception.cmx core/js_of_lam_array.cmx core/js_long.cmx \
-    core/js_exp_make.cmx common/js_config.cmx core/j.cmx ext/ext_list.cmx \
-    common/bs_warnings.cmx core/lam_dispatch_primitive.cmi
+    core/js_exp_make.cmx common/js_config.cmx core/js_analyzer.cmx core/j.cmx \
+    ext/ext_list.cmx common/bs_warnings.cmx core/lam_dispatch_primitive.cmi
 core/lam_bounded_vars.cmx : core/lam.cmx ext/ident_hashtbl.cmx \
     ext/ext_list.cmx core/lam_bounded_vars.cmi
 core/lam_beta_reduce.cmx : core/lam_util.cmx core/lam_stats.cmx \

jscomp/core/js_analyzer.ml

@@ -394,11 +394,11 @@ let rec is_constant (x : J.expression)  =
   | _ -> false 
 
 
-let rec is_simple_no_side_effect_expression (e : J.expression) = 
+let rec is_okay_to_duplicate (e : J.expression) = 
   match e.expression_desc with  
   | Var _ 
   | Bool _ 
   | Str _ 
   | Number _ -> true
-  | Dot (e, (_ : string), _) -> is_simple_no_side_effect_expression e 
+  | Dot (e, (_ : string), _) -> is_okay_to_duplicate e 
   | _ -> false 

jscomp/core/js_analyzer.mli

@@ -81,5 +81,5 @@ val is_constant : J.expression -> bool
     no computation involved so that  it is okay to be duplicated
 *)
 
-val is_simple_no_side_effect_expression 
+val is_okay_to_duplicate
   : J.expression -> bool

jscomp/core/js_ast_util.ml

@@ -34,7 +34,7 @@ module S = Js_stmt_make
 
 let rec named_expression (e : J.expression)
   :  (J.statement  * Ident.t) option = 
-  if Js_analyzer.is_simple_no_side_effect_expression e then 
+  if Js_analyzer.is_okay_to_duplicate e then 
     None 
   else 
     let obj = Ext_ident.create_tmp () in 

jscomp/core/js_long.ml

@@ -113,8 +113,8 @@ let bit_op  op runtime_call args =
   match args  with 
   | [l;r] -> 
     (* Int64 is a block in ocaml, a little more conservative in inlining *)
-    if Js_analyzer.is_simple_no_side_effect_expression l  &&
-       Js_analyzer.is_simple_no_side_effect_expression r then 
+    if Js_analyzer.is_okay_to_duplicate l  &&
+       Js_analyzer.is_okay_to_duplicate r then 
       make ~lo:(op (get_lo l) (get_lo r))
         ~hi:(op (get_hi l) (get_hi r))
     else int64_call runtime_call args 
@@ -170,6 +170,10 @@ let to_hex (args : J.expression list) =
 let get64 = int64_call "get64"
 let float_of_bits  =  int64_call "float_of_bits" 
 let bits_of_float = int64_call "bits_of_float"
+let min args = 
+  int64_call "min" args 
+let max args = 
+  int64_call "max" args
 let to_float (args : J.expression list ) = 
   match args with
   (* | [ {expression_desc  *)

jscomp/core/js_long.mli

@@ -50,6 +50,8 @@ val asr_ : int64_call
 val and_ : int64_call
 val or_ : int64_call
 val swap : int64_call
+val min : int64_call
+val max : int64_call
 val discard_sign : int64_call
 val div_mod : int64_call
 val to_hex : int64_call  

jscomp/core/js_of_lam_option.ml

@@ -57,7 +57,7 @@ let get_default_undefined
   | Array ([x],_)
   | Caml_block([x],_,_,_) -> (map Static_unwrapped x) (* invariant: option encoding *)
   | _ ->
-    if Js_analyzer.is_simple_no_side_effect_expression arg then
+    if Js_analyzer.is_okay_to_duplicate arg then
       E.econd arg (map Static_unwrapped (E.index arg 0l)) E.undefined
     else
       map Runtime_maybe_unwrapped (E.runtime_call Js_runtime_modules.js_primitive "option_get" [arg])

jscomp/core/js_runtime_modules.ml

@@ -38,6 +38,7 @@ let hash = "Caml_hash"
 let oo = "Caml_oo"
 let curry = "Curry"
 let caml_oo_curry = "Caml_oo_curry"
+let caml_primitive = "Caml_primitive"
 let int64 = "Caml_int64"
 let md5 = "Caml_md5"
 let weak = "Caml_weak"

jscomp/core/lam.ml

@@ -1934,17 +1934,6 @@ let convert exports lam : _ * _  =
             | _ -> assert false
           end
 
-        | Lprim ( Pfield (id, _),
-                  [Lprim (Pgetglobal ({name  = "Pervasives"} ), _,_)],loc              
-                )
-          ->
-          let args = Ext_list.map convert_aux args in
-          begin match Ocaml_stdlib_slots.pervasives.(id) , args  with
-            | "^", [ l; r ] 
-              ->
-              prim ~primitive:Pstringadd ~args:[l;r] loc 
-            | _ ->  apply (convert_aux fn) args loc  App_na
-          end
         (*  
         | Lfunction(kind,params,Lprim(prim,inner_args,inner_loc))
           when List.for_all2_no_exn (fun x y -> 

jscomp/core/lam_compile.ml

@@ -202,7 +202,7 @@ and compile_external_field_apply
                  (Determin (a, rest, b))
                  continue (len - x)
              else (* GPR #1423 *)
-             if List.for_all Js_analyzer.is_simple_no_side_effect_expression args then 
+             if List.for_all Js_analyzer.is_okay_to_duplicate args then 
                let params = Ext_list.init (x - len)
                    (fun _ -> Ext_ident.create "param") in
                E.ocaml_fun params 

jscomp/core/lam_dispatch_primitive.ml

@@ -307,13 +307,17 @@ let translate loc (prim_name : string)
       -> Js_long.float_of_bits args 
     | "caml_int64_bswap"
       -> Js_long.swap args    
+    | "caml_int64_min"       
+      ->  Js_long.min args 
+    | "caml_int64_max" 
+      ->  Js_long.max args      
     | "caml_int32_float_of_bits"
     | "caml_int32_bits_of_float"
     | "caml_classify_float"
     | "caml_modf_float"
     | "caml_ldexp_float"
     | "caml_frexp_float"
-    | "caml_float_compare"
+
     | "caml_copysign_float"
     | "caml_expm1_float"
     | "caml_hypot_float"
@@ -388,8 +392,45 @@ let translate loc (prim_name : string)
           call Js_runtime_modules.string 
       end
 
-    | "caml_string_get"
-    | "caml_string_compare"
+    | "caml_int_compare"
+    | "caml_int32_compare"
+    | "caml_nativeint_compare"
+    | "caml_float_compare"
+    | "caml_string_compare" 
+    -> 
+      call Js_runtime_modules.caml_primitive
+
+    | "caml_int_min"
+    | "caml_float_min"
+    | "caml_string_min"
+    | "caml_nativeint_min"
+    | "caml_int32_min"
+
+      -> 
+      begin match args with 
+        | [a;b] ->
+          if Js_analyzer.is_okay_to_duplicate a && Js_analyzer.is_okay_to_duplicate b then 
+            E.econd (E.js_comp Clt a b) a b 
+          else 
+            call Js_runtime_modules.caml_primitive
+        | _ -> assert false  
+      end
+    | "caml_int_max"
+    | "caml_float_max"
+    | "caml_string_max"
+    | "caml_nativeint_max"
+    | "caml_int32_max"    
+    -> 
+      begin match args with 
+        | [a;b] -> 
+          if Js_analyzer.is_okay_to_duplicate a && Js_analyzer.is_okay_to_duplicate b then 
+            E.econd (E.js_comp Cgt a b) a b 
+          else 
+            call Js_runtime_modules.caml_primitive
+        | _ -> assert false 
+      end
+
+    | "caml_string_get"    
     | "string_of_bytes"
     | "bytes_of_string"
 
@@ -574,15 +615,17 @@ let translate loc (prim_name : string)
         | [e] -> E.is_caml_block e 
         | _ -> assert false
       end
+
+
     | "caml_obj_dup" 
     | "caml_update_dummy"
     | "caml_obj_truncate"
     | "caml_lazy_make_forward"  
-    | "caml_int_compare"
-    | "caml_int32_compare"
-    | "caml_nativeint_compare"
       -> 
       call Js_runtime_modules.obj_runtime
+
+    | "caml_min"
+    | "caml_max"
     | "caml_compare"
     | "caml_equal"
     | "caml_notequal"

jscomp/others/.depend

@@ -22,9 +22,7 @@ bs_internalAVLtree.cmj :
 bs_internalMutableAVLSet.cmj : bs_internalAVLset.cmj
 bs_Hash.cmj : bs_Hash.cmi
 bs_Queue.cmj : bs_Array.cmj bs_Queue.cmi
-bs_internalLinkList.cmj :
-bs_LinkList.cmj : bs_Array.cmj bs.cmj
-bs_List.cmj : bs_Array.cmj bs_List.cmi
+bs_List.cmj : js_json.cmj bs_Array.cmj bs_List.cmi
 bs_internalBucketsType.cmj : bs_Array.cmj
 bs_internalSetBuckets.cmj : bs_internalBucketsType.cmj bs_Array.cmj bs.cmj
 bs_internalBuckets.cmj : bs_internalBucketsType.cmj bs_Array.cmj
@@ -71,7 +69,7 @@ js_mapperRt.cmi :
 bs_Array.cmi :
 bs_Hash.cmi :
 bs_Queue.cmi :
-bs_List.cmi :
+bs_List.cmi : js_json.cmi
 bs_HashMap.cmi : bs_Hash.cmi bs_Bag.cmj
 bs_HashSet.cmi : bs_Hash.cmi bs_Bag.cmj
 bs_HashSetString.cmi :

jscomp/others/bs_List.ml

@@ -358,12 +358,13 @@ let rec fillAuxMap arr i x f =
     Bs_Array.unsafe_set arr i (f h [@bs]) ;
     fillAuxMap arr (i + 1) t f  
 
-module J = Js.Json
+module J = Js_json
+type json = J.t 
 let toJson x f =   
   let len = length x in
   let arr = Bs_Array.makeUninitializedUnsafe len in
   fillAuxMap arr 0 x f;
-  Js.Json.array arr
+  J.array arr
 
 (* TODO: best practice about raising excpetion 
    1. raise OCaml exception, no stacktrace 

jscomp/others/bs_List.mli

@@ -52,8 +52,10 @@ val length : 'a t -> int
 
 val toArray : 'a t -> 'a array
 
-val toJson : 'a t -> ('a -> Js.Json.t [@bs]) -> Js.Json.t
-val fromJson : Js.Json.t -> (Js.Json.t -> 'a [@bs]) -> 'a t 
+type json = Js_json.t 
+
+val toJson : 'a t -> ('a -> json  [@bs]) -> json
+val fromJson : json -> (json -> 'a [@bs]) -> 'a t 
 
 val revAppend : 'a t -> 'a t -> 'a t
 

jscomp/others/bs_internalBuckets.ml

@@ -46,7 +46,6 @@ let rec bucket_length accu buckets =
   | None -> accu
   | Some cell -> bucket_length (accu + 1) (next cell)
 
-let max (m : int) n = if m > n then m else n  
 
 
 let rec do_bucket_iter ~f buckets = 
@@ -83,7 +82,9 @@ let fold0 f h init =
 
 let logStats0 h =
   let mbl =
-    Bs_Array.foldLeft (fun[@bs] m b -> max m (bucket_length 0 b)) 0 (C.buckets h) in
+    Bs_Array.foldLeft (fun[@bs] m b -> 
+      let len = (bucket_length 0 b) in
+      Pervasives.max m len) 0 (C.buckets h) in
   let histo = Bs_Array.make (mbl + 1) 0 in
   Bs_Array.iter
     (fun[@bs] b ->

jscomp/others/bs_internalMutableAVLSet.ml

@@ -8,7 +8,7 @@ type ('elt,'id) t0 = 'elt node Js.null
 
 external unsafeCoerce : 'a Js.null -> 'a = "%identity"
 
-let maxInt (x : int) y = if x > y then x else y  
+
 
 let empty = N.empty0      
 let isEmpty = N.isEmpty0
@@ -31,17 +31,21 @@ let rotateWithLeftChild k2 =
   let k1 = unsafeCoerce (N.left k2) in 
   N.(leftSet k2 (right k1)); 
   N.(rightSet k1 (return k2 ));
+  let hlk2, hrk2 = N.(height (left k2), (height (right k2))) in  
   N.(hSet k2 
-    (maxInt (height (left k2)) (height (right k2)) + 1));
-  N.(hSet k1 (maxInt (height (left k1)) (h k2) + 1));
+    (Pervasives.max hlk2 hrk2 + 1));
+  let hlk1, hk2 = N.(height (left k1), (h k2)) in 
+  N.(hSet k1 (Pervasives.max hlk1 hk2 + 1));
   k1  
 (* right rotation *)
 let rotateWithRightChild k1 =   
   let k2 = unsafeCoerce (N.right k1) in 
   N.(rightSet k1 (left k2));
   N.(leftSet k2 (return k1));
-  N.(hSet k1 (maxInt (height (left k1)) (height (right k1)) + 1));
-  N.(hSet k2 (maxInt (height (right k2)) (h k1) + 1));
+  let hlk1, hrk1 = N.((height (left k1)), (height (right k1))) in 
+  N.(hSet k1 (Pervasives.max  hlk1 hrk1 + 1));
+  let hrk2, hk1 = N.(height (right k2), (h k1)) in 
+  N.(hSet k2 (Pervasives.max  hrk2 hk1 + 1));
   k2 
 
 (*
@@ -91,7 +95,8 @@ let rec add (x : key) (t : _ t0) =
              )
            end
         ) in 
+        let hlt, hrt = N.(height (left t),(height (right t))) in 
         N.hSet t 
-          N.(maxInt (height (left t)) (height (right t))  + 1);
+          N.(Pervasives.max hlt hrt  + 1);
         N.return t
       end

jscomp/others/bs_internalSetBuckets.ml

@@ -43,7 +43,6 @@ let rec bucket_length accu buckets =
   | None -> accu
   | Some cell -> bucket_length (accu + 1) (next cell)
 
-let max (m : int) n = if m > n then m else n  
 
 
 let rec do_bucket_iter ~f buckets = 
@@ -100,7 +99,9 @@ let fold0 f h init =
 
 let logStats0 h =
   let mbl =
-    Bs_Array.foldLeft (fun[@bs] m b -> max m (bucket_length 0 b)) 0 (C.buckets h) in
+    Bs_Array.foldLeft (fun[@bs] m b -> 
+      let len = (bucket_length 0 b) in
+      max m len) 0 (C.buckets h) in
   let histo = Bs_Array.make (mbl + 1) 0 in
   Bs_Array.iter
     (fun[@bs] b ->

jscomp/runtime/.depend

@@ -11,7 +11,6 @@ caml_io.cmj : js_undefined.cmj js.cmj bs_string.cmj
 caml_float.cmj : js_typed_array.cmj js_float.cmj caml_float.cmi
 caml_lexer.cmj : caml_lexer.cmi
 caml_parser.cmj : caml_parser.cmi
-caml_primitive.cmj : caml_primitive.cmi
 caml_format.cmj : js_nativeint.cmj js_int64.cmj js_float.cmj caml_utils.cmj \
     bs_string.cmj caml_format.cmi
 caml_md5.cmj : bs_string.cmj caml_md5.cmi
@@ -48,7 +47,6 @@ caml_sys.cmi :
 caml_float.cmi :
 caml_lexer.cmi :
 caml_parser.cmi :
-caml_primitive.cmi :
 caml_format.cmi :
 caml_md5.cmi :
 caml_queue.cmi :

jscomp/runtime/Makefile

@@ -5,14 +5,14 @@ COMPILER=../../lib/bsc.exe
 OTHERS= caml_array caml_string caml_bytes\
 	caml_obj caml_int64 \
 	caml_exceptions	caml_utils caml_sys caml_io\
-	caml_float caml_lexer caml_parser caml_primitive\
+	caml_float caml_lexer caml_parser \
 	caml_format caml_md5 caml_queue caml_hash caml_weak\
 	caml_backtrace caml_int32 caml_gc js_typed_array \
 	js_primitive caml_basic caml_oo curry caml_oo_curry caml_module \
 	caml_missing_polyfill\
 	bs_string  js_float js_exn bs_obj js_nativeint js_int js_null js_undefined
 
-SOURCE_LIST= $(OTHERS) caml_builtin_exceptions  block  js js_unsafe js_internal
+SOURCE_LIST= $(OTHERS) caml_builtin_exceptions  block  js js_unsafe js_internal caml_primitive
 
 caml_sys.cmj: js_undefined.cmj
 caml_oo.cmj : caml_array.cmj
@@ -23,10 +23,11 @@ caml_format.cmj: caml_int64.cmj caml_int32.cmj caml_utils.cmj caml_string.cmj
 caml_weak.cmj caml_module.cmj: caml_obj.cmj js_primitive.cmj
 caml_builtin_exceptions.cmj: caml_builtin_exceptions.cmi js_unsafe.cmi
 block.cmj: block.cmi
+caml_primitive.cmj: caml_primitive.cmi
 caml_int64.cmj : caml_obj.cmj
 # or we can do a post-processing to add missing cmj dependency manually
 js_exn.cmj : caml_exceptions.cmj
-$(addsuffix .cmj, $(OTHERS)): caml_builtin_exceptions.cmj  block.cmj js.cmj js_unsafe.cmj
+$(addsuffix .cmj, $(OTHERS)): caml_builtin_exceptions.cmj  block.cmj js.cmj js_unsafe.cmj caml_primitive.cmj
 $(addsuffix .cmj, $(OTHERS)) caml_builtin_exceptions.cmj  block.cmj js.cmj js_unsafe.cmj : js_internal.cmi 
 ## since we use ppx
 $(addsuffix .cmi, $(OTHERS)): js.cmi js_unsafe.cmj js_unsafe.cmi js.cmj

jscomp/runtime/caml_float.ml

@@ -105,13 +105,7 @@ let caml_frexp_float (x: float): float * int =
     end
   end
 
-let caml_float_compare (x : float) (y : float ) =
-  if x = y then 0
-  else if x < y then  -1
-  else if x > y then 1
-  else if x = x then 1
-  else if y = y then -1
-  else 0
+
 
 let caml_copysign_float   (x : float) (y :  float) :  float =
   let x = abs_float x in