Skip to content

Commit

Permalink
Minimal compare and equal
Browse files Browse the repository at this point in the history
  • Loading branch information
@chambart
chambart committed Jul 29, 2023
1 parent a954e03 commit a35c0cd
Show file tree
Hide file tree
Showing 3 changed files with 230 additions and 32 deletions.
2 changes: 1 addition & 1 deletion wasm/emit_wast.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1803,7 +1803,7 @@ module Conv = struct
Linkage_name.to_string
@@ Compilation_unit.get_linkage_name (Symbol.compilation_unit sym)
in
let name = WSymbol.export_name sym in
let name = Wident.acceptable_string (WSymbol.export_name sym) in
Const.Import { typ = ref_eq; module_; name }

let func_import ({ id; arity } : Func_import.t) =
Expand Down
235 changes: 208 additions & 27 deletions wasm/imports_binaryen.wast
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,9 @@

(import "js_runtime" "memory" (memory $mem 1))

(import "runtime" "compare_ints"
(func $compare_int (param (ref eq)) (param (ref eq)) (result (ref i31))))

(import "runtime" "string_eq"
(func $string_eq (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))))

Expand Down Expand Up @@ -86,12 +89,43 @@
(export "caml_bytes_equal" (func $string_eq))
(export "caml_string_equal" (func $string_eq))

;; (func $string_compare (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))
;; ;; TODO
;; (unreachable))

;; (export "caml_bytes_compare" (func $string_compare))
;; (export "caml_string_compare" (func $string_compare))
;; Stolen from Jerome's wasm_of_ocaml
(func $compare_strings
(param $s1 (ref $String)) (param $s2 (ref $String)) (result i32)
(local $l1 i32) (local $l2 i32) (local $len i32) (local $i i32)
(local $c1 i32) (local $c2 i32)
(if (ref.eq (local.get $s1) (local.get $s2))
(then (return (i32.const 0))))
(local.set $l1 (array.len $String (local.get $s1)))
(local.set $l2 (array.len $String (local.get $s2)))
(local.set $len
(select (local.get $l1) (local.get $l2)
(i32.le_u (local.get $l1) (local.get $l2))))
(local.set $i (i32.const 0))
(loop $loop
(if (i32.lt_s (local.get $i) (local.get $len))
(then
(local.set $c1
(array.get_u $String (local.get $s1) (local.get $i)))
(local.set $c2
(array.get_u $String (local.get $s2) (local.get $i)))
(if (i32.ne (local.get $c1) (local.get $c2))
(then
(if (i32.le_u (local.get $c1) (local.get $c2))
(then (return (i32.const -1)))
(else (return (i32.const 1))))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $loop))))
(i32.sub (local.get $l1) (local.get $l2)))

(func $caml_string_compare (param $a (ref eq)) (param $b (ref eq)) (result (ref i31))
(i31.new (call $compare_strings
(ref.cast $String (local.get $a))
(ref.cast $String (local.get $b)))))

(export "caml_bytes_compare" (func $caml_string_compare))
(export "caml_string_compare" (func $caml_string_compare))

(func (export "caml_blit_string") (param (ref eq)) (param (ref eq))
(param (ref eq)) (param (ref eq))
Expand All @@ -115,28 +149,134 @@
;; ;; TODO
;; (unreachable))

;; Comparison
;; ==========
;; ==========
;; Comparison
;; ==========

;; int < block < unknown
(func (export "caml_compare") (param $a (ref eq)) (param $b (ref eq)) (result (ref i31))
(local $a_block (ref $Gen_block))
(local $b_block (ref $Gen_block))
(if (result (ref i31)) (ref.is_i31 (local.get $a))
(then
(if (result (ref i31)) (ref.is_i31 (local.get $b))
(then (return_call $compare_int (local.get $a) (local.get $b)))
(else (i31.new (i32.const -1))))
)
(else
(if (result (ref i31)) (ref.is_i31 (local.get $b))
(then (i31.new (i32.const 1)))
(else
(local.set $b_block
(block $both_block (result (ref $Gen_block))
(local.set $a_block
(block $a_is_block (result (ref $Gen_block))
(drop (br_on_cast $a_is_block (ref eq) (ref $Gen_block) (local.get $a)))
(return_call $caml_compare_data_non_block (local.get $a) (local.get $b))
))
;; a block, b unknown
(drop (br_on_cast $both_block (ref eq) (ref $Gen_block) (local.get $b)))
(return (i31.new (i32.const -1)))
))
;; Both blocks (test b = block)
(local.set $a_block (ref.cast $Gen_block (local.get $a)))
;; This cast shouldn't be required
(return_call $caml_compare_blocks (local.get $a_block) (local.get $b_block))
)
)
)
)
)

(func (export "caml_compare") (param (ref eq)) (param (ref eq)) (result (ref eq))
;; TODO
(unreachable)
(func $caml_compare_data_non_block (export "compare_data_non_block") (param $a (ref eq)) (param $b (ref eq)) (result (ref i31))
;; (block $both_string (result (ref $String))

;; )
(return_call $caml_string_compare (local.get $a) (local.get $b))
)

(func $caml_compare_blocks (param $a (ref $Gen_block)) (param $b (ref $Gen_block)) (result (ref i31))
(local $len_a i32) (local $len_b i32)
(local.set $len_a (array.len $Gen_block (local.get $a)))
(local.set $len_b (array.len $Gen_block (local.get $b)))
(if (i32.ne (local.get $len_a) (local.get $len_b))
(then
(return (i31.new
(i32.sub
(i32.gt_s (local.get $len_a) (local.get $len_b))
(i32.lt_s (local.get $len_a) (local.get $len_b)))))))
;; TODO
(unreachable)
)

(func $caml_equal (export "caml_equal") (param $a (ref eq)) (param $b (ref eq)) (result (ref i31))
(local $a_block (ref $Gen_block))
(local $b_block (ref $Gen_block))
(if (result (ref i31)) (ref.is_i31 (local.get $a))
(then
(if (result (ref i31)) (ref.is_i31 (local.get $b))
(then (i31.new (ref.eq (local.get $a) (local.get $b))))
(else (i31.new (i32.const 0))))
)
(else
(if (result (ref i31)) (ref.is_i31 (local.get $b))
(then (i31.new (i32.const 0)))
(else
(local.set $b_block
(block $both_block (result (ref $Gen_block))
(local.set $a_block
(block $a_is_block (result (ref $Gen_block))
(drop (br_on_cast $a_is_block (ref eq) (ref $Gen_block) (local.get $a)))
(return_call $equal_data_non_block (local.get $a) (local.get $b))
))
(drop (local.get $a_block))
;; a block, b unknown
(drop (br_on_cast $both_block (ref eq) (ref $Gen_block) (local.get $b)))
(return (i31.new (i32.const 0)))
))
;; Both blocks (test b = block)
(local.set $a_block (ref.cast $Gen_block (local.get $a)))
;; This cast shouldn't be required
(return_call $equal_blocks (local.get $a_block) (local.get $b_block))
)
)
)
)
)

(func $equal_data_non_block (export "equal_data_non_block") (param $a (ref eq)) (param $b (ref eq)) (result (ref i31))
(i31.new (i32.eq
(i32.const 0)
(call $compare_strings
(ref.cast $String (local.get $a))
(ref.cast $String (local.get $b)))))
)

(func $equal_blocks (param $a (ref $Gen_block)) (param $b (ref $Gen_block)) (result (ref i31))
(local $len_a i32)
(local $len_b i32)
(local $v_a (ref eq))
(local $v_b (ref eq))
(local $i i32)
(local.set $len_a (array.len $Gen_block (local.get $a)))
(local.set $len_b (array.len $Gen_block (local.get $b)))
(if (i32.ne (local.get $len_a) (local.get $len_b))
(then (return (i31.new (i32.const 0)))))
;; Same length
(loop $loop
(if (i32.eq (local.get $i) (local.get $len_a))
(then (return (i31.new (i32.const 1)))))
(local.set $v_a (array.get $Gen_block (local.get $a) (local.get $i)))
(local.set $v_b (array.get $Gen_block (local.get $b) (local.get $i)))
(if (ref.eq
(i31.new (i32.const 0))
(call $caml_equal (local.get $v_a) (local.get $v_b)))
(then (return (i31.new (i32.const 0)))))
(local.set $i (i32.add (i32.const 1) (local.get $i)))
(br $loop)
)
)

(func (export "caml_equal") (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))
;; TODO
(unreachable))
;; (block $true
;; (block $false
;; (if (ref.is_i31 (local.get $a))
;; (then (unreachable))
;; (else
;; (if (ref.is_i31 (local.get $b))
;; (then
;; )))))
;; )
;; (return (i31.new (i32.const 0))))
;; (return (i31.new (i32.const 1))))

(func (export "caml_notequal") (param (ref eq)) (param (ref eq)) (result (ref eq))
;; TODO
Expand Down Expand Up @@ -258,10 +398,11 @@
;; TODO
(unreachable))

(func (export "caml_ml_output_char") (param (ref eq)) (param (ref eq))
(func (export "caml_ml_output_char") (param $ch (ref eq)) (param $char (ref eq))
(result (ref eq))
;; TODO
(unreachable))
(call $putchar (i31.get_s (ref.cast i31 (local.get $char))))
(i31.new (i32.const 0))
)

(func (export "caml_ml_output_string") (param (ref eq)) (param (ref eq))
(result (ref eq))
Expand Down Expand Up @@ -363,6 +504,46 @@
(i31.new (i32.const 0)))


(func $C_caml_sys_getenv (export "caml_sys_getenv") (param (ref eq)) (result (ref eq)) (unreachable))

(global $os_type (ref $String) (array.init_static $String (i32.const 87)(i32.const 97)(i32.const 115)(i32.const 109)))

(func $C_caml_sys_get_config (export "caml_sys_get_config") (param (ref eq)) (result (ref eq))
(array.init_static $Gen_block (i31.new (i32.const 0))
(global.get $os_type)
(i31.new (i32.const 32))
(i31.new (i32.const 0))
)
)

(global $executable_name (ref $String) (array.init_static $String (i32.const 119)(i32.const 97)(i32.const 115)(i32.const 111)(i32.const 99)(i32.const 97)(i32.const 109)(i32.const 108)(i32.const 95)(i32.const 98)(i32.const 105)(i32.const 110)(i32.const 97)(i32.const 114)(i32.const 121)))

(func $C_caml_sys_executable_name (export "caml_sys_executable_name") (param (ref eq)) (result (ref eq))
(global.get $executable_name))
(func $C_caml_ml_runtime_warnings_enabled (export "caml_ml_runtime_warnings_enabled") (param (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ml_enable_runtime_warnings (export "caml_ml_enable_runtime_warnings") (param (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_install_signal_handler (export "caml_install_signal_handler") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_obj_tag (export "caml_obj_tag") (param (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_obj_raw_field (export "caml_obj_raw_field") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_floatarray_set (export "caml_floatarray_set") (param (ref eq) (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_floatarray_get (export "caml_floatarray_get") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_unset_key (export "caml_ephe_unset_key") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_unset_data (export "caml_ephe_unset_data") (param (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_set_key (export "caml_ephe_set_key") (param (ref eq) (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_set_data (export "caml_ephe_set_data") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_get_key_copy (export "caml_ephe_get_key_copy") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_get_key (export "caml_ephe_get_key") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_get_data_copy (export "caml_ephe_get_data_copy") (param (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_get_data (export "caml_ephe_get_data") (param (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_create (export "caml_ephe_create") (param (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_check_key (export "caml_ephe_check_key") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_check_data (export "caml_ephe_check_data") (param (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_blit_key (export "caml_ephe_blit_key") (param (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_ephe_blit_data (export "caml_ephe_blit_data") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_obj_make_forward (export "caml_obj_make_forward") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_obj_block (export "caml_obj_block") (param (ref eq) (ref eq)) (result (ref eq)) (unreachable))
(func $C_caml_lazy_make_forward (export "caml_lazy_make_forward") (param (ref eq)) (result (ref eq)) (unreachable))

(func (export "caml_gc_major") (param (ref eq)) (result (ref eq))
(i31.new (i32.const 0)))

Expand Down
25 changes: 21 additions & 4 deletions wasm/runtime_binaryen.wast
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@
;; functions
;; =========

(func (export "compare_ints") (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))
(func (export "compare_ints") (param $a (ref eq)) (param $b (ref eq)) (result (ref i31))
(local $a' i32) (local $b' i32)
(local.set $a' (i31.get_s (ref.cast i31 (local.get $a))))
(local.set $b' (i31.get_s (ref.cast i31 (local.get $b))))
Expand All @@ -66,7 +66,7 @@
(i32.lt_s (local.get $a') (local.get $b'))))
)

(func (export "compare_floats") (param $a (ref eq)) (param $b (ref eq)) (result (ref eq))
(func (export "compare_floats") (param $a (ref eq)) (param $b (ref eq)) (result (ref i31))
(local $a' f64) (local $b' f64)
(local.set $a' (struct.get $Float 0 (ref.cast $Float (local.get $a))))
(local.set $b' (struct.get $Float 0 (ref.cast $Float (local.get $b))))
Expand All @@ -83,6 +83,14 @@
;; Arrays
;; ======

(func $array_length (export "array_length") (param $arr (ref eq)) (result (ref eq))
(i31.new (array.len $FloatArray
(block $floatarray (result (ref $FloatArray))
(return (i31.new (array.len $Array (ref.cast $Array
(br_on_cast $floatarray (ref eq) (ref $FloatArray) (local.get $arr))))))
)))
)

;; (func $array_length (export "array_length") (param $arr (ref eq)) (result (ref eq))
;; (i31.new (array.len
;; (block $floatarray (result (ref $FloatArray))
Expand Down Expand Up @@ -122,8 +130,17 @@
;; (local.get $field)))
;; )

;; (export "array_get_safe" (func $array_get_safe))
;; (export "array_get_unsafe" (func $array_get_safe))
(func $array_get_safe (export "array_get_safe") (param (ref eq)) (param (ref eq)) (result (ref eq))
(unreachable)
)

(func $array_set_unsafe (export "array_set_unsafe") (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
(unreachable)
)

(func $array_get_unsafe (export "array_get_unsafe") (param (ref eq)) (param (ref eq)) (result (ref eq))
(unreachable)
)

;; (func $array_set_float_unsafe (param $arr (ref $FloatArray)) (param $field (ref eq))
;; (param $value (ref eq)) (result (ref eq))
Expand Down

0 comments on commit a35c0cd

Please sign in to comment.