remove legacy caml_is_printable primtive

bobzhang · bobzhang · commit 8ecbad99fae3 · 2020-08-05T11:32:15.000+08:00
diff --git a/jscomp/core/lam_dispatch_primitive.ml b/jscomp/core/lam_dispatch_primitive.ml
@@ -561,9 +561,6 @@ let translate loc (prim_name : string)
             call Js_runtime_modules.caml_primitive
         | _ -> assert false 
       end
-    | "caml_is_printable" 
-      -> 
-      call Js_runtime_modules.char
     | "caml_string_get"    
       -> 
         E.runtime_call Js_runtime_modules.string "get" args
diff --git a/jscomp/runtime/caml_char.ml b/jscomp/runtime/caml_char.ml
@@ -28,6 +28,3 @@ external code : char -> int = "%identity"
   
 external unsafe_chr : int -> char = "%identity"
 
-let caml_is_printable c = 
-  let code = code c in
-  code > 31 && code < 127
diff --git a/jscomp/runtime/caml_format.ml b/jscomp/runtime/caml_format.ml
@@ -26,7 +26,6 @@
 
 
 
-
 let caml_failwith s = raise (Failure  s)
 (* let caml_invalid_argument s= raise (Invalid_argument s ) *)
 
diff --git a/jscomp/runtime/caml_md5.ml b/jscomp/runtime/caml_md5.ml
@@ -143,8 +143,9 @@ let md5blk = [|
     0l;0l;0l;0l; 
     0l;0l;0l;0l
   |] 
+external (.![]) : string -> int -> int32 = "charCodeAt" [@@bs.send]
 
-let caml_md5_string s start len = 
+let caml_md5_string (s : string) start len = 
   let module String = Caml_string_extern in 
   let module Array = Caml_array_extern (* reuse the sugar .. *)
   in 
@@ -166,10 +167,10 @@ let caml_md5_string s start len =
   for  i = 1 to  i_end do 
     for j = 0 to 16 - 1 do 
       let k = i * 64 - 64 + j * 4 in 
-      md5blk.(j) <- (Caml_int32_extern.of_int (Caml_char.code s.[k])) +~
-                    (Caml_int32_extern.of_int (Caml_char.code s.[k+1]) <<~ 8 ) +~        
-                    (Caml_int32_extern.of_int (Caml_char.code s.[k+2]) <<~ 16 ) +~        
-                    (Caml_int32_extern.of_int (Caml_char.code s.[k+3]) <<~ 24 )
+      md5blk.(j) <- s.![k] +~
+                   (s.![k+1] <<~ 8 ) +~        
+                   (s.![k+2] <<~ 16 ) +~        
+                   (s.![k+3] <<~ 24 )
     done ;
     cycle state md5blk
   done ;
@@ -181,7 +182,7 @@ let caml_md5_string s start len =
   let i_end =Caml_string_extern.length s_tail - 1 in
   for i = 0 to  i_end do 
     md5blk.(i / 4 ) <- 
-      md5blk.(i / 4) |~ (Caml_int32_extern.of_int (Caml_char.code s_tail.[i]) <<~ ((i mod 4) lsl 3))
+      md5blk.(i / 4) |~ ( s_tail.![i] <<~ ((i mod 4) lsl 3))
   done ;
   let i = i_end + 1 in
   md5blk.(i / 4 ) <-  md5blk.(i / 4 ) |~ (0x80l <<~ ((i mod 4) lsl 3)) ;
diff --git a/jscomp/runtime/release.ninja b/jscomp/runtime/release.ninja
@@ -35,7 +35,7 @@ build runtime/caml_io.cmj : cc_cmi runtime/caml_io.ml | runtime/caml_io.cmi runt
 build runtime/caml_io.cmi : cc runtime/caml_io.mli | runtime/bs_stdlib_mini.cmi runtime/caml_undefined_extern.cmj runtime/js.cmi runtime/js.cmj
 build runtime/caml_lexer.cmj : cc_cmi runtime/caml_lexer.ml | runtime/caml_lexer.cmi
 build runtime/caml_lexer.cmi : cc runtime/caml_lexer.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
-build runtime/caml_md5.cmj : cc_cmi runtime/caml_md5.ml | runtime/caml_array_extern.cmj runtime/caml_char.cmj runtime/caml_int32_extern.cmj runtime/caml_md5.cmi runtime/caml_string_extern.cmj
+build runtime/caml_md5.cmj : cc_cmi runtime/caml_md5.ml | runtime/caml_array_extern.cmj runtime/caml_int32_extern.cmj runtime/caml_md5.cmi runtime/caml_string_extern.cmj
 build runtime/caml_md5.cmi : cc runtime/caml_md5.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
 build runtime/caml_module.cmj : cc_cmi runtime/caml_module.ml | runtime/caml_array_extern.cmj runtime/caml_module.cmi runtime/caml_obj.cmj
 build runtime/caml_module.cmi : cc runtime/caml_module.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
diff --git a/jscomp/test/build.ninja b/jscomp/test/build.ninja
@@ -139,7 +139,7 @@ build test/const_defs_test.cmi test/const_defs_test.cmj : cc test/const_defs_tes
 build test/const_test.cmi test/const_test.cmj : cc test/const_test.ml | $stdlib
 build test/cont_int_fold_test.cmi test/cont_int_fold_test.cmj : cc test/cont_int_fold_test.ml | $stdlib
 build test/cps_test.cmi test/cps_test.cmj : cc test/cps_test.ml | test/mt.cmj $stdlib
-build test/cross_module_inline_test.cmi test/cross_module_inline_test.cmj : cc test/cross_module_inline_test.ml | $stdlib
+build test/cross_module_inline_test.cmi test/cross_module_inline_test.cmj : cc test/cross_module_inline_test.ml | test/test_char.cmj $stdlib
 build test/custom_error_test.cmi test/custom_error_test.cmj : cc test/custom_error_test.ml | $stdlib
 build test/debug_keep_test.cmi test/debug_keep_test.cmj : cc test/debug_keep_test.ml | $stdlib
 build test/debug_mode_value.cmi test/debug_mode_value.cmj : cc test/debug_mode_value.ml | $stdlib
@@ -583,7 +583,7 @@ build test/string_bound_get_test.cmi test/string_bound_get_test.cmj : cc test/st
 build test/string_get_set_test.cmi test/string_get_set_test.cmj : cc test/string_get_set_test.ml | test/mt.cmj $stdlib
 build test/string_interp_test.cmi test/string_interp_test.cmj : cc test/string_interp_test.ml | $stdlib
 build test/string_literal_print_test.cmi test/string_literal_print_test.cmj : cc test/string_literal_print_test.ml | test/mt.cmj $stdlib
-build test/string_runtime_test.cmi test/string_runtime_test.cmj : cc test/string_runtime_test.ml | test/mt.cmj $stdlib
+build test/string_runtime_test.cmi test/string_runtime_test.cmj : cc test/string_runtime_test.ml | test/mt.cmj test/test_char.cmj $stdlib
 build test/string_set.cmi test/string_set.cmj : cc test/string_set.ml | test/set_gen.cmj $stdlib
 build test/string_set_test.cmi test/string_set_test.cmj : cc test/string_set_test.ml | test/mt.cmj test/string_set.cmj $stdlib
 build test/string_test.cmi test/string_test.cmj : cc test/string_test.ml | test/ext_string_test.cmj test/mt.cmj $stdlib
@@ -602,7 +602,7 @@ build test/test_array_append.cmi test/test_array_append.cmj : cc test/test_array
 build test/test_array_primitive.cmi test/test_array_primitive.cmj : cc test/test_array_primitive.ml | $stdlib
 build test/test_bool_equal.cmi test/test_bool_equal.cmj : cc test/test_bool_equal.ml | $stdlib
 build test/test_bs_this.cmi test/test_bs_this.cmj : cc test/test_bs_this.ml | $stdlib
-build test/test_bug.cmi test/test_bug.cmj : cc test/test_bug.ml | $stdlib
+build test/test_bug.cmi test/test_bug.cmj : cc test/test_bug.ml | test/test_char.cmj $stdlib
 build test/test_bytes.cmi test/test_bytes.cmj : cc test/test_bytes.ml | $stdlib
 build test/test_case_opt_collision.cmi test/test_case_opt_collision.cmj : cc test/test_case_opt_collision.ml | test/mt.cmj $stdlib
 build test/test_case_set.cmi test/test_case_set.cmj : cc test/test_case_set.ml | $stdlib
diff --git a/jscomp/test/cross_module_inline_test.js b/jscomp/test/cross_module_inline_test.js
@@ -1,8 +1,8 @@
 'use strict';
 
-var Caml_char = require("../../lib/js/caml_char.js");
+var Test_char = require("./test_char.js");
 
-var v = Caml_char.caml_is_printable(/* "a" */97);
+var v = Test_char.caml_is_printable(/* "a" */97);
 
 exports.v = v;
 /* v Not a pure module */
diff --git a/jscomp/test/cross_module_inline_test.ml b/jscomp/test/cross_module_inline_test.ml
@@ -1,2 +1,2 @@
-external is_printable: char -> bool = "caml_is_printable"
-let v = is_printable 'a'
+open Test_char
+let v = caml_is_printable 'a'
diff --git a/jscomp/test/string_runtime_test.js b/jscomp/test/string_runtime_test.js
@@ -3,15 +3,15 @@
 var Mt = require("./mt.js");
 var List = require("../../lib/js/list.js");
 var Bytes = require("../../lib/js/bytes.js");
-var Caml_char = require("../../lib/js/caml_char.js");
+var Test_char = require("./test_char.js");
 var Caml_bytes = require("../../lib/js/caml_bytes.js");
 
 var suites_0 = [
   "caml_is_printable",
   (function (param) {
       return {
               TAG: /* Eq */0,
-              _0: Caml_char.caml_is_printable(/* "a" */97),
+              _0: Test_char.caml_is_printable(/* "a" */97),
               _1: true
             };
     })
diff --git a/jscomp/test/string_runtime_test.ml b/jscomp/test/string_runtime_test.ml
@@ -9,7 +9,7 @@ let suites = Mt.[
     Eq(S.caml_string_of_char_array [|'a';'b';'c'|], "abc")
                           ); *)
   "caml_is_printable", (fun _ ->
-    Eq(Caml_char.caml_is_printable 'a', true)
+    Eq(Test_char.caml_is_printable 'a', true)
                        );
   "caml_string_of_bytes", (fun  _ ->
 
diff --git a/jscomp/test/test_bug.js b/jscomp/test/test_bug.js
@@ -1,7 +1,7 @@
 'use strict';
 
 var Bytes = require("../../lib/js/bytes.js");
-var Caml_char = require("../../lib/js/caml_char.js");
+var Test_char = require("./test_char.js");
 var Caml_bytes = require("../../lib/js/caml_bytes.js");
 
 function escaped(s) {
@@ -28,7 +28,7 @@ function escaped(s) {
       exit = 1;
     }
     if (exit === 1) {
-      tmp = Caml_char.caml_is_printable(c) ? 1 : 4;
+      tmp = Test_char.caml_is_printable(c) ? 1 : 4;
     }
     n = n + tmp | 0;
   }
@@ -89,7 +89,7 @@ function escaped(s) {
       exit$1 = 1;
     }
     if (exit$1 === 1) {
-      if (Caml_char.caml_is_printable(c$1)) {
+      if (Test_char.caml_is_printable(c$1)) {
         s$prime[n] = c$1;
       } else {
         s$prime[n] = /* "\\" */92;
diff --git a/jscomp/test/test_bug.ml b/jscomp/test/test_bug.ml
@@ -1,7 +1,7 @@
 external string_length : string -> int = "%string_length"
 external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit
                      = "caml_blit_string" "noalloc"
-external is_printable: char -> bool = "caml_is_printable"
+
 external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 open Bytes
@@ -11,7 +11,7 @@ let escaped s =
     n := !n +
       (match unsafe_get s i with
        | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
-       | c -> if is_printable c then 1 else 4)
+       | c -> if Test_char.caml_is_printable c then 1 else 4)
   done;
   if !n = length s then copy s else begin
     let s' = create !n in
@@ -29,7 +29,7 @@ let escaped s =
       | '\b' ->
           unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b'
       | c ->
-          if is_printable c then
+          if Test_char.caml_is_printable c then
             unsafe_set s' !n c
           else begin
             let a = char_code c in
diff --git a/jscomp/test/test_char.js b/jscomp/test/test_char.js
@@ -1,44 +1,13 @@
 'use strict';
 
 
-function f(x) {
-  return x + 1 | 0;
-}
-
-function chr(n) {
-  if (n < 0 || n > 255) {
-    throw {
-          RE_EXN_ID: "Invalid_argument",
-          _1: "Char.chr",
-          Error: new Error()
-        };
-  }
-  return n;
-}
-
-function lowercase(c) {
-  if (c >= /* "A" */65 && c <= /* "Z" */90 || c >= /* "\192" */192 && c <= /* "\214" */214 || c >= /* "\216" */216 && c <= /* "\222" */222) {
-    return c + 32 | 0;
+function caml_is_printable(c) {
+  if (c > 31) {
+    return c < 127;
   } else {
-    return c;
+    return false;
   }
 }
 
-function uppercase(c) {
-  if (c >= /* "a" */97 && c <= /* "z" */122 || c >= /* "\224" */224 && c <= /* "\246" */246 || c >= /* "\248" */248 && c <= /* "\254" */254) {
-    return c - 32 | 0;
-  } else {
-    return c;
-  }
-}
-
-function compare(c1, c2) {
-  return c1 - c2 | 0;
-}
-
-exports.f = f;
-exports.chr = chr;
-exports.lowercase = lowercase;
-exports.uppercase = uppercase;
-exports.compare = compare;
+exports.caml_is_printable = caml_is_printable;
 /* No side effect */
diff --git a/jscomp/test/test_char.ml b/jscomp/test/test_char.ml
@@ -1,47 +1,3 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the GNU Library General Public License, with    *)
-(*  the special exception on linking described in file ../LICENSE.     *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* Character operations *)
-
-external code: char -> int = "%identity"
-external unsafe_chr: int -> char = "%identity"
-
-let f x = x + 1 
-let chr n =
-  if n < 0 || n > 255 then invalid_arg "Char.chr" else unsafe_chr n
-
-external is_printable: char -> bool = "caml_is_printable"
-
-external string_create: int -> string = "caml_create_bytes"
-external string_unsafe_get : string -> int -> char = "%string_unsafe_get"
-
-
-(** this primitive -- should be removed ..  *)
-
-let lowercase c =
-  if (c >= 'A' && c <= 'Z')
-  || (c >= '\192' && c <= '\214')
-  || (c >= '\216' && c <= '\222')
-  then unsafe_chr(code c + 32)
-  else c
-
-let uppercase c =
-  if (c >= 'a' && c <= 'z')
-  || (c >= '\224' && c <= '\246')
-  || (c >= '\248' && c <= '\254')
-  then unsafe_chr(code c - 32)
-  else c
-
-type t = char
-
-let compare c1 c2 = code c1 - code c2
+let caml_is_printable c = 
+  let code = Char.code c in
+  code > 31 && code < 127
diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml
@@ -111163,9 +111163,6 @@ let translate loc (prim_name : string)
             call Js_runtime_modules.caml_primitive
         | _ -> assert false 
       end
-    | "caml_is_printable" 
-      -> 
-      call Js_runtime_modules.char
     | "caml_string_get"    
       -> 
         E.runtime_call Js_runtime_modules.string "get" args
diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml
@@ -111163,9 +111163,6 @@ let translate loc (prim_name : string)
             call Js_runtime_modules.caml_primitive
         | _ -> assert false 
       end
-    | "caml_is_printable" 
-      -> 
-      call Js_runtime_modules.char
     | "caml_string_get"    
       -> 
         E.runtime_call Js_runtime_modules.string "get" args
diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml
@@ -393255,9 +393255,6 @@ let translate loc (prim_name : string)
             call Js_runtime_modules.caml_primitive
         | _ -> assert false 
       end
-    | "caml_is_printable" 
-      -> 
-      call Js_runtime_modules.char
     | "caml_string_get"    
       -> 
         E.runtime_call Js_runtime_modules.string "get" args
diff --git a/lib/es6/caml_char.js b/lib/es6/caml_char.js
@@ -1,16 +1 @@
-
-
-
-function caml_is_printable(c) {
-  if (c > 31) {
-    return c < 127;
-  } else {
-    return false;
-  }
-}
-
-export {
-  caml_is_printable ,
-  
-}
-/* No side effect */
+/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */
diff --git a/lib/js/caml_char.js b/lib/js/caml_char.js
@@ -1,13 +1 @@
-'use strict';
-
-
-function caml_is_printable(c) {
-  if (c > 31) {
-    return c < 127;
-  } else {
-    return false;
-  }
-}
-
-exports.caml_is_printable = caml_is_printable;
-/* No side effect */
+/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */

Original file line number	Diff line number	Diff line change
`@@ -26,7 +26,6 @@`
`26`	`26`
`27`	`27`
`28`	`28`
`29`		`-`
`30`	`29`	`let caml_failwith s = raise (Failure s)`
`31`	`30`	`(* let caml_invalid_argument s= raise (Invalid_argument s ) *)`
`32`	`31`