remove Pstring_get_{16,32,64}

bobzhang · bobzhang · commit d8b1d58cdf17 · 2020-02-27T13:05:13.000+08:00
diff --git a/jscomp/core/js_long.ml b/jscomp/core/js_long.ml
@@ -167,7 +167,7 @@ let compare (args : J.expression list) =
 
 (* let of_string (args : J.expression list) = 
   int64_call "of_string" args  *)
-let get64 = int64_call "get64"
+(* 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 = 
diff --git a/jscomp/core/js_long.mli b/jscomp/core/js_long.mli
@@ -63,4 +63,4 @@ val compare : int64_call
 (* val of_string : int64_call *)
 val float_of_bits : int64_call
 val bits_of_float : int64_call  
-val get64 : int64_call
+(* val get64 : int64_call *)
diff --git a/jscomp/core/lam_analysis.ml b/jscomp/core/lam_analysis.ml
@@ -191,9 +191,9 @@ let rec no_side_effects (lam : Lam.t) : bool =
       (* size of the nth dimension of a big array *)
       | Pbigarraydim _
       (* load/set 16,32,64 bits from a string: (unsafe)*)
-      | Pstring_load_16 _
+      (* | Pstring_load_16 _
       | Pstring_load_32 _
-      | Pstring_load_64 _
+      | Pstring_load_64 _ *)
       (* | Pstring_set_16 _
       | Pstring_set_32 _
       | Pstring_set_64 _ *)
diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml
@@ -686,12 +686,12 @@ let translate  loc
     E.runtime_call Js_runtime_modules.int32 "caml_int32_bswap" args
   | Pbbswap Lambda.Pint64
     -> Js_long.swap args 
-  | Pstring_load_16 unsafe
+  (* | Pstring_load_16 unsafe
     -> E.runtime_call Js_runtime_modules.string "caml_string_get16" args
   | Pstring_load_32 unsafe
     -> E.runtime_call Js_runtime_modules.string "caml_string_get32" args
   | Pstring_load_64 unsafe
-    -> Js_long.get64 args
+    -> Js_long.get64 args *)
 
   | Plazyforce  
   (*   let parm = Ident.create "prim" in 
diff --git a/jscomp/core/lam_convert.ml b/jscomp/core/lam_convert.ml
@@ -364,12 +364,13 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
   | Plsrbint x -> prim ~primitive:(Plsrbint x) ~args loc
   | Pasrbint x -> prim ~primitive:(Pasrbint x) ~args loc
   | Pbigarraydim x -> prim ~primitive:(Pbigarraydim x) ~args loc
-  | Pstring_load_16 x -> prim ~primitive:(Pstring_load_16 x) ~args loc
-  | Pstring_load_32 x -> prim ~primitive:(Pstring_load_32 x) ~args loc
-  | Pstring_load_64 x -> prim ~primitive:(Pstring_load_64 x) ~args loc
+  | Pstring_load_16 _
+  | Pstring_load_32 _
+  | Pstring_load_64 _
   | Pstring_set_16 _ 
   | Pstring_set_32 _ 
-  | Pstring_set_64 _ -> assert false
+  | Pstring_set_64 _ -> 
+    Location.raise_errorf ~loc "unsupported primitive"
   | Pbigstring_load_16 x -> prim ~primitive:(Pbigstring_load_16 x) ~args loc
   | Pbigstring_load_32 x -> prim ~primitive:(Pbigstring_load_32 x) ~args loc
   | Pbigstring_load_64 x -> prim ~primitive:(Pbigstring_load_64 x) ~args loc
diff --git a/jscomp/core/lam_dispatch_primitive.ml b/jscomp/core/lam_dispatch_primitive.ml
@@ -552,7 +552,7 @@ let translate loc (prim_name : string)
       call Js_runtime_modules.char
     | "caml_string_get"    
       -> 
-        call Js_runtime_modules.string
+        E.runtime_call Js_runtime_modules.string "get" args
     | "bytes_to_string"
     | "bytes_of_string"
     | "caml_blit_string" 
diff --git a/jscomp/core/lam_primitive.ml b/jscomp/core/lam_primitive.ml
@@ -116,9 +116,9 @@ type t =
   (* size of the nth dimension of a big array *)
   | Pbigarraydim of int
   (* load/set 16,32,64 bits from a string: (unsafe)*)
-  | Pstring_load_16 of bool
+  (* | Pstring_load_16 of bool
   | Pstring_load_32 of bool
-  | Pstring_load_64 of bool
+  | Pstring_load_64 of bool *)
   (* | Pstring_set_16 of bool
   | Pstring_set_32 of bool
   | Pstring_set_64 of bool *)
@@ -315,9 +315,9 @@ let eq_primitive_approx ( lhs : t) (rhs : t) =
   | Pcvtbint  (boxed_integer, boxed_integer1) -> (match rhs with Pcvtbint (boxed_integer10, boxed_integer11) -> Lam_compat.eq_boxed_integer boxed_integer boxed_integer10 && Lam_compat.eq_boxed_integer boxed_integer1 boxed_integer11 | _ -> false )
   | Pbintcomp  (boxed_integer , comparison) -> (match rhs with Pbintcomp(boxed_integer1, comparison1) -> Lam_compat.eq_boxed_integer boxed_integer boxed_integer1 && Lam_compat.eq_comparison comparison comparison1 | _ -> false)  
   | Pbigarraydim dim -> (match rhs with Pbigarraydim dim1 -> dim = dim1 | _ -> false )
-  | Pstring_load_16 str ->  (match  rhs with Pstring_load_16 str1 -> str = str1  | _ -> false )
+  (* | Pstring_load_16 str ->  (match  rhs with Pstring_load_16 str1 -> str = str1  | _ -> false )
   | Pstring_load_32 b -> (match rhs with Pstring_load_32 b1 -> b = b1 | _ -> false )    
-  | Pstring_load_64 b -> (match rhs with Pstring_load_64 b1 -> b = b1 | _ -> false )    
+  | Pstring_load_64 b -> (match rhs with Pstring_load_64 b1 -> b = b1 | _ -> false )     *)
   (* | Pstring_set_16 b -> (match rhs with Pstring_set_16 b1 -> b = b1 | _ -> false )    
   | Pstring_set_32 b -> (match rhs with Pstring_set_32 b1 -> b = b1 | _ -> false )    
   | Pstring_set_64 b -> (match rhs with Pstring_set_64 b1 -> b = b1 | _ -> false )       *)
diff --git a/jscomp/core/lam_primitive.mli b/jscomp/core/lam_primitive.mli
@@ -111,9 +111,9 @@ type t =
   (* size of the nth dimension of a big array *)
   | Pbigarraydim of int
   (* load/set 16,32,64 bits from a string: (unsafe)*)
-  | Pstring_load_16 of bool
+  (* | Pstring_load_16 of bool
   | Pstring_load_32 of bool
-  | Pstring_load_64 of bool
+  | Pstring_load_64 of bool *)
   (* | Pstring_set_16 of bool
   | Pstring_set_32 of bool
   | Pstring_set_64 of bool *)
diff --git a/jscomp/core/lam_print.ml b/jscomp/core/lam_print.ml
@@ -268,7 +268,7 @@ let primitive ppf (prim : Lam_primitive.t) = match prim with
   | Pbigarrayset(unsafe, n, kind, layout) ->
     print_bigarray "set" unsafe kind ppf layout
   | Pbigarraydim(n) -> fprintf ppf "Bigarray.dim_%i" n
-  | Pstring_load_16(unsafe) ->
+  (* | Pstring_load_16(unsafe) ->
     if unsafe then fprintf ppf "string.unsafe_get16"
     else fprintf ppf "string.get16"
   | Pstring_load_32(unsafe) ->
@@ -277,7 +277,7 @@ let primitive ppf (prim : Lam_primitive.t) = match prim with
   | Pstring_load_64(unsafe) ->
     if unsafe then fprintf ppf "string.unsafe_get64"
     else fprintf ppf "string.get64"
-  (* | Pstring_set_16(unsafe) ->
+  (* | Pstring_set_16(unsafe) -> *)
     if unsafe then fprintf ppf "string.unsafe_set16"
     else fprintf ppf "string.set16"
   | Pstring_set_32(unsafe) ->
diff --git a/jscomp/runtime/caml_array.ml b/jscomp/runtime/caml_array.ml
@@ -26,11 +26,14 @@
 external caml_array_dup : 'a array -> (_ [@bs.as 0]) -> 'a array = 
   "slice"  [@@bs.send]
 
+let (.!()) = Caml_array_extern.unsafe_get  
+let (.!()<-) = Caml_array_extern.unsafe_set
+
 let caml_array_sub (x : 'a array) (offset : int) (len : int) = 
   let result = Caml_array_extern.new_uninitialized len  in
   let j = {contents = 0} and i =  {contents = offset} in
   while j.contents < len do
-    Caml_array_extern.unsafe_set result j.contents (Caml_array_extern.unsafe_get x i.contents);
+    result.!(j.contents) <- x.!(i.contents);
     j.contents <- j.contents + 1; 
     i.contents <- i.contents + 1;
   done;
@@ -50,7 +53,7 @@ let rec fill arr i l =
       let k = {contents =  i} in
       let j = {contents = 0} in
       while j.contents < l do 
-        Caml_array_extern.unsafe_set arr k.contents (Caml_array_extern.unsafe_get  x j.contents);
+        arr.!(k.contents) <- x .!(j.contents);
         k.contents <- k.contents + 1; 
         j.contents <- j.contents + 1;
       done;
@@ -65,35 +68,35 @@ let  caml_array_concat (l : 'a array list) : 'a array =
 let caml_array_set xs index newval = 
   if index <0 || index >= Caml_array_extern.length xs
   then raise (Invalid_argument "index out of bounds")
-  else Caml_array_extern.unsafe_set xs index  newval
+  else  xs.!( index)<-  newval
 
 let caml_array_get xs index =  
   if index <0 || index >= Caml_array_extern.length xs then
     raise (Invalid_argument "index out of bounds")
-  else Caml_array_extern.unsafe_get xs index
+  else  xs.!( index)
 
 
 let caml_make_vect len init = 
   let b = Caml_array_extern.new_uninitialized len in
   for i = 0 to len - 1 do 
-    Caml_array_extern.unsafe_set b i  init
+     b.!(i) <-  init
   done;
   b
 
 let caml_make_float_vect len = 
   let b = Caml_array_extern.new_uninitialized len in
   for i = 0 to len - 1 do 
-      Caml_array_extern.unsafe_set b i  0.
+       b.!(i) <-  0.
   done;
   b  
   
 let caml_array_blit a1 i1 a2 i2 len = 
   if i2 <= i1 then 
     for j = 0 to len - 1 do
-      Caml_array_extern.unsafe_set a2 (j+i2) (Caml_array_extern.unsafe_get a1 (j+i1))
+      a2.! (j+i2) <- a1.! (j+i1)
     done
   else
     for j = len - 1 downto 0 do
-      Caml_array_extern.unsafe_set a2 (j+i2) (Caml_array_extern.unsafe_get a1 (j+i1))
+       a2 .!(j+i2) <-  a1.! (j+i1)
     done
 
diff --git a/jscomp/runtime/caml_int64.ml b/jscomp/runtime/caml_int64.ml
@@ -458,7 +458,7 @@ let  bits_of_float : float -> t  = fun x ->
     ~hi:( to_nat (Int32_array.unsafe_get int32 1)) *)
 
 (** used by "%caml_string_get64" *)
-let get64 (s : string) (i:int) : t =
+(* let get64 (s : string) (i:int) : t =
   let module String = Caml_string_extern in 
   mk ~lo:
     (Caml_nativeint_extern.logor
@@ -476,4 +476,4 @@ let get64 (s : string) (i:int) : t =
          (Caml_nativeint_extern.logor
             (Caml_nativeint_extern.of_int (Caml_char.code s.[i+6]) << 48 )
             (Caml_nativeint_extern.of_int (Caml_char.code s.[i+7]) << 56 )))
-
+ *)
diff --git a/jscomp/runtime/caml_int64.mli b/jscomp/runtime/caml_int64.mli
@@ -81,7 +81,7 @@ val float_of_bits : t -> float
 (** [bits_of_float fl] it is undefined behaivor when [f] is NaN*)
 val bits_of_float : float -> t 
 
-val get64 : string -> int -> t
+(* val get64 : string -> int -> t *)
 
 
 external unsafe_to_int64 : t -> int64 = "%identity"           
diff --git a/jscomp/runtime/caml_string.ml b/jscomp/runtime/caml_string.ml
@@ -31,21 +31,23 @@
 
 
 
-let caml_string_get s i= 
+let get s i= 
   if i >=Caml_string_extern.length s || i < 0  then
     raise (Invalid_argument "index out of bounds") 
   else Caml_string_extern.unsafe_get s i
 
-let caml_string_get16 s i = 
+(* let caml_string_get16 s i = 
   Caml_char.code (Caml_string_extern.unsafe_get s i) + Caml_char.code (Caml_string_extern.unsafe_get s (i+1)) lsl 8  
 
 let caml_string_get32 s i = 
   Caml_char.code (Caml_string_extern.unsafe_get s i) + 
   Caml_char.code (Caml_string_extern.unsafe_get s (i+1)) lsl 8  + 
   Caml_char.code (Caml_string_extern.unsafe_get s (i+2)) lsl 16 + 
-  Caml_char.code (Caml_string_extern.unsafe_get s (i+3)) lsl 24
+  Caml_char.code (Caml_string_extern.unsafe_get s (i+3)) lsl 24 *)
 
-let get s i =
+
+(* let get s i =
   if i < 0 || i >= Caml_string_extern.length s then
     raise (Invalid_argument "index out of bounds")
   else Caml_string_extern.unsafe_get s i      
+ *)
diff --git a/jscomp/runtime/caml_string.mli b/jscomp/runtime/caml_string.mli
@@ -22,9 +22,5 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-val caml_string_get : string -> int -> char 
-val caml_string_get16 : string -> int -> int
-val caml_string_get32 : string -> int -> int
-
 
 val get : string -> int -> char 
diff --git a/jscomp/test/string_get_set_test.js b/jscomp/test/string_get_set_test.js
@@ -2,92 +2,18 @@
 
 var Mt = require("./mt.js");
 var Block = require("../../lib/js/block.js");
-var Caml_int64 = require("../../lib/js/caml_int64.js");
-var Caml_string = require("../../lib/js/caml_string.js");
 
-Mt.from_pair_suites("String_get_set_test", /* :: */[
+Mt.from_pair_suites("string_get_set_test.ml", /* :: */[
       /* tuple */[
-        "File \"string_get_set_test.ml\", line 8, characters 4-11",
+        "File \"string_get_set_test.ml\", line 6, characters 4-11",
         (function (param) {
             return /* Eq */Block.__(0, [
-                      Caml_string.caml_string_get16("2\0", 0),
-                      50
+                      /* "h" */104,
+                      /* "h" */104
                     ]);
           })
       ],
-      /* :: */[
-        /* tuple */[
-          "File \"string_get_set_test.ml\", line 9, characters 4-11",
-          (function (param) {
-              return /* Eq */Block.__(0, [
-                        Caml_string.caml_string_get16("20", 0),
-                        12338
-                      ]);
-            })
-        ],
-        /* :: */[
-          /* tuple */[
-            "File \"string_get_set_test.ml\", line 10, characters 4-11",
-            (function (param) {
-                return /* Eq */Block.__(0, [
-                          Caml_string.caml_string_get32("0123", 0),
-                          858927408
-                        ]);
-              })
-          ],
-          /* :: */[
-            /* tuple */[
-              "File \"string_get_set_test.ml\", line 11, characters 4-11",
-              (function (param) {
-                  return /* Eq */Block.__(0, [
-                            Caml_string.caml_string_get32("0123", 0),
-                            858927408
-                          ]);
-                })
-            ],
-            /* :: */[
-              /* tuple */[
-                "File \"string_get_set_test.ml\", line 12, characters 4-11",
-                (function (param) {
-                    return /* Eq */Block.__(0, [
-                              Caml_string.caml_string_get32("3210", 0),
-                              808530483
-                            ]);
-                  })
-              ],
-              /* :: */[
-                /* tuple */[
-                  "File \"string_get_set_test.ml\", line 13, characters 4-11",
-                  (function (param) {
-                      return /* Eq */Block.__(0, [
-                                Caml_int64.get64("12345678", 0),
-                                /* int64 */[
-                                  /* hi */943142453,
-                                  /* lo */875770417
-                                ]
-                              ]);
-                    })
-                ],
-                /* :: */[
-                  /* tuple */[
-                    "File \"string_get_set_test.ml\", line 14, characters 4-11",
-                    (function (param) {
-                        return /* Eq */Block.__(0, [
-                                  Caml_int64.get64("87654321", 0),
-                                  /* int64 */[
-                                    /* hi */825373492,
-                                    /* lo */892745528
-                                  ]
-                                ]);
-                      })
-                  ],
-                  /* [] */0
-                ]
-              ]
-            ]
-          ]
-        ]
-      ]
+      /* [] */0
     ]);
 
 /*  Not a pure module */
diff --git a/jscomp/test/string_get_set_test.ml b/jscomp/test/string_get_set_test.ml
@@ -1,18 +1,24 @@
+[@@@bs.config{no_export}]
+let (.%()) (s : string) i = 
+    s.[i] 
 
-external caml_string_get_16 : string -> int -> int = "%caml_string_get16"
+;; Mt.from_pair_suites __FILE__    [
+    __LOC__, (fun _ -> Eq("h".%(0)  ,'h'))
+]
+(* external caml_string_get_16 : string -> int -> int = "%caml_string_get16"
 external caml_string_get_32 : string -> int -> int32 = "%caml_string_get32"
-external caml_string_get_64 : string -> int -> int64 = "%caml_string_get64"
+external caml_string_get_64 : string -> int -> int64 = "%caml_string_get64" *)
 
 (* TODO: endian-aware ? *)
-;; Mt.from_pair_suites __MODULE__ Mt.[
+(* ;; Mt.from_pair_suites __MODULE__ Mt.[
     __LOC__ , (fun _ -> Eq (caml_string_get_16 "2\000" 0, 50));
     __LOC__ , (fun _ -> Eq (caml_string_get_16 "20" 0, 12338));
     __LOC__, (fun _ -> Eq(caml_string_get_32 "0123" 0, 858927408l));
     __LOC__, (fun _ -> Eq(caml_string_get_32 "0123" 0, 858927408l));
     __LOC__, (fun _ -> Eq(caml_string_get_32 "3210" 0, 808530483l));
     __LOC__, (fun _ -> Eq(caml_string_get_64 "12345678" 0, 4050765991979987505L));
     __LOC__, (fun _ -> Eq(caml_string_get_64 "87654321" 0, 3544952156018063160L))
-]
+] *)
 
 (* (\** does not make sense under immutable string setting *\) *)
 (* external caml_string_set_16 : string -> int -> int -> unit = *)
diff --git a/lib/es6/caml_int64.js b/lib/es6/caml_int64.js
diff --git a/lib/es6/caml_string.js b/lib/es6/caml_string.js
diff --git a/lib/js/caml_int64.js b/lib/js/caml_int64.js
diff --git a/lib/js/caml_string.js b/lib/js/caml_string.js
