Compiler: immutable strings

compiler/lib/eval.ml

@@ -293,7 +293,7 @@ let eval_instr info i =
                 ( prim
                 , List.map2 prim_args prim_args' ~f:(fun arg c ->
                       match c with
-                      | Some ((Int _ | Float _) as c) -> Pc c
+                      | Some ((Int _ | Float _ | String _ | IString _) as c) -> Pc c
                       | Some _
                       (* do not be duplicated other constant as
                           they're not represented with constant in javascript. *)

compiler/lib/generate.ml

@@ -105,9 +105,7 @@ module Share = struct
     let n = try IntMap.find i t.applies with Not_found -> 0 in
     { t with applies = IntMap.add i (n + 1) t.applies }
 
-  let add_code_string s share =
-    let share = add_string s share in
-    add_prim "caml_new_string" share
+  let add_code_string s share = add_string s share
 
   let add_code_istring s share = add_string s share
 
@@ -308,8 +306,7 @@ let rec constant_rec ~ctx x level instrs =
   match x with
   | String s ->
       let e = Share.get_string str_js s ctx.Ctx.share in
-      let p = Share.get_prim (runtime_fun ctx) "caml_new_string" ctx.Ctx.share in
-      J.ECall (p, [ e ], J.N), instrs
+      e, instrs
   | IString s -> Share.get_string str_js s ctx.Ctx.share, instrs
   | Float f -> float_const f, instrs
   | Float_array a ->
@@ -844,9 +841,8 @@ let register_bin_math_prim name prim =
       J.ECall (J.EDot (s_var "Math", prim), [ cx; cy ], loc))
 
 let _ =
-  register_un_prim_ctx "%caml_format_int_special" `Pure (fun ctx cx loc ->
-      let p = Share.get_prim (runtime_fun ctx) "caml_new_string" ctx.Ctx.share in
-      J.ECall (p, [ J.EBin (J.Plus, str_js "", cx) ], loc));
+  register_un_prim_ctx "%caml_format_int_special" `Pure (fun _ctx cx _loc ->
+      J.EBin (J.Plus, str_js "", cx));
   register_bin_prim "caml_array_unsafe_get" `Mutable (fun cx cy _ ->
       Mlvalue.Array.field cx cy);
   register_bin_prim "%int_add" `Pure (fun cx cy _ -> to_int (plus_int cx cy));
@@ -911,8 +907,6 @@ let _ =
   register_un_prim "caml_js_from_bool" `Pure (fun cx _ ->
       J.EUn (J.Not, J.EUn (J.Not, cx)));
   register_un_prim "caml_js_to_bool" `Pure (fun cx _ -> to_int cx);
-  register_un_prim "caml_js_from_string" `Mutable (fun cx loc ->
-      J.ECall (J.EDot (cx, "toString"), [], loc));
   register_tern_prim "caml_js_set" (fun cx cy cz _ ->
       J.EBin (J.Eq, J.EAccess (cx, cy), cz));
   register_bin_prim "caml_js_get" `Mutable (fun cx cy _ -> J.EAccess (cx, cy));
@@ -922,7 +916,11 @@ let _ =
       bool (J.EBin (J.EqEq, cx, cy)));
   register_bin_prim "caml_js_instanceof" `Pure (fun cx cy _ ->
       bool (J.EBin (J.InstanceOf, cx, cy)));
-  register_un_prim "caml_js_typeof" `Pure (fun cx _ -> J.EUn (J.Typeof, cx))
+  register_un_prim "caml_js_typeof" `Pure (fun cx _ -> J.EUn (J.Typeof, cx));
+  register_bin_prim "caml_string_notequal" `Pure (fun cx cy _ ->
+      J.EBin (J.NotEqEq, cx, cy));
+  register_bin_prim "caml_string_equal" `Pure (fun cx cy _ ->
+      bool (J.EBin (J.EqEq, cx, cy)))
 
 (****)
 (* when raising ocaml exception and [improved_stacktrace] is enabled,

compiler/lib/parse_bytecode.ml

@@ -2492,7 +2492,7 @@ let predefined_exceptions () =
         let v_name_js = Var.fresh () in
         let v_index = Var.fresh () in
         [ Let (v_name, Constant (String name))
-        ; Let (v_name_js, Prim (Extern "caml_js_from_string", [ Pc (IString name) ]))
+        ; Let (v_name_js, Constant (IString name))
         ; Let (v_index, Constant (Int (Int32.of_int (-index))))
         ; Let (exn, Block (248, [| v_name; v_index |], NotArray))
         ; Let

compiler/num-testsuite/test.ml

@@ -5,7 +5,7 @@ let flush_all () = flush stdout; flush stderr;;
 let message s = print_string s; print_newline ();;
 
 let error_occurred = ref false;;
-let immediate_failure = ref true;;
+let immediate_failure = ref false;;
 
 let error () =
  if !immediate_failure then exit 2 else begin

compiler/tests/obj_dup.ml

@@ -41,7 +41,7 @@ let%expect_test _ =
   |};
   [%expect {|
     true
-    true
+    false
     true
     true
     true

compiler/tests/static_eval.ml

@@ -52,6 +52,6 @@ let%expect_test "static eval of string get" =
   print_var_decl program "bx";
   [%expect
     {|
-    var ex = call_with_char(caml_string_get(constant,- 10));
+    var ex = call_with_char(caml_string_get("abcdefghijklmnopqrstuvwxyz",- 10));
     var ax = call_with_char(103);
-    var bx = call_with_char(caml_string_get(constant,30)); |}]
+    var bx = call_with_char(caml_string_get("abcdefghijklmnopqrstuvwxyz",30)); |}]

compiler/tests/variable_declaration_output.ml

@@ -50,7 +50,7 @@ let%expect_test _ =
   print_var_decl program "symbol_op";
   [%expect
     {|
-    var ex = [0,5,runtime.caml_new_string("hello")];
+    var ex = [0,5,"hello"];
     var ax = [0,1,2,3,4];
     var bx = [254,1.,2.,3.,4.];
     var cx = [254,NaN,NaN,Infinity,- Infinity,0.,- 0.];

lib/js_of_ocaml/json.ml

@@ -36,35 +36,6 @@ class type json =
 
 let json : json Js.t = Unsafe.global##._JSON
 
-external unsafe_equals : 'a -> 'b -> bool = "caml_js_equals"
+let unsafe_input s = json##parse s
 
-external to_byte_MlBytes : js_string t -> 'a t = "caml_js_to_byte_string"
-
-external to_byte_jsstring : 'a t -> js_string t = "caml_jsbytes_of_string"
-
-let input_reviver =
-  let reviver _this _key value =
-    if unsafe_equals (typeof value) (typeof (string "foo"))
-    then to_byte_MlBytes (Unsafe.coerce value)
-    else value
-  in
-  wrap_meth_callback reviver
-
-let unsafe_input s = json##parse_ s input_reviver
-
-class type obj =
-  object
-    method constructor : 'a. 'a constr Js.readonly_prop
-  end
-
-let mlString_constr =
-  let dummy_string = "" in
-  let dummy_obj : obj t = Obj.magic dummy_string in
-  dummy_obj##.constructor
-
-let output_reviver _key value =
-  if instanceof value mlString_constr
-  then to_byte_jsstring (Unsafe.coerce value)
-  else value
-
-let output obj = json##stringify_ obj output_reviver
+let output obj = json##stringify obj

runtime/bigstring.js

@@ -1,9 +1,9 @@
 ///////// BIGSTRING
 
 //Provides: caml_hash_mix_bigstring
-//Requires: caml_hash_mix_string_arr
+//Requires: caml_hash_mix_bytes_arr
 function caml_hash_mix_bigstring(h, bs) {
-  return caml_hash_mix_string_arr(h,bs.data);
+  return caml_hash_mix_bytes_arr(h,bs.data);
 }
 
 //Provides: bigstring_to_array_buffer mutable
@@ -83,20 +83,20 @@ function caml_bigstring_blit_string_to_ba(str1, pos1, ba2, pos2, len){
 }
 
 //Provides: caml_bigstring_blit_bytes_to_ba
-//Requires: caml_invalid_argument, caml_array_bound_error, caml_array_of_string
-//Requires: caml_ml_string_length
+//Requires: caml_invalid_argument, caml_array_bound_error, caml_array_of_bytes
+//Requires: caml_ml_bytes_length
 function caml_bigstring_blit_bytes_to_ba(str1, pos1, ba2, pos2, len){
   if(12 != ba2.kind)
     caml_invalid_argument("caml_bigstring_blit_string_to_ba: kind mismatch");
   if(len == 0) return 0;
   var ofs2 = ba2.offset(pos2);
-  if(pos1 + len > caml_ml_string_length(str1)) {
+  if(pos1 + len > caml_ml_bytes_length(str1)) {
     caml_array_bound_error();
   }
   if(ofs2 + len > ba2.data.length) {
     caml_array_bound_error();
   }
-  var slice = caml_array_of_string(str1).slice(pos1,pos1 + len);
+  var slice = caml_array_of_bytes(str1).slice(pos1,pos1 + len);
   ba2.data.set(slice,ofs2);
   return 0
 }

runtime/dynlink.js

@@ -22,7 +22,7 @@ var current_libs = [0, joo_global_object]
 //Provides: caml_dynlink_open_lib
 //Requires: current_libs, caml_failwith
 function caml_dynlink_open_lib (_mode,file) {
-    var name = file.toString();
+    var name = file;
     joo_global_object.console.log("Dynlink: try to open ", name);
     //caml_failwith("file not found: "+name)
     current_libs.push({});
@@ -39,7 +39,7 @@ function caml_dynlink_close_lib (idx) {
 //Provides: caml_dynlink_lookup_symbol
 //Requires: current_libs
 function caml_dynlink_lookup_symbol (idx, fun_name) {
-  var name = fun_name.toString();
+  var name = fun_name;
   joo_global_object.console.log("Dynlink: look for symbol ", name);
   if(current_libs[idx] && current_libs[idx][name])
     return current_libs[idx][name];

runtime/fs.js

@@ -244,15 +244,15 @@ function caml_create_file(name,content) {
 }
 
 //Provides: caml_read_file_content
-//Requires: resolve_fs_device, caml_raise_no_such_file, caml_create_bytes
+//Requires: resolve_fs_device, caml_raise_no_such_file, caml_create_bytes, caml_string_of_bytes
 function caml_read_file_content (name) {
   var root = resolve_fs_device(name);
   if(root.device.exists(root.rest)) {
     var file = root.device.open(root.rest,{rdonly:1});
     var len  = file.length();
     var buf  = caml_create_bytes(len);
     file.read(0,buf,0,len);
-    return buf
+    return caml_string_of_bytes(buf)
   }
   caml_raise_no_such_file(name);
 }

runtime/fs_fake.js

@@ -19,7 +19,7 @@
 
 //Provides: MlFakeDevice
 //Requires: MlFakeFile, caml_create_bytes
-//Requires: caml_raise_sys_error, caml_raise_no_such_file, caml_new_string, caml_string_of_array
+//Requires: caml_raise_sys_error, caml_raise_no_such_file, caml_new_string, caml_string_of_array, caml_bytes_of_string
 //Requires: MlBytes
 function MlFakeDevice (root, f) {
   this.content={};
@@ -32,7 +32,7 @@ MlFakeDevice.prototype.nm = function(name) {
 MlFakeDevice.prototype.lookup = function(name) {
   if(!this.content[name] && this.lookupFun) {
     var res = this.lookupFun(caml_new_string(this.root), caml_new_string(name));
-    if(res !== 0) this.content[name]=new MlFakeFile(res[1]);
+    if(res !== 0) this.content[name]=new MlFakeFile(caml_bytes_of_string(res[1]));
   }
 }
 MlFakeDevice.prototype.exists = function(name) {
@@ -100,17 +100,22 @@ MlFakeDevice.prototype.register= function (name,content){
     this.content[name] = new MlFakeFile(content);
   else if(content instanceof Array)
     this.content[name] = new MlFakeFile(caml_string_of_array(content));
+  else if(typeof content == "string") {
+    var bytes = caml_bytes_of_string(content);
+    this.content[name] = new MlFakeFile(bytes);
+  }
   else if(content.toString) {
-    var mlstring = caml_new_string(content.toString());
-    this.content[name] = new MlFakeFile(mlstring);
+    var bytes = caml_bytes_of_string(content.toString());
+    this.content[name] = new MlFakeFile(bytes);
   }
+  else caml_raise_sys_error(this.nm(name) + " : registering file with invalid content type");
 }
 
 MlFakeDevice.prototype.constructor = MlFakeDevice
 
 //Provides: MlFakeFile
 //Requires: MlFile
-//Requires: caml_create_bytes, caml_ml_bytes_length,caml_blit_bytes
+//Requires: caml_create_bytes, caml_ml_bytes_length, caml_blit_bytes, caml_blit_string
 //Requires: caml_bytes_get
 function MlFakeFile(content){
   this.data = content;
@@ -132,7 +137,7 @@ MlFakeFile.prototype.write = function(offset,buf,pos,len){
     this.data = new_str;
     caml_blit_bytes(old_data, 0, this.data, 0, clen);
   }
-  caml_blit_bytes(buf, pos, this.data, offset, len);
+  caml_blit_string(buf, pos, this.data, offset, len);
   return 0
 }
 MlFakeFile.prototype.read = function(offset,buf,pos,len){

runtime/fs_node.js

@@ -102,9 +102,8 @@ MlNodeDevice.prototype.rename = function(o,n) {
 
 MlNodeDevice.prototype.constructor = MlNodeDevice
 
-
 //Provides: MlNodeFile
-//Requires: MlFile, caml_array_of_string, caml_bytes_set, caml_raise_sys_error
+//Requires: MlFile, caml_array_of_string, caml_array_of_bytes, caml_bytes_set, caml_raise_sys_error
 function MlNodeFile(fd){
   this.fs = require('fs');
   this.fd = fd;
@@ -138,7 +137,7 @@ MlNodeFile.prototype.write = function(offset,buf,buf_offset,len){
   return 0;
 }
 MlNodeFile.prototype.read = function(offset,buf,buf_offset,len){
-  var a = caml_array_of_string(buf);
+  var a = caml_array_of_bytes(buf);
   if(! (a instanceof joo_global_object.Uint8Array))
     a = new joo_global_object.Uint8Array(a);
   var buffer = joo_global_object.Buffer.from(a);

runtime/io.js

@@ -199,10 +199,10 @@ function caml_ml_set_channel_refill(chanid,f) {
 }
 
 //Provides: caml_ml_refill_input
-//Requires: caml_ml_bytes_length
+//Requires: caml_ml_string_length
 function caml_ml_refill_input (chan) {
   var str = chan.refill();
-  var str_len = caml_ml_bytes_length(str);
+  var str_len = caml_ml_string_length(str);
   if (str_len == 0) chan.refill = null;
   chan.file.write(chan.file.length(), str, 0, str_len);
   return str_len;
@@ -230,7 +230,7 @@ function caml_ml_input (chanid, s, i, l) {
 }
 
 //Provides: caml_input_value
-//Requires: caml_marshal_data_size, caml_input_value_from_string, caml_create_bytes, caml_ml_channels
+//Requires: caml_marshal_data_size, caml_input_value_from_bytes, caml_create_bytes, caml_ml_channels
 function caml_input_value (chanid) {
   var chan = caml_ml_channels[chanid];
 
@@ -244,7 +244,7 @@ function caml_input_value (chanid) {
   chan.file.read(chan.offset,buf,0,len);
 
   var offset = [0];
-  var res = caml_input_value_from_string(buf, offset);
+  var res = caml_input_value_from_bytes(buf, offset);
   chan.offset = chan.offset + offset[0];
   return res;
 }
@@ -346,18 +346,18 @@ function caml_ml_flush (chanid) {
 
 //Provides: caml_ml_output_bytes
 //Requires: caml_ml_flush,caml_ml_bytes_length
-//Requires: caml_create_bytes, caml_blit_bytes, caml_raise_sys_error, caml_ml_channels, caml_jsbytes_of_string
+//Requires: caml_create_bytes, caml_blit_bytes, caml_raise_sys_error, caml_ml_channels, caml_string_of_bytes
 function caml_ml_output_bytes(chanid,buffer,offset,len) {
   var chan = caml_ml_channels[chanid];
   if(! chan.opened) caml_raise_sys_error("Cannot output to a closed channel");
-  var string;
+  var bytes;
   if(offset == 0 && caml_ml_bytes_length(buffer) == len)
-    string = buffer;
+    bytes = buffer;
   else {
-    string = caml_create_bytes(len);
-    caml_blit_bytes(buffer,offset,string,0,len);
+    bytes = caml_create_bytes(len);
+    caml_blit_bytes(buffer,offset,bytes,0,len);
   }
-  var jsstring = caml_jsbytes_of_string(string);
+  var jsstring = caml_string_of_bytes(bytes);
   var id = jsstring.lastIndexOf("\n");
   if(id < 0)
     chan.buffer+=jsstring;
@@ -370,9 +370,9 @@ function caml_ml_output_bytes(chanid,buffer,offset,len) {
 }
 
 //Provides: caml_ml_output
-//Requires: caml_ml_output_bytes
+//Requires: caml_ml_output_bytes, caml_bytes_of_string
 function caml_ml_output(chanid,buffer,offset,len){
-  return caml_ml_output_bytes(chanid,buffer,offset,len);
+  return caml_ml_output_bytes(chanid,caml_bytes_of_string(buffer),offset,len);
 }
 
 //Provides: caml_ml_output_char

runtime/jslib_js_of_ocaml.js

@@ -28,15 +28,23 @@ function caml_js_from_float(x) { return x; }
 //Provides: caml_js_to_float const (const)
 function caml_js_to_float(x) { return x; }
 //Provides: caml_js_from_string mutable (const)
-//Requires: MlBytes
-function caml_js_from_string(s) { return s.toString(); }
+//Requires: caml_is_ascii, caml_utf16_of_utf8
+function caml_js_from_string(s) {
+    if(caml_is_ascii(s)) return s;
+    return caml_utf16_of_utf8(s); }
 //Provides: caml_js_from_array mutable (shallow)
 //Requires: raw_array_sub
 function caml_js_from_array(a) { return raw_array_sub(a,1,a.length-1); }
 //Provides: caml_js_to_array mutable (shallow)
 //Requires: raw_array_cons
 function caml_js_to_array(a) { return raw_array_cons(a,0); }
 
+//Provides: caml_js_to_byte_string const
+function caml_js_to_byte_string(x) { return x }
+
+//Provides: caml_jsbytes_of_string const
+function caml_jsbytes_of_string(x) { return x }
+
 //Provides: caml_js_var mutable (const)
 //Requires: js_print_stderr
 //Requires: MlBytes
@@ -170,9 +178,6 @@ function caml_js_wrap_meth_callback_unsafe(f) {
 }
 //Provides: caml_js_equals mutable (const, const)
 function caml_js_equals (x, y) { return +(x == y); }
-//Provides: caml_js_to_byte_string const
-//Requires: caml_new_string
-function caml_js_to_byte_string (s) {return caml_new_string (s);}
 
 //Provides: caml_js_eval_string (const)
 //Requires: MlBytes