re-org primitive comparisons

bobzhang · bobzhang · commit 0b088ecbd5dc · 2017-12-25T18:24:51.000+08:00
diff --git a/jscomp/core/js_runtime_modules.ml b/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"
diff --git a/jscomp/core/lam_dispatch_primitive.ml b/jscomp/core/lam_dispatch_primitive.ml
@@ -317,7 +317,7 @@ let translate loc (prim_name : string)
     | "caml_modf_float"
     | "caml_ldexp_float"
     | "caml_frexp_float"
-    | "caml_float_compare"
+
     | "caml_copysign_float"
     | "caml_expm1_float"
     | "caml_hypot_float"
@@ -392,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"
 
@@ -579,43 +616,11 @@ let translate loc (prim_name : string)
         | _ -> assert false
       end
 
-    | "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.obj_runtime
-        | _ -> 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.obj_runtime
-        | _ -> 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
 
diff --git a/jscomp/others/.depend b/jscomp/others/.depend
@@ -22,7 +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_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
@@ -69,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 :
diff --git a/jscomp/others/bs_List.ml b/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 
diff --git a/jscomp/others/bs_List.mli b/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
 
diff --git a/jscomp/others/bs_internalBuckets.ml b/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 ->
diff --git a/jscomp/others/bs_internalMutableAVLSet.ml 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
diff --git a/jscomp/others/bs_internalSetBuckets.ml b/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 ->
diff --git a/jscomp/runtime/.depend 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 :
diff --git a/jscomp/runtime/Makefile b/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
diff --git a/jscomp/runtime/caml_float.ml b/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
diff --git a/jscomp/runtime/caml_float.mli b/jscomp/runtime/caml_float.mli
@@ -36,7 +36,7 @@ val caml_modf_float : float -> float * float
 
 val caml_ldexp_float : float -> int -> float
 val caml_frexp_float : float -> float * int
-val caml_float_compare : float -> float -> int
+
 val caml_copysign_float : float -> float -> float
 val caml_expm1_float : float -> float
 
diff --git a/jscomp/runtime/caml_obj.ml b/jscomp/runtime/caml_obj.ml
@@ -125,40 +125,12 @@ let caml_update_dummy x y =
   let y_tag = Obj.tag y in 
   if y_tag <> 0 then
     Obj.set_tag x y_tag
-
-type 'a selector = 'a -> 'a -> 'a 
 (* Bs_obj.set_length x   (Bs_obj.length y) *)
 (* [set_length] seems redundant here given that it is initialized as an array 
 *)
-let caml_int_compare (x : int) (y: int) : int =
-  if  x < y then -1 else if x = y then 0 else  1
-
-(* could be replaced by [Math.min], but it seems those built-ins are slower *)
-let caml_int_min (x : int) (y : int) : int =
-  if x < y then x else y 
-let caml_float_min (x : float) y   =
-  if x < y then x else y   
-let caml_string_min (x : string) y =     
-  if x < y then x else y 
-let caml_nativeint_min (x : nativeint) y =   
-  if x < y then x else y 
-let caml_int32_min (x : int32) y   = 
-  if x < y then x else y 
-
-let caml_int_max (x : int) (y : int) : int =
-  if x > y then x else y 
-let caml_float_max (x : float) y   =
-  if x > y then x else y   
-let caml_string_max (x : string) y =     
-  if x > y then x else y 
-let caml_nativeint_max (x : nativeint) y =   
-  if x > y then x else y 
-let caml_int32_max (x : int32) y   = 
-  if x > y then x else y 
-  
-
-let caml_string_compare (x : string) (y: string) : int =
-  if  x < y then -1 else if x = y then 0 else  1
+
+type 'a selector = 'a -> 'a -> 'a 
+
 
 let unsafe_js_compare x y =
   if x == y then 0 else
@@ -187,13 +159,13 @@ let rec caml_compare (a : Obj.t) (b : Obj.t) : int =
   let a_type = Js.typeof a in 
   let b_type = Js.typeof b in 
   if a_type = "string" then
-    caml_string_compare (Obj.magic a) (Obj.magic b )
+    Pervasives.compare (Obj.magic a : string) (Obj.magic b )
   else 
     let is_a_number = a_type = "number" in 
     let is_b_number = b_type = "number" in 
     match is_a_number , is_b_number with 
     | true, true -> 
-      caml_int_compare (Obj.magic a) (Obj.magic b )
+      Pervasives.compare (Obj.magic a : int) (Obj.magic b : int)
     | true , false -> -1 (* Integer < Block in OCaml runtime GPR #1195 *)
     | false, true -> 1 
     | false, false -> 
@@ -218,7 +190,7 @@ let rec caml_compare (a : Obj.t) (b : Obj.t) : int =
         else if tag_b = 250 then
           caml_compare a (Obj.field b 0)
         else if tag_a = 248 (* object/exception *)  then
-          caml_int_compare (Obj.magic @@ Obj.field a 1) (Obj.magic @@ Obj.field b 1 )
+          Pervasives.compare (Obj.magic @@ Obj.field a 1 : int) (Obj.magic @@ Obj.field b 1 )
         else if tag_a = 251 (* abstract_tag *) then
           raise (Invalid_argument "equal: abstract value")
         else if tag_a <> tag_b then
@@ -307,8 +279,6 @@ and aux_equal_length  (a : Obj.t) (b : Obj.t) i same_length =
 
 let caml_notequal a  b =  not (caml_equal a  b)
 
-let caml_int32_compare = caml_int_compare
-let caml_nativeint_compare = caml_int_compare
 let caml_greaterequal a b = caml_compare a b >= 0
 
 let caml_greaterthan a b = caml_compare a b > 0
diff --git a/jscomp/runtime/caml_obj.mli b/jscomp/runtime/caml_obj.mli
diff --git a/jscomp/runtime/caml_primitive.ml b/jscomp/runtime/caml_primitive.ml
diff --git a/jscomp/runtime/caml_primitive.mli b/jscomp/runtime/caml_primitive.mli
diff --git a/jscomp/runtime/caml_string.ml b/jscomp/runtime/caml_string.ml
diff --git a/jscomp/runtime/caml_string.mli b/jscomp/runtime/caml_string.mli
