Merge 8a76d82 into 5d0b9c8

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/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,6 +307,10 @@ 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"
@@ -574,6 +578,37 @@ let translate loc (prim_name : string)
         | [e] -> E.is_caml_block e 
         | _ -> 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"
@@ -583,6 +618,9 @@ let translate loc (prim_name : string)
     | "caml_nativeint_compare"
       -> 
       call Js_runtime_modules.obj_runtime
+
+    | "caml_min"
+    | "caml_max"
     | "caml_compare"
     | "caml_equal"
     | "caml_notequal"

jscomp/others/.depend

@@ -22,8 +22,6 @@ 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_internalBucketsType.cmj : bs_Array.cmj
 bs_internalSetBuckets.cmj : bs_internalBucketsType.cmj bs_Array.cmj bs.cmj

jscomp/runtime/caml_int64.ml

@@ -258,7 +258,8 @@ let gt x y =
 
 
 let le x y = Pervasives.not (gt x y)
-
+let min x y = if lt x  y then x else y 
+let max x y = if gt x y then x else y 
 
 let to_float ({hi; lo} : t) = 
   Nativeint.to_float ( hi *~ [%raw{|0x100000000|}] +~ lo)
@@ -306,7 +307,7 @@ let rec of_float (x : float) : t =
 
 
 external log2 : float = "Math.LN2" [@@bs.val]  
-external max : float -> float -> float = "Math.max" [@@bs.val]
+(* external maxFloat : float -> float -> float = "Math.max" [@@bs.val] *)
 
 let rec div self other =
   match self, other with
@@ -348,7 +349,7 @@ let rec div self other =
       let rem = ref self in
       (* assert false *)
       while ge !rem other  do
-        let approx = ref ( max 1.
+        let approx = ref ( Pervasives.max 1.
              (floor (to_float !rem /. to_float other) )) in
         let log2 = ceil (log !approx /. log2) in
         let delta =

jscomp/runtime/caml_int64.mli

@@ -57,6 +57,8 @@ val neq : comparison
 val lt : comparison
 val gt : comparison
 val le : comparison
+val min : t -> t -> t 
+val max : t -> t -> t
 
 val to_float : t -> float
 val of_float : float -> t

jscomp/runtime/caml_obj.ml

@@ -126,12 +126,37 @@ let caml_update_dummy x y =
   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
 
@@ -291,3 +316,9 @@ let caml_greaterthan a b = caml_compare a b > 0
 let caml_lessequal a b = caml_compare a b <= 0
 
 let caml_lessthan a b = caml_compare a b < 0
+
+let caml_min (x : Obj.t) y =   
+  if caml_compare  x y <= 0 then x else y 
+
+let caml_max (x : Obj.t) y =    
+  if caml_compare x y >= 0 then x else y 

jscomp/runtime/caml_obj.mli

@@ -52,3 +52,19 @@ val caml_greaterthan : eq
 val caml_lessthan : eq
 val caml_lessequal : eq
 
+type 'a selector = 'a -> 'a -> 'a 
+
+val caml_int_min : int selector
+val caml_float_min : float selector 
+val caml_string_min : string selector  
+val caml_nativeint_min : nativeint selector
+val caml_int32_min : int32 selector 
+
+val caml_int_max : int selector
+val caml_float_max : float selector 
+val caml_string_max : string selector  
+val caml_nativeint_max : nativeint selector
+val caml_int32_max : int32 selector 
+
+val caml_min : Obj.t selector
+val caml_max : Obj.t selector

jscomp/stdlib/pervasives.ml

@@ -59,9 +59,14 @@ external ( <= ) : 'a -> 'a -> bool = "%lessequal"
 external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
 external compare : 'a -> 'a -> int = "%compare"
 
+#if BS then 
+external min : 'a -> 'a -> 'a = "%bs_min"
+external max : 'a -> 'a -> 'a = "%bs_max"
+#else
 let min x y = if x <= y then x else y
 let max x y = if x >= y then x else y
 
+#end
 external ( == ) : 'a -> 'a -> bool = "%eq"
 external ( != ) : 'a -> 'a -> bool = "%noteq"
 
@@ -174,13 +179,17 @@ external bytes_blit : bytes -> int -> bytes -> int -> int -> unit
 external bytes_unsafe_to_string : bytes -> string = "%bytes_to_string"
 external bytes_unsafe_of_string : string -> bytes = "%bytes_of_string"
 
+#if BS then 
+external (^) : string -> string -> string = "#string_append"
+#else
 let ( ^ ) s1 s2 =
   let l1 = string_length s1 and l2 = string_length s2 in
   let s = bytes_create (l1 + l2) in
   string_blit s1 0 s 0 l1;
   string_blit s2 0 s l1 l2;
   bytes_unsafe_to_string s
 
+#end
 (* Character operations -- more in module Char *)
 
 external int_of_char : char -> int = "%identity"

jscomp/stdlib/pervasives.mli

@@ -95,6 +95,10 @@ external compare : 'a -> 'a -> int = "%compare"
    required by the {!Set.Make} and {!Map.Make} functors, as well as
    the {!List.sort} and {!Array.sort} functions. *)
 
+#if BS then 
+external min : 'a -> 'a -> 'a = "%bs_min"
+external max : 'a -> 'a -> 'a = "%bs_max"
+#else
 val min : 'a -> 'a -> 'a
 (** Return the smaller of the two arguments.
     The result is unspecified if one of the arguments contains
@@ -105,6 +109,7 @@ val max : 'a -> 'a -> 'a
     The result is unspecified if one of the arguments contains
     the float value [nan]. *)
 
+#end 
 external ( == ) : 'a -> 'a -> bool = "%eq"
 (** [e1 == e2] tests for physical equality of [e1] and [e2].
    On mutable types such as references, arrays, byte sequences, records with
@@ -502,7 +507,11 @@ external classify_float : float -> fpclass = "caml_classify_float"
    More string operations are provided in module {!String}.
 *)
 
+#if BS then
+external (^) : string -> string -> string = "#string_append"
+#else
 val ( ^ ) : string -> string -> string
+#end
 (** String concatenation. *)
 
 

jscomp/test/.depend

@@ -95,9 +95,10 @@ bs_hashset_int_test.cmj : mt.cmj ../others/bs.cmj array_data_util.cmj
 bs_hashtbl_string_test.cmj : ../stdlib/hashtbl.cmj ../others/bs.cmj
 bs_ignore_effect.cmj : mt.cmj
 bs_ignore_test.cmj : ../runtime/js.cmj
-bs_link_list_test.cmj : mt.cmj ../runtime/js.cmj ../others/bs.cmj
+bs_list_test.cmj : mt.cmj ../runtime/js.cmj ../others/bs.cmj
 bs_map_int_test.cmj : mt.cmj ../others/bs.cmj
 bs_map_test.cmj : ../runtime/js.cmj ../others/bs.cmj
+bs_min_max_test.cmj : ../stdlib/pervasives.cmj
 bs_mutable_set_test.cmj : ../runtime/js.cmj \
     ../others/bs_internalMutableAVLSet.cmj
 bs_node_string_buffer_test.cmj : ../others/node.cmj ../runtime/js.cmj

jscomp/test/Makefile

@@ -228,6 +228,7 @@ OTHERS := test_literals a test_ari test_export2 test_internalOO test_obj_simple_
 	bs_hashset_int_test\
 	array_data_util\
 	bs_list_test\
+	bs_min_max_test\
 # bs_uncurry_test
 # needs Lam to get rid of Uncurry arity first
 # simple_derive_test

jscomp/test/bs_min_max_test.js

@@ -0,0 +1,27 @@
+'use strict';
+
+var Caml_obj = require("../../lib/js/caml_obj.js");
+
+function f(x, y) {
+  return Caml_obj.caml_int_compare(x + y | 0, y + x | 0);
+}
+
+function f2(x, y) {
+  return Caml_obj.caml_int_compare(x + y | 0, y);
+}
+
+var f3 = Caml_obj.caml_int_compare;
+
+function f4(x, y) {
+  if (x < y) {
+    return x;
+  } else {
+    return y;
+  }
+}
+
+exports.f  = f;
+exports.f2 = f2;
+exports.f3 = f3;
+exports.f4 = f4;
+/* No side effect */