Skip to content

Commit

Permalink
WIP
Browse files Browse the repository at this point in the history
  • Loading branch information
@vouillon
vouillon committed Dec 18, 2024
1 parent cb54d52 commit e9a1f85
Show file tree
Hide file tree
Showing 13 changed files with 522 additions and 233 deletions.
8 changes: 7 additions & 1 deletion dune
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,13 @@
(:standard -w +a-4-40-41-42-44-48-58-66-70))
(binaries
(tools/node_wrapper.exe as node)
(tools/node_wrapper.exe as node.exe)))
(tools/node_wrapper.exe as node.exe))
(wasm_of_ocaml
(compilation_mode separate)
(flags
(:standard --disable use-js-string))
(build_runtime_flags
(:standard))))
(with-effects
(js_of_ocaml
(compilation_mode separate)
Expand Down
6 changes: 3 additions & 3 deletions runtime/wasm/bigstring.wat
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,9 +75,9 @@
(struct.get $string 0 (ref.cast (ref $string) (local.get $s)))))
)
(#else
(func $string_get (param $s (ref bytes)) (param $i i32)) (result i32)
(array.get $bytes (local.get $s) (local.get $i))
(func $string_val (param $s (ref eq)) (result $bytes)
(func $string_get (param $s (ref $bytes)) (param $i i32) (result i32)
(array.get $bytes (local.get $s) (local.get $i)))
(func $string_val (param $s (ref eq)) (result (ref $bytes))
(ref.cast (ref $bytes) (local.get $s)))
))

Expand Down
2 changes: 1 addition & 1 deletion runtime/wasm/effect.wat
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@
(func $caml_fresh_oo_id (param (ref eq)) (result (ref eq))))
(import "obj" "cont_tag" (global $cont_tag i32))
(import "stdlib" "caml_named_value"
(func $caml_named_value (param (ref $bytes)) (result (ref null eq))))
(func $caml_named_value (param (ref eq)) (result (ref null eq))))
(import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq))))
(import "fail" "javascript_exception"
(tag $javascript_exception (param externref)))
Expand Down
1 change: 0 additions & 1 deletion runtime/wasm/fs.wat
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

(module
(import "jslib" "log_str" (func $log_str (param (ref $bytes))))
(import "bindings" "getcwd" (func $getcwd (result anyref)))
(import "bindings" "chdir" (func $chdir (param anyref)))
(import "bindings" "mkdir" (func $mkdir (param anyref) (param i32)))
Expand Down
15 changes: 15 additions & 0 deletions runtime/wasm/hash.wat
View file
Original file line number Diff line number Diff line change
Expand Up @@ -318,6 +318,8 @@
(ref.i31 (i32.and (call $caml_hash_mix_final (local.get $h))
(i32.const 0x3FFFFFFF))))

(#if use-js-string
(#then
(func (export "caml_string_hash")
(param (ref eq)) (param (ref eq)) (result (ref eq))
(local $h i32)
Expand All @@ -329,3 +331,16 @@
(ref.cast (ref $string) (local.get 1))))
(i32.const 0x3FFFFFFF))))
)
(#else
(func (export "caml_string_hash")
(param (ref eq)) (param (ref eq)) (result (ref eq))
(local $h i32)
(ref.i31
(i32.and
(call $caml_hash_mix_final
(call $caml_hash_mix_bytes
(i31.get_s (ref.cast (ref i31) (local.get 0)))
(ref.cast (ref $bytes) (local.get 1))))
(i32.const 0x3FFFFFFF))))
))
)
53 changes: 39 additions & 14 deletions runtime/wasm/jslib.wat
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,7 @@
(import "fail" "caml_failwith_tag"
(func $caml_failwith_tag (result (ref eq))))
(import "stdlib" "caml_named_value"
(func $caml_named_value (param (ref $bytes)) (result (ref null eq))))
(func $caml_named_value (param (ref eq)) (result (ref null eq))))
(import "obj" "caml_callback_1"
(func $caml_callback_1
(param (ref eq)) (param (ref eq)) (result (ref eq))))
Expand All @@ -95,6 +95,8 @@
(func $string_of_jsstring (param (ref eq)) (result (ref eq))))
(import "jsstring" "jsbytes_of_bytes"
(func $jsbytes_of_bytes (param (ref $bytes)) (result anyref)))
(import "jsstring" "bytes_of_jsbytes"
(func $bytes_of_jsbytes (param anyref) (result (ref $bytes))))
(import "int32" "caml_copy_int32"
(func $caml_copy_int32 (param i32) (result (ref eq))))
(import "int32" "Int32_val"
Expand Down Expand Up @@ -469,34 +471,53 @@
(#else
(func $caml_jsstring_of_string (export "caml_jsstring_of_string")
(param (ref eq)) (result (ref eq))
(local $s (ref $string))
(local.set $s (ref.cast (ref $string) (local.get 0)))
(local $s (ref $bytes))
(local.set $s (ref.cast (ref $bytes) (local.get 0)))
(return (struct.new $js (call $jsstring_of_bytes (local.get $s)))))
))
;;ZZZZZZZZZZZZZZZZZZZ
(func $caml_jsbytes_of_string (export "caml_jsbytes_of_string")

(#if use-js-string
(#then
(func (export "caml_jsbytes_of_string")
(param (ref eq)) (result (ref eq))
(local.get 0))
)
(#else
(export "caml_jsbytes_of_string" (func $caml_jsbytes_of_bytes))
))

(func $caml_jsbytes_of_bytes
(param (ref eq)) (result (ref eq))
(local $s (ref $bytes))
(local.set $s (ref.cast (ref $bytes) (local.get 0)))
(return (struct.new $js (call $jsbytes_of_bytes (local.get $s)))))

(#if use-js-string
(#then
(export "caml_js_to_string" (func $string_of_jsstring))
(export "caml_string_of_jsstring" (func $string_of_jsstring))
(func $caml_string_of_jsstring (param (ref eq)) (result (ref eq))
(return_call $string_of_jsstring (local.get 0)))

(func (export "caml_bytes_of_jsstring")
)
(#else
(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 $bytes_of_jsstring
(struct.get $js 0 (ref.cast (ref $js) (local.get $s)))))
))

(#if use-js-string
(#then
(func (export "caml_string_of_jsbytes")
(param $s (ref eq)) (result (ref eq))
(local.get 0))
)
(#else
(func (export "caml_string_of_jsbytes") (param $s (ref eq)) (result (ref eq))
(return_call $bytes_of_jsbytes
(struct.get $js 0 (ref.cast (ref $js) (local.get $s)))))
))

(func (export "caml_list_to_js_array")
(param (ref eq)) (result (ref eq))
Expand Down Expand Up @@ -570,12 +591,12 @@
(call $wrap (local.get $exn)))))
(array.new_fixed $block 3 (ref.i31 (i32.const 0))
(call $caml_failwith_tag)
(call $string_of_jsstring
(call $caml_string_of_jsstring
(call $wrap
(call $meth_call
(local.get $exn)
(call $unwrap
(call $jsstring_of_string
(call $caml_jsstring_of_string
(array.new_data $bytes $toString
(i32.const 0) (i32.const 8))))
(any.convert_extern (call $new_array (i32.const 0))))))))
Expand Down Expand Up @@ -609,11 +630,15 @@
(array.get $block (local.get $exn) (i32.const 2)))))))
(call $wrap (ref.null any)))

(func (export "log_str") (param $s (ref $bytes))
(call $log_js
(call $unwrap (call $jsstring_of_string (local.get $s)))))

(func (export "caml_jsoo_flags_use_js_string")
(param (ref eq)) (result (ref eq))
(ref.i31 (i32.const 1))) ;; ZZZ
(ref.i31
(#if use-js-string
(#then
(i32.const 1)
)
(#else
(i32.const 0)
))
)) ;; ZZZ
)
48 changes: 47 additions & 1 deletion runtime/wasm/jsstring.wat
View file
Original file line number Diff line number Diff line change
Expand Up @@ -148,7 +148,8 @@
(return_call $jsstring_of_subbytes
(local.get $s) (i32.const 0) (array.len (local.get $s))))

(func (export "bytes_of_jsstring") (param $s anyref) (result (ref $bytes))
(func $bytes_of_jsstring (export "bytes_of_jsstring")
(param $s anyref) (result (ref $bytes))
(if (global.get $text_converters_available)
(then
(return_call $encodeStringToUTF8Array
Expand Down Expand Up @@ -240,6 +241,51 @@
(br $fill))))
(return_call $jsstring_of_bytes (local.get $s')))

(func (export "bytes_of_jsbytes") (param $s anyref) (result (ref $bytes))
(local $l i32) (local $i i32) (local $n i32) (local $c i32)
(local $s' (ref $bytes)) (local $s'' (ref $bytes))
(local.set $s' (call $bytes_of_jsstring (local.get $s)))
(local.set $l (array.len (local.get $s')))
(local.set $i (i32.const 0))
(local.set $n (i32.const 0))
(loop $count
(if (i32.lt_u (local.get $i) (local.get $l))
(then
(if (i32.ge_u (array.get_u $bytes (local.get $s') (local.get $i))
(i32.const 0xC0))
(then (local.set $n (i32.add (local.get $n) (i32.const 1)))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $count))))
(if (i32.eqz (local.get $n)) (then (return (local.get $s'))))
(local.set $s''
(array.new $bytes (i32.const 0)
(i32.sub (local.get $i) (local.get $n))))
(local.set $i (i32.const 0))
(local.set $n (i32.const 0))
(loop $fill
(if (i32.lt_u (local.get $i) (local.get $l))
(then
(local.set $c
(array.get_u $bytes (local.get $s') (local.get $i)))
(if (i32.lt_u (local.get $c) (i32.const 0xC0))
(then
(array.set $bytes
(local.get $s'') (local.get $n) (local.get $c))
(local.set $i (i32.add (local.get $i) (i32.const 1))))
(else
(array.set $bytes (local.get $s'')
(local.get $n)
(i32.sub
(i32.add
(i32.shl (local.get $c) (i32.const 6))
(array.get_u $bytes (local.get $s')
(i32.add (local.get $i) (i32.const 1))))
(i32.const 0x3080)))
(local.set $i (i32.add (local.get $i) (i32.const 2)))))
(local.set $n (i32.add (local.get $n) (i32.const 1)))
(br $fill))))
(local.get $s''))

;; Fallback implementation of string conversion functions

(memory (export "caml_buffer") 1)
Expand Down
77 changes: 70 additions & 7 deletions runtime/wasm/lexing.wat
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,20 +17,38 @@

(module
(import "fail" "caml_failwith" (func $caml_failwith (param (ref eq))))
(import "wasm:js-string" "length"
(func $string_length (param externref) (result i32)))
(import "wasm:js-string" "charCodeAt"
(func $string_get (param externref i32) (result i32)))

(type $block (array (mut (ref eq))))
(type $bytes (array (mut i8)))
(type $string (struct (field anyref)))

(#if use-js-string
(#then
(import "wasm:js-string" "charCodeAt"
(func $string_get (param externref i32) (result i32)))

(func $string_val (param $s (ref eq)) (result externref)
(extern.convert_any
(struct.get $string 0 (ref.cast (ref $string) (local.get $s)))))
)
(#else
(func $string_get (param $s (ref $bytes)) (param $i i32) (result i32)
(array.get $bytes (local.get $s) (local.get $i)))
(func $string_val (param $s (ref eq)) (result (ref $bytes))
(ref.cast (ref $bytes) (local.get $s)))
))

(func $get (param $s externref) (param $i i32) (result i32)
(func $get
(param $s
(#if use-js-string
(#then
externref
)
(#else
(ref $bytes)
))
)
(param $i i32) (result i32)
(local.set $i (i32.add (local.get $i) (local.get $i)))
(i32.extend16_s
(i32.or (call $string_get (local.get $s) (local.get $i))
Expand Down Expand Up @@ -72,12 +90,23 @@
(local $buffer (ref $bytes))
(local $vpos (ref eq)) (local $action (ref eq))
(local $pos i32) (local $base i32) (local $backtrk i32)
(#if use-js-string
(#then
(local $lex_base externref)
(local $lex_backtrk externref)
(local $lex_check externref)
(local $lex_check_code externref)
(local $lex_trans externref)
(local $lex_default externref)
)
(#else
(local $lex_base (ref $bytes))
(local $lex_backtrk (ref $bytes))
(local $lex_check (ref $bytes))
(local $lex_check_code (ref $bytes))
(local $lex_trans (ref $bytes))
(local $lex_default (ref $bytes))
))
(local.set $tbl (ref.cast (ref $block) (local.get $vtbl)))
(local.set $lexbuf (ref.cast (ref $block) (local.get $vlexbuf)))
(local.set $state
Expand Down Expand Up @@ -192,7 +221,16 @@
(br $loop)))

(func $run_mem
(param $s externref) (param $i i32) (param $lexbuf (ref $block))
(param $s
(#if use-js-string
(#then
externref
)
(#else
(ref $bytes)
))
)
(param $i i32) (param $lexbuf (ref $block))
(param $curr_pos (ref eq))
(local $dst i32) (local $src i32)
(local $mem (ref $block))
Expand All @@ -218,7 +256,16 @@
(br $loop)))

(func $run_tag
(param $s externref) (param $i i32) (param $lexbuf (ref $block))
(param $s
(#if use-js-string
(#then
externref
)
(#else
(ref $bytes)
))
)
(param $i i32) (param $lexbuf (ref $block))
(return_call $run_mem (local.get $s) (local.get $i) (local.get $lexbuf)
(ref.i31 (i32.const -1))))

Expand All @@ -234,6 +281,8 @@
(local $vpos (ref eq)) (local $action (ref eq))
(local $pos i32) (local $base i32) (local $backtrk i32)
(local $pc_off i32) (local $base_code i32)
(#if use-js-string
(#then
(local $lex_code externref)
(local $lex_base externref)
(local $lex_base_code externref)
Expand All @@ -245,6 +294,20 @@
(local $lex_trans_code externref)
(local $lex_default externref)
(local $lex_default_code externref)
)
(#else
(local $lex_code (ref $bytes))
(local $lex_base (ref $bytes))
(local $lex_base_code (ref $bytes))
(local $lex_backtrk (ref $bytes))
(local $lex_backtrk_code (ref $bytes))
(local $lex_check (ref $bytes))
(local $lex_check_code (ref $bytes))
(local $lex_trans (ref $bytes))
(local $lex_trans_code (ref $bytes))
(local $lex_default (ref $bytes))
(local $lex_default_code (ref $bytes))
))
(local.set $tbl (ref.cast (ref $block) (local.get $vtbl)))
(local.set $lexbuf (ref.cast (ref $block) (local.get $vlexbuf)))
(local.set $state
Expand Down
Loading

0 comments on commit e9a1f85

Please sign in to comment.