Merge pull request #4598 from BuckleScript/bytes

clean up runtime support: remove legacy caml_char primitives

Author: bobzhang

jscomp/core/lam_dispatch_primitive.ml

@@ -293,8 +293,10 @@ let translate loc (prim_name : string)
         | [e0; e1] -> E.float_mul e0 e1 
         | _ -> assert false  
       end
-    | "caml_bytes_equal" ->   
-      call Js_runtime_modules.caml_primitive
+    | "caml_bytes_compare"
+    | "caml_bytes_equal" 
+      -> 
+      call Js_runtime_modules.bytes
     | "caml_int64_succ" -> 
       E.runtime_call Js_runtime_modules.int64 "succ" args 
     | "caml_int64_to_string" -> 
@@ -524,11 +526,10 @@ let translate loc (prim_name : string)
     | "caml_int32_compare"
     | "caml_nativeint_compare"
     | "caml_float_compare"
-    | "caml_bytes_compare"
+
     | "caml_string_compare" 
     -> 
       call Js_runtime_modules.caml_primitive
-
     | "caml_bool_min"  
     | "caml_int_min"
     | "caml_float_min"
@@ -560,17 +561,10 @@ let translate loc (prim_name : string)
             call Js_runtime_modules.caml_primitive
         | _ -> assert false 
       end
-    | "caml_fill_string"
-    | "caml_fill_bytes"
-      -> 
-        E.runtime_call 
-          Js_runtime_modules.bytes "caml_fill_bytes" args
-    | "caml_is_printable" 
-      -> 
-      call Js_runtime_modules.char
     | "caml_string_get"    
       -> 
         E.runtime_call Js_runtime_modules.string "get" args
+    | "caml_fill_bytes"
     | "bytes_to_string"
     | "bytes_of_string"
     | "caml_blit_string" 

jscomp/ext/js_runtime_modules.ml

@@ -33,7 +33,6 @@ let array = "Caml_array"
 let format = "Caml_format"
 let string = "Caml_string"
 let bytes = "Caml_bytes"
-let char = "Caml_char"
 let float = "Caml_float"
 let hash_primitive = "Caml_hash_primitive" 
 let hash = "Caml_hash"

jscomp/main/builtin_cmi_datasets.ml

@@ -22,6 +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 (.!()) : int array -> int -> int = "" [@@bs.get_index]
 
 let raiseWhenNotFound x =
   if Js.testAny x then raise Not_found 
@@ -30,7 +31,7 @@ let raiseWhenNotFound x =
 let rec fromIntAux (enum : int) i len xs =
   if i = len then None
   else
-    let k = Js.Array2.unsafe_get xs i in
+    let k = xs.!(i) in
     if k = enum then Some i
     else fromIntAux enum (i + 1) len xs
 
@@ -40,7 +41,7 @@ let fromInt len (xs : int array) (enum : int )  : 'variant option =
 let rec fromIntAssertAux len (enum : int) i  xs =
   if i = len then raise Not_found
   else
-    let k = Js.Array2.unsafe_get xs i in
+    let k = xs.!(i) in
     if k = enum then  i
     else fromIntAssertAux len enum (i + 1)  xs
 

jscomp/main/builtin_cmj_datasets.ml

@@ -30,7 +30,7 @@ build others/js_json.cmj : cc_cmi others/js_json.ml | others/js_array2.cmj other
 build others/js_json.cmi : cc others/js_json.mli | others/js_dict.cmi others/js_null.cmi others/js_string.cmj others/js_types.cmi runtime
 build others/js_list.cmj : cc_cmi others/js_list.ml | others/js_array2.cmj others/js_list.cmi others/js_vector.cmj runtime
 build others/js_list.cmi : cc others/js_list.mli | others/js_vector.cmi runtime
-build others/js_mapperRt.cmj : cc_cmi others/js_mapperRt.ml | others/js_array2.cmj others/js_mapperRt.cmi runtime
+build others/js_mapperRt.cmj : cc_cmi others/js_mapperRt.ml | others/js_mapperRt.cmi runtime
 build others/js_mapperRt.cmi : cc others/js_mapperRt.mli | runtime
 build others/js_math.cmi others/js_math.cmj : cc others/js_math.ml | others/js_int.cmj runtime
 build others/js_null.cmj : cc_cmi others/js_null.ml | others/js_exn.cmj others/js_null.cmi runtime

jscomp/others/js_mapperRt.ml

@@ -141,3 +141,42 @@ let bytes_of_string  s =
        *)
   done;
   res
+
+
+  let rec caml_bytes_compare_aux (s1 : bytes) (s2 : bytes) off len def =   
+    if off < len then 
+      let a, b = Caml_bytes_extern.unsafe_get s1 off, Caml_bytes_extern.unsafe_get s2 off in  
+      if a > b then 1
+      else if a < b then -1 
+      else caml_bytes_compare_aux s1 s2 (off + 1) len def 
+    else def   
+  
+(* code path could be using a tuple if we can eliminate the tuple allocation for code below
+   {[
+     let (len, v) = 
+       if len1 = len2 then (..,...)
+       else (.., .)
+   ]}
+
+*)
+let caml_bytes_compare (s1 : bytes) (s2 : bytes) : int =  
+  let len1, len2 = Caml_bytes_extern.length s1, Caml_bytes_extern.length s2 in 
+  if len1 = len2 then 
+    caml_bytes_compare_aux s1 s2 0 len1 0 
+  else if len1 < len2 then   
+    caml_bytes_compare_aux s1 s2 0 len1 (-1)
+  else
+    caml_bytes_compare_aux s1 s2 0 len2 1 
+
+let rec caml_bytes_equal_aux (s1 : bytes) s2 (off : int) len =      
+  if off = len then true 
+  else 
+    let a, b = Caml_bytes_extern.unsafe_get s1 off, Caml_bytes_extern.unsafe_get s2 off in  
+    a = b
+    && caml_bytes_equal_aux s1 s2 (off + 1) len 
+
+let caml_bytes_equal (s1 : bytes) (s2 : bytes) : bool = 
+  let len1, len2 = Caml_bytes_extern.length s1, Caml_bytes_extern.length s2 in 
+  len1 = len2 &&
+  caml_bytes_equal_aux s1 s2 0 len1 
+

jscomp/others/release.ninja

@@ -37,3 +37,5 @@ val caml_blit_string :
   int -> 
   unit
 val bytes_of_string : string -> bytes
+val caml_bytes_compare: bytes -> bytes -> int
+val caml_bytes_equal : bytes -> bytes -> bool 

jscomp/runtime/caml_bytes.ml

@@ -24,10 +24,19 @@
 
 
 
+ external (.![]) : string -> int -> int = "%string_unsafe_get" 
+ external (.!()) : string -> int -> char = "%string_unsafe_get" 
 
+let code_0 = "0".![0]
+let code_a = "a".![0]
+let code_A = "A".![0]
 
+module Caml_char = struct 
+  external code : char -> int = "%identity"  
+  external unsafe_chr : int -> char = "%identity"
+end  
 
-let caml_failwith s = raise (Failure  s)
+let failwith s = raise (Failure  s)
 (* let caml_invalid_argument s= raise (Invalid_argument s ) *)
 
 let (>>>) = Caml_nativeint_extern.shift_right_logical
@@ -40,11 +49,11 @@ let ( *~ ) = Caml_nativeint_extern.mul
 let parse_digit c = 
   match c with 
   | '0' .. '9' 
-    -> Caml_char.code c - Caml_char.code '0'
+    -> Caml_char.code c - code_0
   | 'A' .. 'Z'
-    -> Caml_char.code c - (Caml_char.code 'A' - 10)
+    -> Caml_char.code c - (code_A - 10)
   | 'a' .. 'z'
-    -> Caml_char.code c - (Caml_char.code 'a' - 10 )
+    -> Caml_char.code c - (code_a - 10 )
   | _ -> -1
 
 type of_string_base =
@@ -86,41 +95,39 @@ let parse_sign_and_base (s : string) =
 
 
 let caml_int_of_string s = 
-  let module String = Caml_string_extern in 
   let i, sign, hbase = parse_sign_and_base s in
   let base  = Caml_nativeint_extern.of_int (int_of_string_base hbase) in
   let threshold = (-1n >>> 0) in 
   let len =Caml_string_extern.length s in  
-  let c = if i < len then s.[i] else '\000' in
+  let c = if i < len then s.!(i) else '\000' in
   let d = to_nat (parse_digit c) in
   let () =
     if d < 0n || d >=  base then
-      caml_failwith "int_of_string" in
+      failwith "int_of_string" in
   (* let () = [%bs.debugger]  in *)
   let rec aux acc k = 
     if k = len then acc 
     else 
-      let a = s.[k] in
+      let a = s.!(k) in
       if a  = '_' then aux acc ( k +  1) 
       else 
         let v = to_nat  (parse_digit a) in  
         if v < 0n || v >=  base then 
-          caml_failwith "int_of_string"
+          failwith "int_of_string"
         else 
           let acc = base *~ acc +~  v in 
           if acc > threshold then 
-            caml_failwith "int_of_string"
+            failwith "int_of_string"
           else aux acc  ( k +   1)
   in 
   let res = sign *~ aux d (i + 1) in 
   let or_res = Caml_nativeint_extern.logor res 0n in 
   (if base = 10n && res <> or_res then 
-    caml_failwith "int_of_string");
+    failwith "int_of_string");
   or_res
 
 
 let caml_int64_of_string s = 
-  let module String = Caml_string_extern in 
   let i, sign, hbase = parse_sign_and_base s in
   let base  = Caml_int64_extern.of_int (int_of_string_base hbase) in
   let sign = Caml_int64_extern.of_nativeint sign in
@@ -136,31 +143,31 @@ let caml_int64_of_string s =
       9223372036854775807L
   in 
   let len =Caml_string_extern.length s in  
-  let c = if i < len then s.[i] else '\000' in
+  let c = if i < len then s.!(i) else '\000' in
   let d = Caml_int64_extern.of_int (parse_digit c) in
   let () =
     if d < 0L || d >=  base then
-      caml_failwith "int64_of_string" in
+      failwith "int64_of_string" in
   let (+~) = Caml_int64_extern.add  in
   let ( *~ ) = Caml_int64_extern.mul  in
 
   let rec aux acc k = 
     if k = len then acc 
     else             
-      let a = s.[k] in
+      let a = s.!(k) in
       if a  = '_' then aux acc ( k +  1) 
       else     
         let v = Caml_int64_extern.of_int (parse_digit a) in  
         if v < 0L || v >=  base || acc > threshold then 
-          caml_failwith "int64_of_string"
+          failwith "int64_of_string"
         else 
           let acc = base *~ acc +~  v in 
           aux acc  ( k +   1)
   in 
   let res = sign *~ aux d (i + 1) in 
   let or_res = Caml_int64_extern.logor res 0L in 
   (if base = 10L && res <> or_res then 
-    caml_failwith "int64_of_string");
+    failwith "int64_of_string");
   or_res
 
 type base = 
@@ -184,7 +191,7 @@ type fmt = {
   mutable conv : string
 }
 
-let lowercase c =
+let lowercase (c : char) : char =
   if (c >= 'A' && c <= 'Z')
   || (c >= '\192' && c <= '\214')
   || (c >= '\216' && c <= '\222')
@@ -220,8 +227,8 @@ let parse_format fmt =
           f.width <- 0;
           let j = ref i in 
 
-          while (let w = Caml_char.code fmt.[j.contents] - Caml_char.code '0' in w >=0 && w <= 9  ) do 
-            f.width <- f.width * 10 + Caml_char.code fmt.[j.contents] - Caml_char.code '0';
+          while (let w = fmt.![j.contents] - code_0  in w >=0 && w <= 9  ) do 
+            f.width <- f.width * 10 + fmt.![j.contents] - code_0;
             j.contents <- j.contents + 1
           done;
           aux f j.contents
@@ -230,8 +237,8 @@ let parse_format fmt =
         -> 
         f.prec <- 0;
         let j = ref (i + 1 ) in 
-        while (let w = Caml_char.code fmt.[j.contents] - Caml_char.code '0' in w >=0 && w <= 9  ) do 
-          f.prec <- f.prec * 10 + Caml_char.code fmt.[j.contents] - Caml_char.code '0';
+        while (let w = fmt.![j.contents] - code_0 in w >=0 && w <= 9  ) do 
+          f.prec <- f.prec * 10 + fmt.![j.contents] - code_0;
           j.contents <- j.contents + 1;
         done;
         aux f j.contents