Merge pull request #33 from ocaml-wasm/js-string-builtins

Use Js string builtins when available
ocaml-wasm · Mar 28, 2024 · 3c96f1e · 3c96f1e
2 parents 6aa4b92 + e04f918
commit 3c96f1e
Show file tree

Hide file tree

Showing 6 changed files with 108 additions and 97 deletions.
diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
@@ -31,7 +31,7 @@ jobs:
       - name: Install node
         uses: actions/setup-node@v4
         with:
-          node-version: v22.0.0-v8-canary20231204cf8ac0f493
+          node-version: v22.0.0-v8-canary2024030314ed92e804
 
       - name: Restore cached binaryen
         id: cache-binaryen

diff --git a/runtime/wasm/float.wat b/runtime/wasm/float.wat
@@ -1,10 +1,8 @@
 (module
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
-   (import "jslib" "caml_jsstring_of_string"
-      (func $caml_jsstring_of_string (param (ref eq)) (result (ref eq))))
    (import "bindings" "format_float"
       (func $format_float
-         (param i32) (param i32) (param f64) (result anyref)))
+         (param i32) (param i32) (param i32) (param f64) (result anyref)))
    (import "bindings" "identity"
       (func $parse_float (param anyref) (result f64)))
    (import "Math" "exp" (func $exp (param f64) (result f64)))
@@ -13,9 +11,10 @@
       (func $caml_invalid_argument (param (ref eq))))
    (import "ints" "lowercase_hex_table"
       (global $lowercase_hex_table (ref $chars)))
+   (import "jsstring" "jsstring_of_string"
+      (func $jsstring_of_string (param (ref $string)) (result anyref)))
    (import "jsstring" "string_of_jsstring"
-      (func $string_of_jsstring
-         (param anyref) (param i32) (result (ref $string))))
+      (func $string_of_jsstring (param anyref) (result (ref $string))))
 
    (type $float (struct (field f64)))
    (type $string (array (mut i8)))
@@ -291,9 +290,9 @@
             (local.set $num
                (call $format_float
                   (local.get $precision) (local.get $conversion)
+                  (local.get $i)
                   (f64.abs (local.get $f))))
-            (local.set $s
-               (call $string_of_jsstring (local.get $num) (local.get $i)))
+            (local.set $s (call $string_of_jsstring (local.get $num)))
             (br $sign (local.get $s))))
       (if (local.get $negative)
          (then
@@ -637,8 +636,7 @@
                                                 (local.get $negative))))
                                        ))))))))))))))))))
          (local.set $f
-            (call $parse_float
-               (call $unwrap (call $caml_jsstring_of_string (local.get $s)))))
+            (call $parse_float (call $jsstring_of_string (local.get $s))))
          (br_if $error (f64.ne (local.get $f) (local.get $f)))
          (return (struct.new $float (local.get $f))))
       (call $caml_failwith

diff --git a/runtime/wasm/jslib.wat b/runtime/wasm/jslib.wat
@@ -68,12 +68,10 @@
       (func $caml_is_closure (param (ref eq)) (result i32)))
    (import "obj" "caml_is_last_arg"
       (func $caml_is_last_arg (param (ref eq)) (result i32)))
-   (import "jsstring" "jsstring_of_substring"
-      (func $jsstring_of_substring
-         (param (ref $string)) (param i32) (param i32) (result anyref)))
+   (import "jsstring" "jsstring_of_string"
+      (func $jsstring_of_string (param (ref $string)) (result anyref)))
    (import "jsstring" "string_of_jsstring"
-      (func $string_of_jsstring
-         (param anyref) (param i32) (result (ref $string))))
+      (func $string_of_jsstring (param anyref) (result (ref $string))))
    (import "int32" "caml_copy_int32"
       (func $caml_copy_int32 (param i32) (result (ref eq))))
    (import "int32" "Int32_val"
@@ -442,10 +440,7 @@
       (param (ref eq)) (result (ref eq))
       (local $s (ref $string))
       (local.set $s (ref.cast (ref $string) (local.get 0)))
-      (return
-         (struct.new $js
-            (call $jsstring_of_substring
-               (local.get $s) (i32.const 0) (array.len (local.get $s))))))
+      (return (struct.new $js (call $jsstring_of_string (local.get $s)))))
 
    (func $caml_jsbytes_of_string (export "caml_jsbytes_of_string")
       (param (ref eq)) (result (ref eq))
@@ -468,8 +463,7 @@
          (then
             (return
                (struct.new $js
-                  (call $jsstring_of_substring
-                     (local.get $s) (i32.const 0) (local.get $i))))))
+                  (call $jsstring_of_string (local.get $s))))))
       (local.set $s'
          (array.new $string (i32.const 0)
             (i32.add (local.get $i) (local.get $n))))
@@ -496,26 +490,21 @@
                      (local.set $n (i32.add (local.get $n) (i32.const 2)))))
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $fill))))
-      (return
-         (struct.new $js
-            (call $jsstring_of_substring
-               (local.get $s') (i32.const 0) (local.get $n)))))
+      (return (struct.new $js (call $jsstring_of_string (local.get $s')))))
 
    (export "caml_js_to_string" (func $caml_string_of_jsstring))
    (func $caml_string_of_jsstring (export "caml_string_of_jsstring")
       (param $s (ref eq)) (result (ref eq))
       (return_call $string_of_jsstring
-         (struct.get $js 0 (ref.cast (ref $js) (local.get $s)))
-         (i32.const 0)))
+         (struct.get $js 0 (ref.cast (ref $js) (local.get $s)))))
 
    (func (export "caml_string_of_jsbytes")
       (param $s (ref eq)) (result (ref eq))
       (local $l i32) (local $i i32) (local $n i32) (local $c i32)
       (local $s' (ref $string)) (local $s'' (ref $string))
       (local.set $s'
          (call $string_of_jsstring
-            (struct.get $js 0 (ref.cast (ref $js) (local.get $s)))
-            (i32.const 0)))
+            (struct.get $js 0 (ref.cast (ref $js) (local.get $s)))))
       (local.set $l (array.len (local.get $s')))
       (local.set $i (i32.const 0))
       (local.set $n (i32.const 0))

diff --git a/runtime/wasm/jsstring.wat b/runtime/wasm/jsstring.wat
@@ -1,4 +1,19 @@
 (module
+   (import "wasm:js-string" "compare"
+      (func $compare_strings (param externref externref) (result i32)))
+   (import "wasm:js-string" "test"
+      (func $is_string (param externref) (result i32)))
+   (import "wasm:js-string" "hash"
+      (func $hash_string (param i32) (param anyref) (result i32)))
+
+   (import "wasm:text-decoder" "decodeStringFromUTF8Array"
+      (func $decodeStringFromUTF8Array
+         (param (ref null $string)) (param i32) (param i32)
+         (result (ref extern))))
+   (import "wasm:text-encoder" "encodeStringToUTF8Array"
+      (func $encodeStringToUTF8Array
+         (param externref) (result (ref $string))))
+
    (import "bindings" "read_string"
       (func $read_string (param i32) (result anyref)))
    (import "bindings" "read_string_stream"
@@ -7,16 +22,65 @@
       (func $write_string (param anyref) (result i32)))
    (import "bindings" "append_string"
       (func $append_string (param anyref) (param anyref) (result anyref)))
-   (import "bindings" "compare_strings"
-      (func $compare_strings
-         (param anyref) (param anyref) (result i32)))
-   (import "bindings" "hash_string"
-      (func $hash_string (param i32) (param anyref) (result i32)))
-   (import "bindings" "is_string"
-      (func $is_string (param anyref) (result i32)))
 
    (type $string (array (mut i8)))
 
+   (global $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
+         (i32.ne
+            (i32.const 0)
+            (call $compare_strings
+               (call $decodeStringFromUTF8Array
+                  (array.new_fixed $string 1 (i32.const 0))
+                  (i32.const 0) (i32.const 1))
+               (call $decodeStringFromUTF8Array
+                  (array.new_fixed $string 1 (i32.const 1))
+                   (i32.const 0) (i32.const 1))))))
+
+   (func (export "jsstring_compare")
+      (param $s anyref) (param $s' anyref) (result i32)
+      (return_call $compare_strings
+         (extern.externalize (local.get $s))
+         (extern.externalize (local.get $s'))))
+
+   (func (export "jsstring_test") (param $s anyref) (result i32)
+      (return_call $is_string (extern.externalize (local.get $s))))
+
+   (export "jsstring_hash" (func $hash_string))
+
+   ;; 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)
+         (then
+            (return
+               (extern.internalize
+                  (call $decodeStringFromUTF8Array (local.get $s)
+                     (local.get $pos)
+                     (i32.add (local.get $pos) (local.get $len)))))))
+      (return_call $jsstring_of_substring_fallback
+         (local.get $s) (local.get $pos) (local.get $len)))
+
+   (func (export "jsstring_of_string") (param $s (ref $string)) (result anyref)
+      (return_call $jsstring_of_substring
+         (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)
+         (then
+            (return_call $encodeStringToUTF8Array
+               (extern.externalize (local.get $s)))))
+      (return_call $string_of_jsstring_fallback (local.get $s)))
+
+   ;; Fallback implementation of string conversion functions
+
    (memory (export "caml_buffer") 1)
 
    (global $buffer_size i32 (i32.const 65536))
@@ -33,7 +97,7 @@
                (local.set $i (i32.add (local.get $i) (i32.const 1)))
                (br $loop)))))
 
-   (func $jsstring_of_substring (export "jsstring_of_substring")
+   (func $jsstring_of_substring_fallback
       (param $s (ref $string)) (param $pos i32) (param $len i32)
       (result anyref)
       (local $s' anyref)
@@ -81,19 +145,17 @@
       (struct (field $s (ref $string)) (field $next (ref null $stack))))
    (global $stack (mut (ref null $stack)) (ref.null $stack))
 
-   (func $string_of_jsstring (export "string_of_jsstring")
-      (param $s anyref) (param $ofs i32) (result (ref $string))
-      (local $len i32)
+   (func $string_of_jsstring_fallback (param $s anyref) (result (ref $string))
+      (local $ofs i32) (local $len i32)
       (local $s' (ref $string)) (local $s'' (ref $string))
       (local $item (ref $stack))
       (local.set $len (call $write_string (local.get $s)))
       (if (ref.is_null (global.get $stack))
          (then
             (local.set $s'
-               (array.new $string
-                  (i32.const 0) (i32.add (local.get $len) (local.get $ofs))))
+               (array.new $string (i32.const 0) (local.get $len)))
             (call $read_from_buffer
-               (local.get $s') (local.get $ofs) (local.get $len))
+               (local.get $s') (i32.const 0) (local.get $len))
             (return (local.get $s'))))
       (block $done
          (local.set $item (br_on_null $done (global.get $stack)))
@@ -130,49 +192,4 @@
       (local.set $s (array.new $string (i32.const 0) (local.get $len)))
       (call $read_from_buffer (local.get $s) (i32.const 0) (local.get $len))
       (global.set $stack (struct.new $stack (local.get $s) (global.get $stack))))
-
-   (export "jsstring_compare" (func $compare_strings))
-   (export "jsstring_hash" (func $hash_string))
-   (export "jsstring_test" (func $is_string))
-
-(;
-   ;; stringref implementation
-
-   (import "hash" "caml_hash_mix_int"
-      (func $caml_hash_mix_int (param i32) (param i32) (result i32)))
-
-   (func $jsstring_of_substring (export "jsstring_of_substring")
-      (param $s (ref $string)) (param $pos i32) (param $len i32)
-      (result anyref)
-      (string.new_lossy_utf8_array (local.get $s) (local.get $pos)
-         (i32.add (local.get $pos) (local.get $len))))
-
-   (func $string_of_jsstring (export "string_of_jsstring")
-      (param $s0 anyref) (param $ofs i32) (result (ref $string))
-      (local $l i32)
-      (local $s (ref string))
-      (local $s' (ref $string))
-      (local.set $s (ref.cast (ref string) (local.get $s0)))
-      (local.set $l (string.measure_wtf8 (local.get $s)))
-      (local.set $s'
-         (array.new $string
-            (i32.const 0) (i32.add (local.get $l) (local.get $ofs))))
-      (drop (string.encode_lossy_utf8_array
-               (local.get $s) (local.get $s') (local.get $ofs)))
-      (local.get $s'))
-
-   (func (export "jsstring_compare")
-      (param $s anyref) (param $s' anyref) (result i32)
-      (string.compare
-         (ref.cast (ref string) (local.get $s))
-         (ref.cast (ref string) (local.get $s'))))
-
-   (func (export "jsstring_hash")
-      (param $h i32) (param $s anyref) (result i32)
-      (return_call $caml_hash_mix_int (local.get $h)
-         (string.hash (ref.cast (ref string) (local.get $s)))))
-
-   (func (export "jsstring_test") (param $s anyref) (result i32)
-      (ref.test (ref string) (local.get $s)))
-;)
 )
diff --git a/runtime/wasm/runtime.js b/runtime/wasm/runtime.js
@@ -129,9 +129,6 @@
              start += read;
            }
          },
-         compare_strings:(s1,s2)=>(s1<s2)?-1:+(s1>s2),
-         hash_string,
-         is_string:(v)=>+(typeof v==="string"),
          ta_create:(k,sz)=> new(typed_arrays[k])(sz),
          ta_normalize:(a)=>
            a instanceof Uint32Array?
@@ -218,7 +215,7 @@
              return caml_callback(f, args.length, args, 2);
          },
          wrap_fun_arguments:(f)=>function(){return f(arguments)},
-         format_float:(prec, conversion, x)=>{
+         format_float:(prec, conversion, pad, x)=>{
            function toFixed(x,dp) {
              if (Math.abs(x) < 1.0) {
                return x.toFixed(dp);
@@ -273,7 +270,7 @@
              }
              break;
            }
-           return s
+           return pad?" "+s:s
          },
          gettimeofday:()=>(new Date()).getTime() / 1000,
          gmtime:(t)=>{
@@ -346,10 +343,20 @@
          map_delete:(m,x)=>m.delete(x),
          log:(x)=>console.log('ZZZZZ', x)
         }
-    const imports = {Math:math,bindings,env:{},js,strings,fragments}
+    let string_ops =
+        {test:(v)=>+(typeof v==="string"),
+         compare:(s1,s2)=>(s1<s2)?-1:+(s1>s2),
+         hash:hash_string,
+         decodeStringFromUTF8Array:()=>"",
+         encodeStringToUTF8Array:()=>0}
+    const imports =
+        {Math:math,bindings,"wasm:js-string":string_ops,
+         "wasm:text-decoder":string_ops,"wasm:text-encoder":string_ops,
+         env:{},js,strings,fragments}
+    const options = { builtins: ['js-string', 'text-decoder', 'text-encoder'] }
     const wasmModule =
-          isNode?await WebAssembly.instantiate(await code, imports)
-                :await WebAssembly.instantiateStreaming(code,imports)
+          isNode?await WebAssembly.instantiate(await code, imports, options)
+                :await WebAssembly.instantiateStreaming(code,imports, options)
 
     var {caml_callback, caml_alloc_tm, caml_start_fiber,
          caml_handle_uncaught_exception, caml_buffer,

diff --git a/tools/node_wrapper.sh b/tools/node_wrapper.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 export PATH=$(echo $PATH | cut -d : -f 2-) # Do not call oneself recursively
-exec node --experimental-wasm-stack-switching --stack-size=7000 "$@"
+exec node --experimental-wasm-imported-strings --experimental-wasm-stack-switching --stack-size=7000 "$@"