Use JS String Builtins to convert ASCII OCaml strings to Javascript strings

Author: vouillon

runtime/wasm/jsstring.wat

@@ -22,6 +22,10 @@
       (func $is_string (param externref) (result i32)))
    (import "wasm:js-string" "hash"
       (func $hash_string (param i32) (param anyref) (result i32)))
+   (import "wasm:js-string" "fromCharCodeArray"
+      (func $fromCharCodeArray
+         (param (ref null $wstring)) (param i32) (param i32)
+         (result (ref extern))))
 
    (import "wasm:text-decoder" "decodeStringFromUTF8Array"
       (func $decodeStringFromUTF8Array
@@ -41,15 +45,17 @@
       (func $append_string (param anyref) (param anyref) (result anyref)))
 
    (type $string (array (mut i8)))
+   (type $wstring (array (mut i16)))
 
-   (global $builtins_available (mut i32) (i32.const 0))
+   (global $text_converters_available (mut i32) (i32.const 0))
+   (global $string_builtins_available (mut i32) (i32.const 0))
 
    (start $init)
 
    (func $init
       ;; Our dummy implementation of string conversion always returns
       ;; the empty string.
-      (global.set $builtins_available
+      (global.set $text_converters_available
          (i32.ne
             (i32.const 0)
             (call $compare_strings
@@ -58,6 +64,16 @@
                   (i32.const 0) (i32.const 1))
                (call $decodeStringFromUTF8Array
                   (array.new_fixed $string 1 (i32.const 1))
+                   (i32.const 0) (i32.const 1)))))
+      (global.set $string_builtins_available
+         (i32.ne
+            (i32.const 0)
+            (call $compare_strings
+               (call $fromCharCodeArray
+                  (array.new_fixed $wstring 1 (i32.const 0))
+                  (i32.const 0) (i32.const 1))
+               (call $fromCharCodeArray
+                  (array.new_fixed $wstring 1 (i32.const 1))
                    (i32.const 0) (i32.const 1))))))
 
    (func (export "jsstring_compare")
@@ -71,17 +87,48 @@
 
    (export "jsstring_hash" (func $hash_string))
 
+   (func $is_ascii
+      (param $s (ref $string)) (param $i i32) (param $end i32) (result i32)
+      (loop $loop
+         (if (i32.eq (local.get $i) (local.get $end))
+            (then (return (i32.const 1))))
+         (if (i32.gt_u (array.get_u $string (local.get $s) (local.get $i))
+                (i32.const 127))
+            (then (return (i32.const 0))))
+         (local.set $i (i32.add (local.get $i) (i32.const 1)))
+         (br $loop)))
+
    ;; Used by package zarith_stubs_js
    (func $jsstring_of_substring (export "jsstring_of_substring")
       (param $s (ref $string)) (param $pos i32) (param $len i32)
       (result anyref)
-      (if (global.get $builtins_available)
+      (local $i i32) (local $ws (ref $wstring))
+      (if (global.get $text_converters_available)
          (then
             (return
                (any.convert_extern
                   (call $decodeStringFromUTF8Array (local.get $s)
                      (local.get $pos)
                      (i32.add (local.get $pos) (local.get $len)))))))
+      (if (i32.and (global.get $string_builtins_available)
+             (call $is_ascii
+                (local.get $s) (local.get $pos)
+                (i32.add (local.get $pos) (local.get $len))))
+         (then
+            (local.set $ws (array.new $wstring (i32.const 0) (local.get $len)))
+            (loop $loop
+               (if (i32.lt_u (local.get $i) (local.get $len))
+                  (then
+                     (array.set $wstring (local.get $ws) (local.get $i)
+                        (array.get $string (local.get $s)
+                           (i32.add (local.get $pos) (local.get $i))))
+                     (local.set $i (i32.add (local.get $i) (i32.const 1)))
+
+                     (br $loop))))
+            (return
+               (any.convert_extern
+                  (call $fromCharCodeArray (local.get $ws)
+                     (i32.const 0) (local.get $len))))))
       (return_call $jsstring_of_substring_fallback
          (local.get $s) (local.get $pos) (local.get $len)))
 
@@ -90,7 +137,7 @@
          (local.get $s) (i32.const 0) (array.len (local.get $s))))
 
    (func (export "string_of_jsstring") (param $s anyref) (result (ref $string))
-      (if (global.get $builtins_available)
+      (if (global.get $text_converters_available)
          (then
             (return_call $encodeStringToUTF8Array
                (extern.convert_any (local.get $s)))))