reduce runtime without using js primitives

Author: bobzhang

jscomp/runtime/.depend

@@ -12,8 +12,8 @@ caml_float.cmj : 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_int.cmj js_float.cmj \
-    caml_utils.cmj bs_string.cmj caml_format.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
 caml_queue.cmj : caml_queue.cmi
 caml_hash.cmj : js_undefined.cmj js.cmj caml_queue.cmj bs_string.cmj \

jscomp/runtime/bs_obj.ml

@@ -29,7 +29,7 @@ external set_length : any -> int -> unit = "#obj_set_length"
 external length : any -> int = "#obj_length"
 external tag : any -> int = "caml_obj_tag"
 external set_tag : any -> int -> unit = "caml_obj_set_tag"
-(* external uninitialized_object : int -> int -> any = "#uninitialized_object" *)
+
 external is_instance_array : any -> bool = 
   "#is_instance_array" (* use Array.isArray instead*)
 external size_of_any : any -> 'a Js.undefined =

jscomp/runtime/bs_string.ml

@@ -22,7 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-external string_of_char : char -> string = "#string_of_char"
+
 (** TODO: check with {!String.of_char} 
     it's quite common that we have
     {[ Bs_string.of_char x.[0] ]}
@@ -31,8 +31,9 @@ external string_of_char : char -> string = "#string_of_char"
     ]}
 *)
 
+(*ATT: this relies on we encode `char' as int *)
 external of_char : char -> string = "String.fromCharCode" 
-    [@@bs.val] 
+[@@bs.val] 
 external toUpperCase : string -> string = "toUpperCase" [@@bs.send] 
 external of_int : int -> base:int -> string = "toString" [@@bs.send]
 external of_nativeint : nativeint -> base:int -> string = "toString" [@@bs.send]

jscomp/runtime/caml_array.ml

@@ -24,8 +24,9 @@
 
 
 
-external new_uninitialized : int -> 'a array = "#create_array"
-external append : 'a array -> 'a array -> 'a array = "#array_append"
+external new_uninitialized : int -> 'a array = "Array" [@@bs.new]
+external append : 'a array -> 'a array -> 'a array = "concat" [@@bs.send]
+
 external make : int -> 'a -> 'a array = "caml_make_vect"
 
 

jscomp/runtime/caml_array.mli

@@ -25,8 +25,8 @@
 
 
 
-external new_uninitialized : int -> 'a array = "#create_array"
-external append : 'a array -> 'a array -> 'a array = "#array_append"
+external new_uninitialized : int -> 'a array = "Array" [@@bs.new]
+external append : 'a array -> 'a array -> 'a array = "concat" [@@bs.send]
 external make : int -> 'a -> 'a array = "caml_make_vect"
 
 val caml_array_sub : 'a array -> int -> int -> 'a array

jscomp/runtime/caml_format.ml

@@ -406,29 +406,29 @@ let caml_int64_format fmt x =
             ref (Int64.add quotient_l c )  in
           let modulus = ref d in
           s :=
-            Bs_string.string_of_char 
+            Bs_string.of_char 
               cvtbl.[ Int64.to_int !modulus] ^ !s ;
 
           while  !quotient <> 0L do
             let a, b = Js_int64.div_mod (!quotient) wbase in
             quotient := a;
             modulus := b;
-            s := Bs_string.string_of_char cvtbl.[Int64.to_int !modulus] ^ !s ;
+            s := Bs_string.of_char cvtbl.[Int64.to_int !modulus] ^ !s ;
           done;
         end
       else
         let a, b =  Js_int64.div_mod x wbase  in
         let quotient = ref a  in
         let modulus = ref b in
         s :=
-          Bs_string.string_of_char 
+          Bs_string.of_char 
             cvtbl.[ Int64.to_int !modulus] ^ !s ;
 
         while  !quotient <> 0L do
           let a, b = Js_int64.div_mod (!quotient) wbase in
           quotient := a;
           modulus := b;
-          s := Bs_string.string_of_char cvtbl.[Int64.to_int !modulus] ^ !s ;
+          s := Bs_string.of_char cvtbl.[Int64.to_int !modulus] ^ !s ;
         done
 
     | Dec ->
@@ -454,29 +454,29 @@ let caml_int64_format fmt x =
                  e)  in
         let modulus = ref f in
         s :=
-          Bs_string.string_of_char 
+          Bs_string.of_char 
             cvtbl.[Int64.to_int !modulus] ^ !s ;
 
         while !quotient <> 0L do
           let a, b = Js_int64.div_mod (!quotient) wbase in
           quotient := a;
           modulus := b;
-          s := Bs_string.string_of_char cvtbl.[Int64.to_int !modulus] ^ !s ;
+          s := Bs_string.of_char cvtbl.[Int64.to_int !modulus] ^ !s ;
         done;
 
       else
         let a, b =  Js_int64.div_mod x wbase  in
         let quotient = ref a  in
         let modulus = ref b in
         s :=
-          Bs_string.string_of_char 
+          Bs_string.of_char 
             cvtbl.[ Int64.to_int !modulus] ^ !s ;
 
         while  !quotient <> 0L do
           let a, b = Js_int64.div_mod (!quotient) wbase in
           quotient := a;
           modulus := b;
-          s := Bs_string.string_of_char cvtbl.[Int64.to_int !modulus] ^ !s ;
+          s := Bs_string.of_char cvtbl.[Int64.to_int !modulus] ^ !s ;
         done;
   end;
   if f.prec >= 0 then
@@ -531,7 +531,7 @@ let caml_format_float fmt x =
         let prec = if prec <> 0 then prec else 1 in
         s := Js_float.to_exponential x (prec - 1);
         let j = Bs_string.index_of !s "e" in 
-        let  exp = Js_int.from_any @@ Bs_string.slice_rest !s (j + 1)  in 
+        let  exp = int_of_float @@ Js_float.of_any @@ Bs_string.slice_rest !s (j + 1)  in 
         if exp < -4 || x >= 1e21 ||Bs_string.length (Js_float.toFixed x 0) > prec then 
           let i = ref (j - 1)  in
           while !s.[!i] = '0' do 

jscomp/runtime/caml_string.ml

@@ -25,7 +25,7 @@
 
 
 
-external new_uninitialized : int -> bytes = "#create_array" 
+external new_uninitialized : int -> bytes = "Array"  [@@bs.new]
 external to_int_array : bytes -> int array = "%identity"
 external of_int_array : int array -> bytes = "%identity"
 

jscomp/runtime/js_float.ml

@@ -52,5 +52,7 @@ external max : float -> float -> float = "Math.max"
 
 external random : unit -> float = "Math.random"
 [@@bs.val ]
-external of_any : 'a -> float = "#anything_to_number"
+
+external of_any : 'a -> float = "Number"
+[@@bs.val]
 

jscomp/runtime/js_int.ml

@@ -22,4 +22,10 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-external from_any : 'a -> int = "#anything_to_number" (* + conversion*)
+
+ (** If we use number, we need coerce to int32 by adding `|0`,
+    otherwise `+0` can be wrong.
+    Most JS API is float oriented, it may overflow int32 or 
+    comes with [NAN]
+  *)
+(* + conversion*)

jscomp/syntax/ast_core_type.ml

@@ -104,6 +104,10 @@ let is_user_bool (ty : t) =
   | Ptyp_constr({txt = Lident "bool"},[]) -> true 
   | _ -> false 
 
+let is_user_int (ty : t) = 
+  match ty.ptyp_desc with 
+  | Ptyp_constr({txt = Lident "int"},[]) -> true 
+  | _ -> false 
 
 let is_optional_label l =
   String.length l > 0 && l.[0] = '?'

jscomp/syntax/ast_core_type.mli

@@ -77,6 +77,8 @@ val is_user_option : t -> bool
 
 val is_user_bool : t -> bool
 
+val is_user_int : t -> bool
+
 val is_optional_label : string -> bool 
 
 (** 

jscomp/test/.depend

@@ -99,6 +99,7 @@ class_repr.cmj : ../stdlib/oo.cmj
 class_setter_getter.cmj : ../runtime/js.cmj class_setter_getter.cmi
 class_test.cmj : mt.cmj
 class_type_ffi_test.cmj : ../runtime/js.cmj
+compare_test.cmj :
 complex_if_test.cmj : mt.cmj ../stdlib/bytes.cmj
 complex_test.cmj : mt.cmj ../stdlib/complex.cmj
 complex_while_loop.cmj :
@@ -241,8 +242,8 @@ int64_test.cmj : ../stdlib/pervasives.cmj ../stdlib/nativeint.cmj mt.cmj \
 int_hashtbl_test.cmj : mt.cmj ../stdlib/list.cmj ../stdlib/hashtbl.cmj \
     ../stdlib/array.cmj
 int_map.cmj : ../stdlib/map.cmj
-int_overflow_test.cmj : ../stdlib/string.cmj mt.cmj ../stdlib/int32.cmj \
-    ../stdlib/char.cmj
+int_overflow_test.cmj : ../stdlib/string.cmj mt.cmj ../runtime/js_float.cmj \
+    ../stdlib/int32.cmj ../stdlib/char.cmj
 io_test.cmj : ../runtime/js.cmj
 js_array_test.cmj : mt.cmj ../runtime/js.cmj
 js_bool_test.cmj : mt.cmj ../runtime/js.cmj

jscomp/test/Makefile

@@ -112,7 +112,8 @@ OTHERS := literals a test_ari test_export2 test_internalOO test_obj_simple_ffi t
 	test\
 	undef_regression2_test\
 	js_global_test\
-	bang_primitive
+	bang_primitive\
+	compare_test
 
 
 # bs_uncurry_test

jscomp/test/bang_primitive.js

@@ -12,5 +12,13 @@ function test(x, y) {
         ];
 }
 
+function f(x, _) {
+  return /* tuple */[
+          String.fromCharCode.apply(null,x),
+          0
+        ];
+}
+
 exports.test = test;
+exports.f    = f;
 /* No side effect */

jscomp/test/bang_primitive.ml

@@ -27,4 +27,18 @@ let test x y=
   ge x y,
   eq x y,
   neq x y
-  
+
+(*
+external append : 'a array -> 'a array -> 'a array = "#array_append"
+
+
+let f x y = append x y
+*)
+
+external of_small_int_array : int array -> string = "#string_of_small_int_array"
+(* external string_of_char : char -> string = "#string_of_char" *)
+(* string_of_char y  *)
+
+let f x y = 
+  of_small_int_array x, 0
+  

jscomp/test/compare_test.js

@@ -0,0 +1,49 @@
+'use strict';
+
+var Caml_obj = require("../../lib/js/caml_obj");
+
+function compare(x, y) {
+  switch (x) {
+    case 0 : 
+        return +(y === /* A */0);
+    case 1 : 
+        return +(y === /* B */1);
+    case 2 : 
+        return +(y === /* C */2);
+    
+  }
+}
+
+function compare2(x, y) {
+  switch (x) {
+    case 0 : 
+        if (y !== 0) {
+          return /* false */0;
+        }
+        else {
+          return /* true */1;
+        }
+    case 1 : 
+        if (y !== 1) {
+          return /* false */0;
+        }
+        else {
+          return /* true */1;
+        }
+    case 2 : 
+        if (y >= 2) {
+          return /* true */1;
+        }
+        else {
+          return /* false */0;
+        }
+    
+  }
+}
+
+var compare3 = Caml_obj.caml_equal;
+
+exports.compare  = compare;
+exports.compare2 = compare2;
+exports.compare3 = compare3;
+/* No side effect */

jscomp/test/compare_test.ml

@@ -0,0 +1,29 @@
+type t = 
+    | A
+    | B 
+    | C 
+
+let compare (x : t) (y : t) =
+    match x with 
+    | A -> y = A
+    | B -> y = B
+    | C -> y = C
+
+
+
+(* There is a downside in this way of writing
+    if I comment [C,C] there will be no warning
+*)
+let compare2 (x : t) (y : t) = 
+    match x,y with          
+    | A,A
+    | B,B
+    | C,C 
+    -> true 
+    | (A|B|C),_ -> false 
+
+let compare3 (x : t) (y : t) = 
+    match x with 
+    | A -> x = y (* still polymoprhic equal *)
+    | B -> x = y
+    | C -> x = y    

jscomp/test/float_test.js

@@ -222,9 +222,13 @@ var param$8 = Caml_float.caml_expm1_float(0);
 
 Mt_global.collect_eq(test_id, suites, 'File "float_test.ml", line 59, characters 5-12', param$8, 0);
 
-var param$9 = Caml_float.caml_expm1_float(2);
+var param$9 = Number("3.0");
 
-Mt_global.collect_approx(test_id, suites, 'File "float_test.ml", line 60, characters 9-16', param$9, 6.38905609893065);
+Mt_global.collect_eq(test_id, suites, 'File "float_test.ml", line 60, characters 5-12', param$9, 3.0);
+
+var param$10 = Caml_float.caml_expm1_float(2);
+
+Mt_global.collect_approx(test_id, suites, 'File "float_test.ml", line 61, characters 9-16', param$10, 6.38905609893065);
 
 var match$4 = Caml_float.caml_modf_float(32.3);
 

jscomp/test/float_test.ml

@@ -57,6 +57,7 @@ let () =
   eq __LOC__  (copysign (3.) (0.)) 3.;
   eq __LOC__ (log10 10.) 1.;
   eq __LOC__ (expm1 0.) 0. ;
+  eq __LOC__ (Js_float.of_any "3.0") 3.0;
   approx __LOC__ (expm1 2.) 6.38905609893065
 ;;