From 1b981f7a03a246cead1c5a161cc79c5a89c1c383 Mon Sep 17 00:00:00 2001 From: Philip Blair Date: Sun, 15 Oct 2023 09:13:13 +0200 Subject: [PATCH 1/4] feat: Add bindings for exception handling (try/catch/throw/rethrow) --- src/expression.c | 111 +++++++++++++++++++++++++++++++++++++++++++++ src/expression.js | 61 +++++++++++++++++++++++++ src/expression.ml | 26 +++++++++++ src/expression.mli | 26 +++++++++++ test/test.expected | 58 +++++++++++++++++++++++ test/test.ml | 44 ++++++++++++++++++ 6 files changed, 326 insertions(+) diff --git a/src/expression.c b/src/expression.c index 5f6e189..00b3d3b 100644 --- a/src/expression.c +++ b/src/expression.c @@ -1884,6 +1884,117 @@ caml_binaryen_ref_eq(value _module, value _left, value _right) { CAMLreturn(alloc_BinaryenExpressionRef(exp)); } +// Exception handling operations +CAMLprim value +caml_binaryen_try_native(value _module, value _name, value _body, value _catchTags, value _catchBodies, value _delegateTarget) { + CAMLparam5(_module, _name, _body, _catchTags, _catchBodies); + CAMLxparam1(_delegateTarget); + BinaryenModuleRef module = BinaryenModuleRef_val(_module); + char *name; + if (Is_none(_name)) { + name = NULL; + } else { + name = Safe_String_val(Some_val(_name)); + } + BinaryenExpressionRef body = BinaryenExpressionRef_val(_body); + _catchTags = array_of_list(_catchTags); + int catchTagsLen = array_length(_catchTags); + const char* catchTags[catchTagsLen]; + for (int i = 0; i < catchTagsLen; i++) { + catchTags[i] = Safe_String_val(Field(_catchTags, i)); + } + _catchBodies = array_of_list(_catchBodies); + int catchBodiesLen = array_length(_catchBodies); + BinaryenExpressionRef catchBodies[catchBodiesLen]; + for (int i = 0; i < catchBodiesLen; i++) { + catchBodies[i] = BinaryenExpressionRef_val(Field(_catchBodies, i)); + } + char *delegateTarget; + if (Is_none(_delegateTarget)) { + delegateTarget = NULL; + } else { + delegateTarget = Safe_String_val(Some_val(_delegateTarget)); + } + BinaryenExpressionRef exp = BinaryenTry(module, name, body, catchTags, catchTagsLen, catchBodies, catchBodiesLen, delegateTarget); + CAMLreturn(alloc_BinaryenExpressionRef(exp)); +} + +CAMLprim value caml_binaryen_try_bytecode(value *argv, int argn) { + return caml_binaryen_try_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); +} + +CAMLprim value +caml_binaryen_trycatch(value _module, value _name, value _body, value _catchTags, value _catchBodies) { + CAMLparam5(_module, _name, _body, _catchTags, _catchBodies); + BinaryenModuleRef module = BinaryenModuleRef_val(_module); + char *name; + if (Is_none(_name)) { + name = NULL; + } else { + name = Safe_String_val(Some_val(_name)); + } + BinaryenExpressionRef body = BinaryenExpressionRef_val(_body); + _catchTags = array_of_list(_catchTags); + int catchTagsLen = array_length(_catchTags); + const char* catchTags[catchTagsLen]; + for (int i = 0; i < catchTagsLen; i++) { + catchTags[i] = Safe_String_val(Field(_catchTags, i)); + } + _catchBodies = array_of_list(_catchBodies); + int catchBodiesLen = array_length(_catchBodies); + BinaryenExpressionRef catchBodies[catchBodiesLen]; + for (int i = 0; i < catchBodiesLen; i++) { + catchBodies[i] = BinaryenExpressionRef_val(Field(_catchBodies, i)); + } + char *delegateTarget = NULL; + BinaryenExpressionRef exp = BinaryenTry(module, name, body, catchTags, catchTagsLen, catchBodies, catchBodiesLen, delegateTarget); + CAMLreturn(alloc_BinaryenExpressionRef(exp)); +} + +CAMLprim value +caml_binaryen_trydelegate(value _module, value _name, value _body, value _delegateTarget) { + CAMLparam4(_module, _name, _body,_delegateTarget); + BinaryenModuleRef module = BinaryenModuleRef_val(_module); + char *name; + if (Is_none(_name)) { + name = NULL; + } else { + name = Safe_String_val(Some_val(_name)); + } + BinaryenExpressionRef body = BinaryenExpressionRef_val(_body); + char *delegateTarget = Safe_String_val(_delegateTarget); + int catchTagsLen = 0; + int catchBodiesLen = 0; + const char *catchTags[1] = {NULL}; + BinaryenExpressionRef catchBodies[1] = {NULL}; + BinaryenExpressionRef exp = BinaryenTry(module, name, body, catchTags, catchTagsLen, catchBodies, catchBodiesLen, delegateTarget); + CAMLreturn(alloc_BinaryenExpressionRef(exp)); +} + +CAMLprim value +caml_binaryen_throw(value _module, value _tag, value _operands) { + CAMLparam3(_module, _tag, _operands); + BinaryenModuleRef module = BinaryenModuleRef_val(_module); + char *tag = Safe_String_val(_tag); + _operands = array_of_list(_operands); + int operandsLen = array_length(_operands); + BinaryenExpressionRef operands[operandsLen]; + for (int i = 0; i < operandsLen; i++) { + operands[i] = BinaryenExpressionRef_val(Field(_operands, i)); + } + BinaryenExpressionRef exp = BinaryenThrow(module, tag, operands, operandsLen); + CAMLreturn(alloc_BinaryenExpressionRef(exp)); +} + +CAMLprim value +caml_binaryen_rethrow(value _module, value _target) { + CAMLparam2(_module, _target); + BinaryenModuleRef module = BinaryenModuleRef_val(_module); + char *target = Safe_String_val(_target); + BinaryenExpressionRef exp = BinaryenRethrow(module, target); + CAMLreturn(alloc_BinaryenExpressionRef(exp)); +} + // Table operations CAMLprim value caml_binaryen_table_get(value _module, value _name, value _index, value _ty) { diff --git a/src/expression.js b/src/expression.js index b19c5ed..d292192 100644 --- a/src/expression.js +++ b/src/expression.js @@ -1706,6 +1706,67 @@ function caml_binaryen_ref_eq(wasm_mod, left, right) { return wasm_mod.ref.func(left, right); } +// Exception handling operations + +//Provides: caml_binaryen_try_native +//Requires: caml_jsstring_of_string, caml_list_to_js_array +function caml_binaryen_try_native(wasm_mod, name, body, catch_tags, catch_bodies, delegate_target) { + return wasm_mod.try( + caml_jsstring_of_string(name), + body, + caml_list_to_js_array(catch_tags).map(caml_jsstring_of_string), + caml_list_to_js_array(catch_bodies), + delegate_target ? caml_jsstring_of_string(delegate_target[1]) : null, + ); +} + +//Provides: caml_binaryen_try_bytecode +//Requires: caml_binaryen_try_native +function caml_binaryen_try_bytecode() { + return caml_binaryen_try_native(arguments[0], arguments[1], arguments[2], arguments[3], arguments[4], arguments[5]); +} + +//Provides: caml_binaryen_trycatch +//Requires: caml_jsstring_of_string, caml_list_to_js_array +function caml_binaryen_trycatch(wasm_mod, name, body, catch_tags, catch_bodies) { + return wasm_mod.try( + caml_jsstring_of_string(name), + body, + caml_list_to_js_array(catch_tags).map(caml_jsstring_of_string), + caml_list_to_js_array(catch_bodies), + null, + ); +} + +//Provides: caml_binaryen_trydelegate +//Requires: caml_jsstring_of_string, caml_list_to_js_array +function caml_binaryen_trydelegate(wasm_mod, name, body, delegate_target) { + return wasm_mod.try( + caml_jsstring_of_string(name), + body, + [], + [], + delegate_target ? caml_jsstring_of_string(delegate_target[1]) : null, + ); +} + +//Provides: caml_binaryen_throw +//Requires: caml_jsstring_of_string, caml_list_to_js_array +function caml_binaryen_throw(wasm_mod, tag, operands) { + return wasm_mod.throw( + caml_jsstring_of_string(tag), + caml_list_to_js_array(operands), + ); +} + +//Provides: caml_binaryen_rethrow +//Requires: caml_jsstring_of_string, caml_list_to_js_array +function caml_binaryen_rethrow(wasm_mod, target) { + return wasm_mod.rethrow( + caml_jsstring_of_string(target), + ) +} + // Table operations //Provides: caml_binaryen_table_get diff --git a/src/expression.ml b/src/expression.ml index b0fceee..cc0a4a9 100644 --- a/src/expression.ml +++ b/src/expression.ml @@ -849,6 +849,32 @@ module Ref = struct (** Module, left, right *) end +(** Bindings for `try` instruction. For better validation, use `Try_catch` or `Try_Delegate`. *) +module Try = struct + external make : Module.t -> string option -> t -> string list -> t list -> string option -> t = "caml_binaryen_try_bytecode" "caml_binaryen_try_native" + (** Module, name, body, catch tags, catch bodies, delegate target *) +end + +module Try_Catch = struct + external make : Module.t -> string option -> t -> string list -> t list -> t = "caml_binaryen_trycatch" + (** Module, name, body, catch tags, catch bodies *) +end + +module Try_Delegate = struct + external make : Module.t -> string option -> t -> string -> t = "caml_binaryen_trydelegate" + (** Module, name, body, delegate *) +end + +module Throw = struct + external make : Module.t -> string -> t list -> t = "caml_binaryen_throw" + (** Module, tag, operands *) +end + +module Rethrow = struct + external make : Module.t -> string -> t = "caml_binaryen_rethrow" + (** Module, target *) +end + module Table = struct external get : Module.t -> string -> t -> Type.t -> t = "caml_binaryen_table_get" diff --git a/src/expression.mli b/src/expression.mli index c22e181..d916345 100644 --- a/src/expression.mli +++ b/src/expression.mli @@ -350,6 +350,32 @@ module Ref : sig (** Module, left, right *) end +(** Bindings for `try` instruction. For better validation, use `Try_catch` or `Try_Delegate`. *) +module Try : sig + val make : Module.t -> string option -> t -> string list -> t list -> string option -> t + (** Module, name, body, catch tags, catch bodies, delegate target *) +end + +module Try_Catch : sig + val make : Module.t -> string option -> t -> string list -> t list -> t + (** Module, name, body, catch tags, catch bodies *) +end + +module Try_Delegate : sig + val make : Module.t -> string option -> t -> string -> t + (** Module, name, body, delegate *) +end + +module Throw : sig + val make : Module.t -> string -> t list -> t + (** Module, tag, operands *) +end + +module Rethrow : sig + val make : Module.t -> string -> t + (** Module, target *) +end + module Table : sig val get : Module.t -> string -> t -> Type.t -> t (** Module, name, index, type *) diff --git a/test/test.expected b/test/test.expected index d65130c..2a3b653 100644 --- a/test/test.expected +++ b/test/test.expected @@ -6,6 +6,64 @@ (ref.null nofunc) (i32.const 0) ) +(try $tc1 (result i32) + (do + (throw $foo + (i32.const 1) + ) + ) + (catch $foo + (i32.const 2) + ) + (catch $bar + (i32.const 3) + ) +) +(try $tc2 (result i32) + (do + (rethrow $foo) + ) + (catch $foo + (i32.const 2) + ) + (catch $bar + (i32.const 3) + ) +) +(try $tc3 (result i32) + (do + (i32.const 1) + ) + (catch $foo + (i32.const 2) + ) + (catch_all + (i32.const 3) + ) +) +(try $tc4 (result i32) + (do + (i32.const 1) + ) + (catch $foo + (i32.const 2) + ) + (catch_all + (i32.const 3) + ) +) +(try $td1 (result i32) + (do + (i32.const 1) + ) + (delegate $del1) +) +(try $td2 (result i32) + (do + (i32.const 1) + ) + (delegate $del1) +) (module (type $i32_i32_=>_i32 (func (param i32 i32) (result i32))) (type $none_=>_none (func)) diff --git a/test/test.ml b/test/test.ml index b53eba0..0aa879e 100644 --- a/test/test.ml +++ b/test/test.ml @@ -185,6 +185,50 @@ let _ = assert ( Bytes.equal (Memory.get_segment_data wasm_mod 1) (Bytes.of_string "world")) +(* Exception handling *) +let try_catch_1 = + Expression.Try.make wasm_mod (Some "tc1") + (Expression.Throw.make wasm_mod "foo" [Expression.Const.make wasm_mod (Literal.int32 1l)]) + ["foo"; "bar"] + [Expression.Const.make wasm_mod (Literal.int32 2l); Expression.Const.make wasm_mod (Literal.int32 3l)] + None +let try_catch_2 = + Expression.Try_Catch.make wasm_mod (Some "tc2") + (Expression.Rethrow.make wasm_mod "foo") + ["foo"; "bar"] + [Expression.Const.make wasm_mod (Literal.int32 2l); Expression.Const.make wasm_mod (Literal.int32 3l)] + +(* One more catch-body than catch-tag; last body becomes the catch_all *) +let try_catch_all_1 = + Expression.Try.make wasm_mod (Some "tc3") + (Expression.Const.make wasm_mod (Literal.int32 1l)) + ["foo"] + [Expression.Const.make wasm_mod (Literal.int32 2l); Expression.Const.make wasm_mod (Literal.int32 3l)] + None +let try_catch_all_2 = + Expression.Try_Catch.make wasm_mod (Some "tc4") + (Expression.Const.make wasm_mod (Literal.int32 1l)) + ["foo"] + [Expression.Const.make wasm_mod (Literal.int32 2l); Expression.Const.make wasm_mod (Literal.int32 3l)] + +let try_delegate_1 = + Expression.Try.make wasm_mod (Some "td1") + (Expression.Const.make wasm_mod (Literal.int32 1l)) + [] + [] + (Some "del1") +let try_delegate_2 = + Expression.Try_Delegate.make wasm_mod (Some "td2") + (Expression.Const.make wasm_mod (Literal.int32 1l)) + "del1" + +let _ = Expression.print try_catch_1 +let _ = Expression.print try_catch_2 +let _ = Expression.print try_catch_all_1 +let _ = Expression.print try_catch_all_2 +let _ = Expression.print try_delegate_1 +let _ = Expression.print try_delegate_2 + (* Create an imported "write" function i32 (externref, i32, i32) *) (* Similar to the example here: https://bytecodealliance.org/articles/reference-types-in-wasmtime *) From 053c18560f1bae408dac3f2ee57042e8fefb6c89 Mon Sep 17 00:00:00 2001 From: Philip Blair Date: Mon, 16 Oct 2023 09:13:47 +0200 Subject: [PATCH 2/4] Remove C bindings for try_catch/try_delegate and replace with OCaml implementations --- src/expression.c | 48 ----------------------------------------------- src/expression.js | 24 ------------------------ src/expression.ml | 6 ++---- 3 files changed, 2 insertions(+), 76 deletions(-) diff --git a/src/expression.c b/src/expression.c index 00b3d3b..541872b 100644 --- a/src/expression.c +++ b/src/expression.c @@ -1923,54 +1923,6 @@ CAMLprim value caml_binaryen_try_bytecode(value *argv, int argn) { return caml_binaryen_try_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } -CAMLprim value -caml_binaryen_trycatch(value _module, value _name, value _body, value _catchTags, value _catchBodies) { - CAMLparam5(_module, _name, _body, _catchTags, _catchBodies); - BinaryenModuleRef module = BinaryenModuleRef_val(_module); - char *name; - if (Is_none(_name)) { - name = NULL; - } else { - name = Safe_String_val(Some_val(_name)); - } - BinaryenExpressionRef body = BinaryenExpressionRef_val(_body); - _catchTags = array_of_list(_catchTags); - int catchTagsLen = array_length(_catchTags); - const char* catchTags[catchTagsLen]; - for (int i = 0; i < catchTagsLen; i++) { - catchTags[i] = Safe_String_val(Field(_catchTags, i)); - } - _catchBodies = array_of_list(_catchBodies); - int catchBodiesLen = array_length(_catchBodies); - BinaryenExpressionRef catchBodies[catchBodiesLen]; - for (int i = 0; i < catchBodiesLen; i++) { - catchBodies[i] = BinaryenExpressionRef_val(Field(_catchBodies, i)); - } - char *delegateTarget = NULL; - BinaryenExpressionRef exp = BinaryenTry(module, name, body, catchTags, catchTagsLen, catchBodies, catchBodiesLen, delegateTarget); - CAMLreturn(alloc_BinaryenExpressionRef(exp)); -} - -CAMLprim value -caml_binaryen_trydelegate(value _module, value _name, value _body, value _delegateTarget) { - CAMLparam4(_module, _name, _body,_delegateTarget); - BinaryenModuleRef module = BinaryenModuleRef_val(_module); - char *name; - if (Is_none(_name)) { - name = NULL; - } else { - name = Safe_String_val(Some_val(_name)); - } - BinaryenExpressionRef body = BinaryenExpressionRef_val(_body); - char *delegateTarget = Safe_String_val(_delegateTarget); - int catchTagsLen = 0; - int catchBodiesLen = 0; - const char *catchTags[1] = {NULL}; - BinaryenExpressionRef catchBodies[1] = {NULL}; - BinaryenExpressionRef exp = BinaryenTry(module, name, body, catchTags, catchTagsLen, catchBodies, catchBodiesLen, delegateTarget); - CAMLreturn(alloc_BinaryenExpressionRef(exp)); -} - CAMLprim value caml_binaryen_throw(value _module, value _tag, value _operands) { CAMLparam3(_module, _tag, _operands); diff --git a/src/expression.js b/src/expression.js index d292192..abecd40 100644 --- a/src/expression.js +++ b/src/expression.js @@ -1726,30 +1726,6 @@ function caml_binaryen_try_bytecode() { return caml_binaryen_try_native(arguments[0], arguments[1], arguments[2], arguments[3], arguments[4], arguments[5]); } -//Provides: caml_binaryen_trycatch -//Requires: caml_jsstring_of_string, caml_list_to_js_array -function caml_binaryen_trycatch(wasm_mod, name, body, catch_tags, catch_bodies) { - return wasm_mod.try( - caml_jsstring_of_string(name), - body, - caml_list_to_js_array(catch_tags).map(caml_jsstring_of_string), - caml_list_to_js_array(catch_bodies), - null, - ); -} - -//Provides: caml_binaryen_trydelegate -//Requires: caml_jsstring_of_string, caml_list_to_js_array -function caml_binaryen_trydelegate(wasm_mod, name, body, delegate_target) { - return wasm_mod.try( - caml_jsstring_of_string(name), - body, - [], - [], - delegate_target ? caml_jsstring_of_string(delegate_target[1]) : null, - ); -} - //Provides: caml_binaryen_throw //Requires: caml_jsstring_of_string, caml_list_to_js_array function caml_binaryen_throw(wasm_mod, tag, operands) { diff --git a/src/expression.ml b/src/expression.ml index cc0a4a9..829b2ef 100644 --- a/src/expression.ml +++ b/src/expression.ml @@ -856,13 +856,11 @@ module Try = struct end module Try_Catch = struct - external make : Module.t -> string option -> t -> string list -> t list -> t = "caml_binaryen_trycatch" - (** Module, name, body, catch tags, catch bodies *) + let make module_ name body catch_tags catch_bodies = Try.make module_ name body catch_tags catch_bodies None end module Try_Delegate = struct - external make : Module.t -> string option -> t -> string -> t = "caml_binaryen_trydelegate" - (** Module, name, body, delegate *) + let make module_ name body delegate = Try.make module_ name body [] [] (Some delegate) end module Throw = struct From 7afaa1bc8d2771b0555bcdc1671429e59120ca61 Mon Sep 17 00:00:00 2001 From: Philip Blair Date: Sat, 21 Oct 2023 14:02:07 +0200 Subject: [PATCH 3/4] Add additional bindings to 'tag' values and fix tests --- src/dune | 2 + src/export.c | 10 ++ src/export.js | 13 ++ src/export.ml | 4 + src/export.mli | 1 + src/expression.js | 4 +- src/import.c | 32 +++++ src/import.js | 47 ++++++ src/import.ml | 11 ++ src/import.mli | 5 + src/ocaml_helpers.c | 8 ++ src/ocaml_helpers.h | 4 + src/tag.c | 61 ++++++++ src/tag.js | 43 ++++++ src/tag.ml | 15 ++ src/tag.mli | 9 ++ test/test.expected | 342 ++++++++++++++++++++++++++++++++++---------- test/test.ml | 75 +++++++--- 18 files changed, 592 insertions(+), 94 deletions(-) create mode 100644 src/tag.c create mode 100644 src/tag.js create mode 100644 src/tag.ml create mode 100644 src/tag.mli diff --git a/src/dune b/src/dune index a5bcd43..1249f71 100644 --- a/src/dune +++ b/src/dune @@ -15,6 +15,7 @@ export global table + tag memory module_feature module @@ -37,6 +38,7 @@ export.js global.js table.js + tag.js memory.js module_feature.js module.js diff --git a/src/export.c b/src/export.c index f100a70..79d701f 100644 --- a/src/export.c +++ b/src/export.c @@ -48,6 +48,16 @@ caml_binaryen_add_global_export(value _module, value _internalName, value _exter CAMLreturn(alloc_BinaryenExportRef(exp)); } +CAMLprim value +caml_binaryen_add_tag_export(value _module, value _internalName, value _externalName) { + CAMLparam3(_module, _internalName, _externalName); + BinaryenModuleRef module = BinaryenModuleRef_val(_module); + char* internalName = Safe_String_val(_internalName); + char* externalName = Safe_String_val(_externalName); + BinaryenExportRef exp = BinaryenAddTagExport(module, internalName, externalName); + CAMLreturn(alloc_BinaryenExportRef(exp)); +} + CAMLprim value caml_binaryen_get_export(value _module, value _externalName) { CAMLparam2(_module, _externalName); diff --git a/src/export.js b/src/export.js index a0060ca..168dabf 100644 --- a/src/export.js +++ b/src/export.js @@ -50,6 +50,19 @@ function caml_binaryen_add_global_export( ); } +//Provides: caml_binaryen_add_tag_export +//Requires: caml_jsstring_of_string +function caml_binaryen_add_tag_export( + wasm_mod, + internal_name, + external_name +) { + return wasm_mod.addTagExport( + caml_jsstring_of_string(internal_name), + caml_jsstring_of_string(external_name) + ); +} + //Provides: caml_binaryen_get_export //Requires: caml_jsstring_of_string function caml_binaryen_get_export(wasm_mod, external_name) { diff --git a/src/export.ml b/src/export.ml index 549c76b..05787a4 100644 --- a/src/export.ml +++ b/src/export.ml @@ -16,6 +16,10 @@ external add_global_export : Module.t -> string -> string -> t = "caml_binaryen_add_global_export" (** Module, internal name, external name. *) +external add_tag_export : Module.t -> string -> string -> t + = "caml_binaryen_add_tag_export" +(** Module, internal name, external name. *) + external get_export : Module.t -> string -> t = "caml_binaryen_get_export" external remove_export : Module.t -> string -> unit diff --git a/src/export.mli b/src/export.mli index 707f768..183297a 100644 --- a/src/export.mli +++ b/src/export.mli @@ -4,6 +4,7 @@ val add_function_export : Module.t -> string -> string -> t val add_table_export : Module.t -> string -> string -> t val add_memory_export : Module.t -> string -> string -> t val add_global_export : Module.t -> string -> string -> t +val add_tag_export : Module.t -> string -> string -> t val get_export : Module.t -> string -> t val remove_export : Module.t -> string -> unit val get_num_exports : Module.t -> int diff --git a/src/expression.js b/src/expression.js index abecd40..f64999c 100644 --- a/src/expression.js +++ b/src/expression.js @@ -1712,7 +1712,7 @@ function caml_binaryen_ref_eq(wasm_mod, left, right) { //Requires: caml_jsstring_of_string, caml_list_to_js_array function caml_binaryen_try_native(wasm_mod, name, body, catch_tags, catch_bodies, delegate_target) { return wasm_mod.try( - caml_jsstring_of_string(name), + name ? caml_jsstring_of_string(name[1]) : null, body, caml_list_to_js_array(catch_tags).map(caml_jsstring_of_string), caml_list_to_js_array(catch_bodies), @@ -1736,7 +1736,7 @@ function caml_binaryen_throw(wasm_mod, tag, operands) { } //Provides: caml_binaryen_rethrow -//Requires: caml_jsstring_of_string, caml_list_to_js_array +//Requires: caml_jsstring_of_string function caml_binaryen_rethrow(wasm_mod, target) { return wasm_mod.rethrow( caml_jsstring_of_string(target), diff --git a/src/import.c b/src/import.c index 962043e..501ae77 100644 --- a/src/import.c +++ b/src/import.c @@ -67,6 +67,24 @@ caml_binaryen_add_global_import__bytecode(value * argv) { return caml_binaryen_add_global_import(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } +CAMLprim value +caml_binaryen_add_tag_import(value _module, value _internalName, value _externalModuleName, value _externalBaseName, value _paramsty, value _resultsty) { + CAMLparam5(_module, _internalName, _externalModuleName, _externalBaseName, _paramsty); + CAMLxparam1(_resultsty); + BinaryenModuleRef module = BinaryenModuleRef_val(_module); + char* internalName = Safe_String_val(_internalName); + char* externalModuleName = Safe_String_val(_externalModuleName); + char* externalBaseName = Safe_String_val(_externalBaseName); + BinaryenType paramsty = BinaryenType_val(_paramsty); + BinaryenType resultsty = BinaryenType_val(_resultsty); + BinaryenAddTagImport(module, internalName, externalModuleName, externalBaseName, paramsty, resultsty); + CAMLreturn(Val_unit); +} +CAMLprim value +caml_binaryen_add_tag_import__bytecode(value * argv) { + return caml_binaryen_add_tag_import(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); +} + CAMLprim value caml_binaryen_function_import_get_module(value _fun) { CAMLparam1(_fun); @@ -89,6 +107,13 @@ caml_binaryen_global_import_get_module(value _global) { CAMLreturn(caml_copy_string(BinaryenGlobalImportGetModule(global))); } +CAMLprim value +caml_binaryen_tag_import_get_module(value _tag) { + CAMLparam1(_tag); + BinaryenTagRef tag = BinaryenTagRef_val(_tag); + CAMLreturn(caml_copy_string(BinaryenTagImportGetModule(tag))); +} + CAMLprim value caml_binaryen_function_import_get_base(value _fun) { CAMLparam1(_fun); @@ -110,3 +135,10 @@ caml_binaryen_global_import_get_base(value _global) { BinaryenGlobalRef global = BinaryenGlobalRef_val(_global); CAMLreturn(caml_copy_string(BinaryenGlobalImportGetBase(global))); } + +CAMLprim value +caml_binaryen_tag_import_get_base(value _tag) { + CAMLparam1(_tag); + BinaryenTagRef tag = BinaryenTagRef_val(_tag); + CAMLreturn(caml_copy_string(BinaryenTagImportGetBase(tag))); +} diff --git a/src/import.js b/src/import.js index 465dcd2..95852d8 100644 --- a/src/import.js +++ b/src/import.js @@ -92,6 +92,37 @@ function caml_binaryen_add_global_import__bytecode() { ); } +//Provides: caml_binaryen_add_tag_import +//Requires: caml_jsstring_of_string +function caml_binaryen_add_tag_import( + wasm_mod, + internalName, + externalModuleName, + externalBaseName, + paramsty, + resultsty +) { + return wasm_mod.addTagImport( + caml_jsstring_of_string(internalName), + caml_jsstring_of_string(externalModuleName), + caml_jsstring_of_string(externalBaseName), + paramsty, + resultsty + ); +} +//Provides: caml_binaryen_add_tag_import__bytecode +//Requires: caml_binaryen_add_tag_import +function caml_binaryen_add_tag_import__bytecode() { + return caml_binaryen_add_tag_import( + arguments[0], + arguments[1], + arguments[2], + arguments[3], + arguments[4], + arguments[5] + ); +} + //Provides: caml_binaryen_function_import_get_module //Requires: Binaryen //Requires: caml_string_of_jsstring @@ -115,6 +146,14 @@ function caml_binaryen_global_import_get_module(global) { return caml_string_of_jsstring(global_info.module); } +//Provides: caml_binaryen_tag_import_get_module +//Requires: Binaryen +//Requires: caml_string_of_jsstring +function caml_binaryen_tag_import_get_module(tag) { + var tag_info = Binaryen.getTagInfo(tag); + return caml_string_of_jsstring(tag_info.module); +} + //Provides: caml_binaryen_function_import_get_base //Requires: Binaryen //Requires: caml_string_of_jsstring @@ -137,3 +176,11 @@ function caml_binaryen_global_import_get_base(global) { var global_info = Binaryen.getGlobalInfo(global); return caml_string_of_jsstring(global_info.base); } + +//Provides: caml_binaryen_tag_import_get_base +//Requires: Binaryen +//Requires: caml_string_of_jsstring +function caml_binaryen_tag_import_get_base(tag) { + var tag_info = Binaryen.getTagInfo(tag); + return caml_string_of_jsstring(tag_info.base); +} diff --git a/src/import.ml b/src/import.ml index 33ccec1..81dff36 100644 --- a/src/import.ml +++ b/src/import.ml @@ -17,6 +17,11 @@ external add_global_import : = "caml_binaryen_add_global_import__bytecode" "caml_binaryen_add_global_import" (** Module, internal name, external module name, external base name, type, mutable. *) +external add_tag_import : + Module.t -> string -> string -> string -> Type.t -> Type.t -> unit + = "caml_binaryen_add_tag_import__bytecode" "caml_binaryen_add_tag_import" +(** Module, internal name, external module name, external base name, params type, results type. *) + external function_import_get_module : Function.t -> string = "caml_binaryen_function_import_get_module" @@ -26,6 +31,9 @@ external memory_import_get_module : Module.t -> string -> string external global_import_get_module : Global.t -> string = "caml_binaryen_global_import_get_module" +external tag_import_get_module : Tag.t -> string + = "caml_binaryen_tag_import_get_module" + external function_import_get_base : Function.t -> string = "caml_binaryen_function_import_get_base" @@ -34,3 +42,6 @@ external memory_import_get_base : Module.t -> string -> string external global_import_get_base : Global.t -> string = "caml_binaryen_global_import_get_base" + +external tag_import_get_base : Tag.t -> string + = "caml_binaryen_tag_import_get_base" diff --git a/src/import.mli b/src/import.mli index 52a6937..42c9bf9 100644 --- a/src/import.mli +++ b/src/import.mli @@ -7,9 +7,14 @@ val add_memory_import : Module.t -> string -> string -> string -> bool -> unit val add_global_import : Module.t -> string -> string -> string -> Type.t -> bool -> unit +val add_tag_import : + Module.t -> string -> string -> string -> Type.t -> Type.t -> unit + val function_import_get_module : Function.t -> string val memory_import_get_module : Module.t -> string -> string val global_import_get_module : Global.t -> string +val tag_import_get_module : Tag.t -> string val function_import_get_base : Function.t -> string val memory_import_get_base : Module.t -> string -> string val global_import_get_base : Global.t -> string +val tag_import_get_base : Tag.t -> string diff --git a/src/ocaml_helpers.c b/src/ocaml_helpers.c index 78a1723..d8af8bb 100644 --- a/src/ocaml_helpers.c +++ b/src/ocaml_helpers.c @@ -38,6 +38,14 @@ value alloc_BinaryenGlobalRef(BinaryenGlobalRef exp) return v; } +/* Allocating an OCaml custom block to hold the given BinaryenTagRef */ +value alloc_BinaryenTagRef(BinaryenTagRef exp) +{ + value v = caml_alloc_custom(&binaryen_ops, sizeof(BinaryenTagRef), 0, 1); + BinaryenTagRef_val(v) = exp; + return v; +} + /* Allocating an OCaml custom block to hold the given BinaryenExportRef */ value alloc_BinaryenExportRef(BinaryenExportRef exp) { diff --git a/src/ocaml_helpers.h b/src/ocaml_helpers.h index 3e926ea..939ba09 100644 --- a/src/ocaml_helpers.h +++ b/src/ocaml_helpers.h @@ -29,6 +29,7 @@ static struct custom_operations binaryen_ops = { #define BinaryenLiteral_val(v) (*((struct BinaryenLiteral*) Data_custom_val(v))) #define BinaryenFunctionRef_val(v) (*((BinaryenFunctionRef*) Data_custom_val(v))) #define BinaryenGlobalRef_val(v) (*((BinaryenGlobalRef*) Data_custom_val(v))) +#define BinaryenTagRef_val(v) (*((BinaryenTagRef*) Data_custom_val(v))) #define BinaryenExportRef_val(v) (*((BinaryenExportRef*) Data_custom_val(v))) #define BinaryenTableRef_val(v) (*((BinaryenTableRef*) Data_custom_val(v))) #define BinaryenElementSegmentRef_val(v) (*((BinaryenElementSegmentRef*) Data_custom_val(v))) @@ -53,6 +54,9 @@ value alloc_BinaryenType(BinaryenType typ); /* Allocating an OCaml custom block to hold the given BinaryenGlobalRef */ value alloc_BinaryenGlobalRef(BinaryenGlobalRef exp); +/* Allocating an OCaml custom block to hold the given BinaryenTagRef */ +value alloc_BinaryenTagRef(BinaryenTagRef exp); + /* Allocating an OCaml custom block to hold the given BinaryenExportRef */ value alloc_BinaryenExportRef(BinaryenExportRef exp); diff --git a/src/tag.c b/src/tag.c new file mode 100644 index 0000000..0eb0dac --- /dev/null +++ b/src/tag.c @@ -0,0 +1,61 @@ +#define CAML_NAME_SPACE +#include +#include +#include +#include + +#include "binaryen-c.h" +#include "ocaml_helpers.h" + +CAMLprim value +caml_binaryen_add_tag(value _module, value _name, value _params, value _results) { + CAMLparam4(_module, _name, _params, _results); + BinaryenModuleRef module = BinaryenModuleRef_val(_module); + char* name = Safe_String_val(_name); + BinaryenType params = BinaryenType_val(_params); + BinaryenType results = BinaryenType_val(_results); + BinaryenTagRef tag = BinaryenAddTag(module, name, params, results); + CAMLreturn(alloc_BinaryenTagRef(tag)); +} + +CAMLprim value +caml_binaryen_get_tag(value _module, value _name) { + CAMLparam2(_module, _name); + BinaryenModuleRef module = BinaryenModuleRef_val(_module); + char* name = Safe_String_val(_name); + BinaryenTagRef tag = BinaryenGetTag(module, name); + CAMLreturn(alloc_BinaryenTagRef(tag)); +} + +CAMLprim value +caml_binaryen_remove_tag(value _module, value _name) { + CAMLparam2(_module, _name); + BinaryenModuleRef module = BinaryenModuleRef_val(_module); + char* name = Safe_String_val(_name); + BinaryenRemoveTag(module, name); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_tag_get_name(value _tag) { + CAMLparam1(_tag); + BinaryenTagRef tag = BinaryenTagRef_val(_tag); + const char* name = BinaryenTagGetName(tag); + CAMLreturn(caml_copy_string(name)); +} + +CAMLprim value +caml_binaryen_tag_get_params(value _tag) { + CAMLparam1(_tag); + BinaryenTagRef tag = BinaryenTagRef_val(_tag); + BinaryenType ty = BinaryenTagGetParams(tag); + CAMLreturn(alloc_BinaryenType(ty)); +} + +CAMLprim value +caml_binaryen_tag_get_results(value _tag) { + CAMLparam1(_tag); + BinaryenTagRef tag = BinaryenTagRef_val(_tag); + BinaryenType ty = BinaryenTagGetResults(tag); + CAMLreturn(alloc_BinaryenType(ty)); +} diff --git a/src/tag.js b/src/tag.js new file mode 100644 index 0000000..63065b1 --- /dev/null +++ b/src/tag.js @@ -0,0 +1,43 @@ +//Provides: caml_binaryen_add_tag +//Requires: caml_jsstring_of_string +function caml_binaryen_add_tag(wasm_mod, name, params, results) { + return wasm_mod.addTag( + caml_jsstring_of_string(name), + params, + results, + ); +} + +//Provides: caml_binaryen_get_tag +//Requires: caml_jsstring_of_string +function caml_binaryen_get_tag(wasm_mod, name) { + return wasm_mod.getTag(caml_jsstring_of_string(name)); +} + +//Provides: caml_binaryen_remove_tag +//Requires: caml_jsstring_of_string +function caml_binaryen_remove_tag(wasm_mod, name) { + return wasm_mod.removeTag(caml_jsstring_of_string(name)); +} + +//Provides: caml_binaryen_tag_get_name +//Requires: Binaryen +//Requires: caml_string_of_jsstring +function caml_binaryen_tag_get_name(tag) { + var tag_info = Binaryen.getTagInfo(tag); + return caml_string_of_jsstring(tag_info.name); +} + +//Provides: caml_binaryen_tag_get_params +//Requires: Binaryen +function caml_binaryen_tag_get_params(tag) { + var tag_info = Binaryen.getTagInfo(tag); + return tag_info.params; +} + +//Provides: caml_binaryen_tag_get_results +//Requires: Binaryen +function caml_binaryen_tag_get_results(tag) { + var tag_info = Binaryen.getTagInfo(tag); + return tag_info.results; +} diff --git a/src/tag.ml b/src/tag.ml new file mode 100644 index 0000000..7f8660f --- /dev/null +++ b/src/tag.ml @@ -0,0 +1,15 @@ +type t + +external add_tag : Module.t -> string -> Type.t -> Type.t -> t + = "caml_binaryen_add_tag" +(** Module, name, params, result *) + +external get_tag : Module.t -> string -> t = "caml_binaryen_get_tag" + +external remove_tag : Module.t -> string -> unit + = "caml_binaryen_remove_tag" + +external get_name : t -> string = "caml_binaryen_tag_get_name" +external get_params : t -> Type.t = "caml_binaryen_tag_get_params" +external get_results : t -> Type.t = "caml_binaryen_tag_get_results" + diff --git a/src/tag.mli b/src/tag.mli new file mode 100644 index 0000000..d558c19 --- /dev/null +++ b/src/tag.mli @@ -0,0 +1,9 @@ +type t + +val add_tag : Module.t -> string -> Type.t -> Type.t -> t +val get_tag : Module.t -> string -> t +val remove_tag : Module.t -> string -> unit +val get_name : t -> string +val get_params : t -> Type.t +val get_results : t -> Type.t + diff --git a/test/test.expected b/test/test.expected index 2a3b653..626efcb 100644 --- a/test/test.expected +++ b/test/test.expected @@ -6,65 +6,8 @@ (ref.null nofunc) (i32.const 0) ) -(try $tc1 (result i32) - (do - (throw $foo - (i32.const 1) - ) - ) - (catch $foo - (i32.const 2) - ) - (catch $bar - (i32.const 3) - ) -) -(try $tc2 (result i32) - (do - (rethrow $foo) - ) - (catch $foo - (i32.const 2) - ) - (catch $bar - (i32.const 3) - ) -) -(try $tc3 (result i32) - (do - (i32.const 1) - ) - (catch $foo - (i32.const 2) - ) - (catch_all - (i32.const 3) - ) -) -(try $tc4 (result i32) - (do - (i32.const 1) - ) - (catch $foo - (i32.const 2) - ) - (catch_all - (i32.const 3) - ) -) -(try $td1 (result i32) - (do - (i32.const 1) - ) - (delegate $del1) -) -(try $td2 (result i32) - (do - (i32.const 1) - ) - (delegate $del1) -) (module + (type $i32_=>_none (func (param i32))) (type $i32_i32_=>_i32 (func (param i32 i32) (result i32))) (type $none_=>_none (func)) (type $anyref_i32_i32_=>_i32 (func (param anyref i32 i32) (result i32))) @@ -78,9 +21,12 @@ (data $1 "world") (table $table 1 1 funcref) (elem $elem (i32.const 0) $adder) + (tag $foo (param i32)) + (tag $bar (param i32)) (export "adder" (func $adder)) (export "memory" (memory $0)) (export "hello" (func $hello)) + (export "trydelegate" (func $trydelegate)) (start $start) (func $adder (type $i32_i32_=>_i32) (param $0 i32) (param $1 i32) (result i32) (block $add (result i32) @@ -123,10 +69,135 @@ (i32.const 1) ) ) + (func $trydelegate (type $none_=>_none) + (block $blk + (drop + (try $tc1 (result i32) + (do + (throw $foo + (i32.const 1) + ) + ) + (catch $foo + (block $tc1blk2 (result i32) + (drop + (pop i32) + ) + (i32.const 2) + ) + ) + (catch $bar + (block $tc1blk3 (result i32) + (drop + (pop i32) + ) + (i32.const 3) + ) + ) + ) + ) + (drop + (try $tc2 (result i32) + (do + (throw $foo + (i32.const 1) + ) + ) + (catch $foo + (block $tc2blk2 + (drop + (pop i32) + ) + (rethrow $tc2) + ) + ) + (catch $bar + (block $tc2blk3 (result i32) + (drop + (pop i32) + ) + (i32.const 3) + ) + ) + ) + ) + (drop + (try $tc3 (result i32) + (do + (i32.const 1) + ) + (catch $foo + (block $tc3blk2 (result i32) + (drop + (pop i32) + ) + (i32.const 2) + ) + ) + (catch_all + (i32.const 3) + ) + ) + ) + (drop + (try $tc4 (result i32) + (do + (i32.const 1) + ) + (catch $foo + (block $tc4blk2 (result i32) + (drop + (pop i32) + ) + (i32.const 2) + ) + ) + (catch_all + (i32.const 3) + ) + ) + ) + (drop + (try $del1 (result i32) + (do + (try $td1 (result i32) + (do + (i32.const 1) + ) + (delegate $del1) + ) + ) + (catch_all + (block $del1blk (result i32) + (i32.const 2) + ) + ) + ) + ) + (drop + (try $del2 (result i32) + (do + (try $td2 (result i32) + (do + (i32.const 1) + ) + (delegate $del2) + ) + ) + (catch_all + (block $del2blk (result i32) + (i32.const 2) + ) + ) + ) + ) + ) + ) ) (module - (type $i32_i32_=>_i32 (func (param i32 i32) (result i32))) + (type $i32_=>_none (func (param i32))) (type $none_=>_none (func)) + (type $i32_i32_=>_i32 (func (param i32 i32) (result i32))) (type $anyref_i32_i32_=>_i32 (func (param anyref i32 i32) (result i32))) (type $anyref_=>_i32 (func (param anyref) (result i32))) (import "future-wasi" "write" (func $write (param anyref i32 i32) (result i32))) @@ -135,9 +206,12 @@ (data $1 "world") (table $table 1 1 funcref) (elem $elem (i32.const 0) $adder) + (tag $foo (param i32)) + (tag $bar (param i32)) (export "adder" (func $adder)) (export "memory" (memory $0)) (export "hello" (func $hello)) + (export "trydelegate" (func $trydelegate)) (start $start) (func $adder (type $i32_i32_=>_i32) (; has Stack IR ;) (param $0 i32) (param $1 i32) (result i32) (i32.add @@ -171,23 +245,71 @@ (i32.const 1) ) ) + (func $trydelegate (type $none_=>_none) (; has Stack IR ;) + (drop + (try (result i32) + (do + (throw $foo + (i32.const 1) + ) + ) + (catch $foo + (drop + (pop i32) + ) + (i32.const 2) + ) + (catch $bar + (drop + (pop i32) + ) + (i32.const 3) + ) + ) + ) + (drop + (try $tc2 (result i32) + (do + (throw $foo + (i32.const 1) + ) + ) + (catch $foo + (drop + (pop i32) + ) + (rethrow $tc2) + ) + (catch $bar + (drop + (pop i32) + ) + (i32.const 3) + ) + ) + ) + ) ) (module - (type $type$0 (func (param anyref i32 i32) (result i32))) - (type $type$1 (func (param i32 i32) (result i32))) - (type $type$2 (func)) - (type $type$3 (func (param anyref) (result i32))) + (type $type$0 (func (param i32))) + (type $type$3 (func)) + (type $type$1 (func (param anyref i32 i32) (result i32))) + (type $type$2 (func (param i32 i32) (result i32))) + (type $type$4 (func (param anyref) (result i32))) (import "future-wasi" "write" (func $fimport$0 (param anyref i32 i32) (result i32))) (memory $0 1) (data $0 (i32.const 0) "hello") (data $1 "world") (table $0 1 1 funcref) (elem $0 (i32.const 0) $0) + (tag $tag$0 (param i32)) + (tag $tag$1 (param i32)) (export "adder" (func $0)) (export "memory" (memory $0)) (export "hello" (func $2)) + (export "trydelegate" (func $3)) (start $1) - (func $0 (type $type$1) (param $0 i32) (param $1 i32) (result i32) + (func $0 (type $type$2) (param $0 i32) (param $1 i32) (result i32) (i32.add (select (local.get $0) @@ -199,7 +321,7 @@ (local.get $1) ) ) - (func $1 (type $type$2) + (func $1 (type $type$3) (memory.init $1 (i32.const 2048) (i32.const 0) @@ -212,30 +334,76 @@ ) ) ) - (func $2 (type $type$3) (param $0 anyref) (result i32) + (func $2 (type $type$4) (param $0 anyref) (result i32) (call $fimport$0 (local.get $0) (i32.const 0) (i32.const 1) ) ) + (func $3 (type $type$3) + (drop + (try $label$3 (result i32) + (do + (throw $tag$0 + (i32.const 1) + ) + ) + (catch $tag$0 + (drop + (pop i32) + ) + (i32.const 2) + ) + (catch $tag$1 + (drop + (pop i32) + ) + (unreachable) + ) + ) + ) + (try $label$6 + (do + (throw $tag$0 + (i32.const 1) + ) + ) + (catch $tag$0 + (drop + (pop i32) + ) + (rethrow $label$6) + ) + (catch $tag$1 + (drop + (pop i32) + ) + (unreachable) + ) + ) + ) ) (module - (type $type$0 (func (param anyref i32 i32) (result i32))) - (type $type$1 (func (param i32 i32) (result i32))) - (type $type$2 (func)) - (type $type$3 (func (param anyref) (result i32))) + (type $type$0 (func (param i32))) + (type $type$3 (func)) + (type $type$1 (func (param anyref i32 i32) (result i32))) + (type $type$2 (func (param i32 i32) (result i32))) + (type $type$4 (func (param anyref) (result i32))) (import "future-wasi" "write" (func $fimport$0 (param anyref i32 i32) (result i32))) (memory $0 1) (data $0 (i32.const 0) "hello") (data $1 "world") (table $0 1 1 funcref) (elem $0 (i32.const 0) $0) + (tag $tag$0 (param i32)) + (tag $tag$1 (param i32)) (export "adder" (func $0)) (export "memory" (memory $0)) (export "hello" (func $2)) + (export "trydelegate" (func $3)) (start $1) - (func $0 (type $type$1) (param $0 i32) (param $1 i32) (result i32) + (func $0 (type $type$2) (param $0 i32) (param $1 i32) (result i32) local.get $0 local.get $1 i32.load $0 @@ -244,7 +412,7 @@ local.get $1 i32.add ) - (func $1 (type $type$2) + (func $1 (type $type$3) i32.const 2048 i32.const 0 i32.const 5 @@ -254,10 +422,38 @@ call $0 drop ) - (func $2 (type $type$3) (param $0 anyref) (result i32) + (func $2 (type $type$4) (param $0 anyref) (result i32) local.get $0 i32.const 0 i32.const 1 call $fimport$0 ) + (func $3 (type $type$3) + try $label$3 (result i32) + i32.const 1 + throw $tag$0 + catch $tag$0 + + drop + i32.const 2 + catch $tag$1 + + drop + unreachable + end + drop + try $label$6 + i32.const 1 + throw $tag$0 + catch $tag$0 + + drop + rethrow $label$6 + catch $tag$1 + + drop + unreachable + end + unreachable + ) ) diff --git a/test/test.ml b/test/test.ml index 0aa879e..81a41ab 100644 --- a/test/test.ml +++ b/test/test.ml @@ -185,49 +185,73 @@ let _ = assert ( Bytes.equal (Memory.get_segment_data wasm_mod 1) (Bytes.of_string "world")) +let _ = Tag.add_tag wasm_mod "foo" Type.int32 Type.none +let _ = Tag.add_tag wasm_mod "bar" Type.int32 Type.none + (* Exception handling *) let try_catch_1 = Expression.Try.make wasm_mod (Some "tc1") (Expression.Throw.make wasm_mod "foo" [Expression.Const.make wasm_mod (Literal.int32 1l)]) ["foo"; "bar"] - [Expression.Const.make wasm_mod (Literal.int32 2l); Expression.Const.make wasm_mod (Literal.int32 3l)] + [(Expression.Block.make wasm_mod "tc1blk2" [Expression.Drop.make wasm_mod (Expression.Pop.make wasm_mod Type.int32); Expression.Const.make wasm_mod (Literal.int32 2l)]); + (Expression.Block.make wasm_mod "tc1blk3" [Expression.Drop.make wasm_mod (Expression.Pop.make wasm_mod Type.int32); Expression.Const.make wasm_mod (Literal.int32 3l)])] None let try_catch_2 = Expression.Try_Catch.make wasm_mod (Some "tc2") - (Expression.Rethrow.make wasm_mod "foo") + (Expression.Throw.make wasm_mod "foo" [Expression.Const.make wasm_mod (Literal.int32 1l)]) ["foo"; "bar"] - [Expression.Const.make wasm_mod (Literal.int32 2l); Expression.Const.make wasm_mod (Literal.int32 3l)] + [(Expression.Block.make wasm_mod "tc2blk2" [Expression.Drop.make wasm_mod (Expression.Pop.make wasm_mod Type.int32); Expression.Rethrow.make wasm_mod "tc2"]); + (Expression.Block.make wasm_mod "tc2blk3" [Expression.Drop.make wasm_mod (Expression.Pop.make wasm_mod Type.int32); Expression.Const.make wasm_mod (Literal.int32 3l)])] (* One more catch-body than catch-tag; last body becomes the catch_all *) let try_catch_all_1 = Expression.Try.make wasm_mod (Some "tc3") (Expression.Const.make wasm_mod (Literal.int32 1l)) ["foo"] - [Expression.Const.make wasm_mod (Literal.int32 2l); Expression.Const.make wasm_mod (Literal.int32 3l)] + [ + Expression.Block.make wasm_mod "tc3blk2" [ + Expression.Drop.make wasm_mod (Expression.Pop.make wasm_mod Type.int32); + Expression.Const.make wasm_mod (Literal.int32 2l); + ]; + Expression.Const.make wasm_mod (Literal.int32 3l) + ] None let try_catch_all_2 = Expression.Try_Catch.make wasm_mod (Some "tc4") (Expression.Const.make wasm_mod (Literal.int32 1l)) ["foo"] - [Expression.Const.make wasm_mod (Literal.int32 2l); Expression.Const.make wasm_mod (Literal.int32 3l)] + [ + Expression.Block.make wasm_mod "tc4blk2" [ + Expression.Drop.make wasm_mod (Expression.Pop.make wasm_mod Type.int32); + Expression.Const.make wasm_mod (Literal.int32 2l); + ]; + Expression.Const.make wasm_mod (Literal.int32 3l) + ] let try_delegate_1 = - Expression.Try.make wasm_mod (Some "td1") - (Expression.Const.make wasm_mod (Literal.int32 1l)) + Expression.Try_Catch.make wasm_mod (Some "del1") + (Expression.Try.make wasm_mod (Some "td1") + (Expression.Const.make wasm_mod (Literal.int32 1l)) + [] + [] + (Some "del1")) [] - [] - (Some "del1") + [ + Expression.Block.make wasm_mod "del1blk" [ + Expression.Const.make wasm_mod (Literal.int32 2l); + ]; + ] let try_delegate_2 = - Expression.Try_Delegate.make wasm_mod (Some "td2") - (Expression.Const.make wasm_mod (Literal.int32 1l)) - "del1" - -let _ = Expression.print try_catch_1 -let _ = Expression.print try_catch_2 -let _ = Expression.print try_catch_all_1 -let _ = Expression.print try_catch_all_2 -let _ = Expression.print try_delegate_1 -let _ = Expression.print try_delegate_2 + Expression.Try_Catch.make wasm_mod (Some "del2") + (Expression.Try_Delegate.make wasm_mod (Some "td2") + (Expression.Const.make wasm_mod (Literal.int32 1l)) + "del2") + [] + [ + Expression.Block.make wasm_mod "del2blk" [ + Expression.Const.make wasm_mod (Literal.int32 2l); + ]; + ] (* Create an imported "write" function i32 (externref, i32, i32) *) (* Similar to the example here: https://bytecodealliance.org/articles/reference-types-in-wasmtime *) @@ -248,7 +272,20 @@ let _ = ] Type.int32) +(* Create a function with try/delegate *) +let _ = + Function.add_function wasm_mod "trydelegate" Type.none Type.none [||] + (Expression.Block.make wasm_mod "blk" [ + Expression.Drop.make wasm_mod try_catch_1; + Expression.Drop.make wasm_mod try_catch_2; + Expression.Drop.make wasm_mod try_catch_all_1; + Expression.Drop.make wasm_mod try_catch_all_2; + Expression.Drop.make wasm_mod try_delegate_1; + Expression.Drop.make wasm_mod try_delegate_2; + ]) + let _ = Export.add_function_export wasm_mod "hello" "hello" +let _ = Export.add_function_export wasm_mod "trydelegate" "trydelegate" let _ = Module.validate wasm_mod (* Shouldn't actually do anything since we aren't doing function renames *) From 6108a39685e79a1e3bb7c91d6fee04909ebd1904 Mon Sep 17 00:00:00 2001 From: Philip Blair Date: Sun, 22 Oct 2023 18:36:34 +0200 Subject: [PATCH 4/4] Add remaining operations --- src/expression.c | 270 +++++++++++++++++++++++++++++++++++++++++++++ src/expression.js | 181 ++++++++++++++++++++++++++++++ src/expression.ml | 129 ++++++++++++++++++++++ src/expression.mli | 208 ++++++++++++++++++++++++++++++++++ 4 files changed, 788 insertions(+) diff --git a/src/expression.c b/src/expression.c index 541872b..ee0db80 100644 --- a/src/expression.c +++ b/src/expression.c @@ -1947,6 +1947,276 @@ caml_binaryen_rethrow(value _module, value _target) { CAMLreturn(alloc_BinaryenExpressionRef(exp)); } +CAMLprim value +caml_binaryen_try_get_name(value _expr) { + CAMLparam1(_expr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + const char* binaryenRetVal = BinaryenTryGetName(expr); + CAMLreturn(caml_copy_string(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_set_name(value _expr, value _name) { + CAMLparam2(_expr, _name); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + const char* name = Safe_String_val(_name); + BinaryenTrySetName(expr, name); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_try_get_body(value _expr) { + CAMLparam1(_expr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenExpressionRef binaryenRetVal = BinaryenTryGetBody(expr); + CAMLreturn(alloc_BinaryenExpressionRef(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_set_body(value _expr, value _bodyExpr) { + CAMLparam2(_expr, _bodyExpr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenExpressionRef bodyExpr = BinaryenExpressionRef_val(_bodyExpr); + BinaryenTrySetBody(expr, bodyExpr); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_try_get_num_catch_tags(value _expr) { + CAMLparam1(_expr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex binaryenRetVal = BinaryenTryGetNumCatchTags(expr); + CAMLreturn(Val_int(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_get_num_catch_bodies(value _expr) { + CAMLparam1(_expr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex binaryenRetVal = BinaryenTryGetNumCatchBodies(expr); + CAMLreturn(Val_int(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_get_catch_tag_at(value _expr, value _index) { + CAMLparam2(_expr, _index); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + const char* binaryenRetVal = BinaryenTryGetCatchTagAt(expr, index); + CAMLreturn(caml_copy_string(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_set_catch_tag_at(value _expr, value _index, value _catchTag) { + CAMLparam3(_expr, _index, _catchTag); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + const char* catchTag = Safe_String_val(_catchTag); + BinaryenTrySetCatchTagAt(expr, index, catchTag); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_try_append_catch_tag(value _expr, value _catchTag) { + CAMLparam2(_expr, _catchTag); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + const char* catchTag = Safe_String_val(_catchTag); + BinaryenIndex binaryenRetVal = BinaryenTryAppendCatchTag(expr, catchTag); + CAMLreturn(Val_int(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_insert_catch_tag_at(value _expr, value _index, value _catchTag) { + CAMLparam3(_expr, _index, _catchTag); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + const char* catchTag = Safe_String_val(_catchTag); + BinaryenTryInsertCatchTagAt(expr, index, catchTag); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_try_remove_catch_tag_at(value _expr, value _index) { + CAMLparam2(_expr, _index); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + const char* binaryenRetVal = BinaryenTryRemoveCatchTagAt(expr, index); + CAMLreturn(caml_copy_string(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_get_catch_body_at(value _expr, value _index) { + CAMLparam2(_expr, _index); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + BinaryenExpressionRef binaryenRetVal = BinaryenTryGetCatchBodyAt(expr, index); + CAMLreturn(alloc_BinaryenExpressionRef(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_set_catch_body_at(value _expr, value _index, value _catchExpr) { + CAMLparam3(_expr, _index, _catchExpr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + BinaryenExpressionRef catchExpr = BinaryenExpressionRef_val(_catchExpr); + BinaryenTrySetCatchBodyAt(expr, index, catchExpr); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_try_append_catch_body(value _expr, value _catchExpr) { + CAMLparam2(_expr, _catchExpr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenExpressionRef catchExpr = BinaryenExpressionRef_val(_catchExpr); + BinaryenIndex binaryenRetVal = BinaryenTryAppendCatchBody(expr, catchExpr); + CAMLreturn(Val_int(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_insert_catch_body_at(value _expr, value _index, value _catchExpr) { + CAMLparam3(_expr, _index, _catchExpr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + BinaryenExpressionRef catchExpr = BinaryenExpressionRef_val(_catchExpr); + BinaryenTryInsertCatchBodyAt(expr, index, catchExpr); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_try_remove_catch_body_at(value _expr, value _index) { + CAMLparam2(_expr, _index); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + BinaryenExpressionRef binaryenRetVal = BinaryenTryRemoveCatchBodyAt(expr, index); + CAMLreturn(alloc_BinaryenExpressionRef(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_has_catch_all(value _expr) { + CAMLparam1(_expr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + bool binaryenRetVal = BinaryenTryHasCatchAll(expr); + CAMLreturn(Val_bool(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_try_get_delegate_target(value _expr) { + CAMLparam1(_expr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + const char* binaryenRetVal = BinaryenTryGetDelegateTarget(expr); + if (binaryenRetVal == NULL) { + CAMLreturn(Val_none); + } else { + CAMLreturn(caml_alloc_some(caml_copy_string(binaryenRetVal))); + } +} + +CAMLprim value +caml_binaryen_try_set_delegate_target(value _expr, value _delegateTarget) { + CAMLparam2(_expr, _delegateTarget); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + const char* delegateTarget = Safe_String_val(_delegateTarget); + BinaryenTrySetDelegateTarget(expr, delegateTarget); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_try_is_delegate(value _expr) { + CAMLparam1(_expr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + bool binaryenRetVal = BinaryenTryIsDelegate(expr); + CAMLreturn(Val_bool(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_throw_get_tag(value _expr) { + CAMLparam1(_expr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + const char* binaryenRetVal = BinaryenThrowGetTag(expr); + CAMLreturn(caml_copy_string(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_throw_set_tag(value _expr, value _tagName) { + CAMLparam2(_expr, _tagName); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + const char* tagName = Safe_String_val(_tagName); + BinaryenThrowSetTag(expr, tagName); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_throw_get_num_operands(value _expr) { + CAMLparam1(_expr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex binaryenRetVal = BinaryenThrowGetNumOperands(expr); + CAMLreturn(Val_int(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_throw_get_operand_at(value _expr, value _index) { + CAMLparam2(_expr, _index); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + BinaryenExpressionRef binaryenRetVal = BinaryenThrowGetOperandAt(expr, index); + CAMLreturn(alloc_BinaryenExpressionRef(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_throw_set_operand_at(value _expr, value _index, value _operandExpr) { + CAMLparam3(_expr, _index, _operandExpr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + BinaryenExpressionRef operandExpr = BinaryenExpressionRef_val(_operandExpr); + BinaryenThrowSetOperandAt(expr, index, operandExpr); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_throw_append_operand(value _expr, value _operandExpr) { + CAMLparam2(_expr, _operandExpr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenExpressionRef operandExpr = BinaryenExpressionRef_val(_operandExpr); + BinaryenIndex binaryenRetVal = BinaryenThrowAppendOperand(expr, operandExpr); + CAMLreturn(Val_int(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_throw_insert_operand_at(value _expr, value _index, value _operandExpr) { + CAMLparam3(_expr, _index, _operandExpr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + BinaryenExpressionRef operandExpr = BinaryenExpressionRef_val(_operandExpr); + BinaryenThrowInsertOperandAt(expr, index, operandExpr); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_binaryen_throw_remove_operand_at(value _expr, value _index) { + CAMLparam2(_expr, _index); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + BinaryenIndex index = Int_val(_index); + BinaryenExpressionRef binaryenRetVal = BinaryenThrowRemoveOperandAt(expr, index); + CAMLreturn(alloc_BinaryenExpressionRef(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_rethrow_get_target(value _expr) { + CAMLparam1(_expr); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + const char* binaryenRetVal = BinaryenRethrowGetTarget(expr); + CAMLreturn(caml_copy_string(binaryenRetVal)); +} + +CAMLprim value +caml_binaryen_rethrow_set_target(value _expr, value _target) { + CAMLparam2(_expr, _target); + BinaryenExpressionRef expr = BinaryenExpressionRef_val(_expr); + const char* target = Safe_String_val(_target); + BinaryenRethrowSetTarget(expr, target); + CAMLreturn(Val_unit); +} + // Table operations CAMLprim value caml_binaryen_table_get(value _module, value _name, value _index, value _ty) { diff --git a/src/expression.js b/src/expression.js index f64999c..d473fe3 100644 --- a/src/expression.js +++ b/src/expression.js @@ -1743,6 +1743,187 @@ function caml_binaryen_rethrow(wasm_mod, target) { ) } +//Provides: caml_binaryen_try_get_name +//Requires: Binaryen, caml_string_of_jsstring +function caml_binaryen_try_get_name(expr) { + return caml_string_of_jsstring(Binaryen['_BinaryenTryGetName'](expr)); +} + +//Provides: caml_binaryen_try_set_name +//Requires: Binaryen, caml_jsstring_of_string +function caml_binaryen_try_set_name(expr, name) { + Binaryen['_BinaryenTrySetName'](expr, name); +} + +//Provides: caml_binaryen_try_get_body +//Requires: Binaryen +function caml_binaryen_try_get_body(expr) { + return Binaryen['_BinaryenTryGetBody'](expr); +} + +//Provides: caml_binaryen_try_set_body +//Requires: Binaryen +function caml_binaryen_try_set_body(expr, bodyExpr) { + Binaryen['_BinaryenTrySetBody'](expr, bodyExpr); +} + +//Provides: caml_binaryen_try_get_num_catch_tags +//Requires: Binaryen +function caml_binaryen_try_get_num_catch_tags(expr) { + return Binaryen['_BinaryenTryGetNumCatchTags'](expr); +} + +//Provides: caml_binaryen_try_get_num_catch_bodies +//Requires: Binaryen +function caml_binaryen_try_get_num_catch_bodies(expr) { + return Binaryen['_BinaryenTryGetNumCatchBodies'](expr); +} + +//Provides: caml_binaryen_try_get_catch_tag_at +//Requires: Binaryen, caml_string_of_jsstring +function caml_binaryen_try_get_catch_tag_at(expr, index) { + return caml_string_of_jsstring(Binaryen['_BinaryenTryGetCatchTagAt'](expr, index)); +} + +//Provides: caml_binaryen_try_set_catch_tag_at +//Requires: Binaryen, caml_jsstring_of_string +function caml_binaryen_try_set_catch_tag_at(expr, index, catchTag) { + Binaryen['_BinaryenTrySetCatchTagAt'](expr, index, catchTag); +} + +//Provides: caml_binaryen_try_append_catch_tag +//Requires: Binaryen, caml_jsstring_of_string +function caml_binaryen_try_append_catch_tag(expr, catchTag) { + return Binaryen['_BinaryenTryAppendCatchTag'](expr, catchTag); +} + +//Provides: caml_binaryen_try_insert_catch_tag_at +//Requires: Binaryen, caml_jsstring_of_string +function caml_binaryen_try_insert_catch_tag_at(expr, index, catchTag) { + Binaryen['_BinaryenTryInsertCatchTagAt'](expr, index, catchTag); +} + +//Provides: caml_binaryen_try_remove_catch_tag_at +//Requires: Binaryen, caml_string_of_jsstring +function caml_binaryen_try_remove_catch_tag_at(expr, index) { + return caml_string_of_jsstring(Binaryen['_BinaryenTryRemoveCatchTagAt'](expr, index)); +} + +//Provides: caml_binaryen_try_get_catch_body_at +//Requires: Binaryen +function caml_binaryen_try_get_catch_body_at(expr, index) { + return Binaryen['_BinaryenTryGetCatchBodyAt'](expr, index); +} + +//Provides: caml_binaryen_try_set_catch_body_at +//Requires: Binaryen +function caml_binaryen_try_set_catch_body_at(expr, index, catchExpr) { + Binaryen['_BinaryenTrySetCatchBodyAt'](expr, index, catchExpr); +} + +//Provides: caml_binaryen_try_append_catch_body +//Requires: Binaryen +function caml_binaryen_try_append_catch_body(expr, catchExpr) { + return Binaryen['_BinaryenTryAppendCatchBody'](expr, catchExpr); +} + +//Provides: caml_binaryen_try_insert_catch_body_at +//Requires: Binaryen +function caml_binaryen_try_insert_catch_body_at(expr, index, catchExpr) { + Binaryen['_BinaryenTryInsertCatchBodyAt'](expr, index, catchExpr); +} + +//Provides: caml_binaryen_try_remove_catch_body_at +//Requires: Binaryen +function caml_binaryen_try_remove_catch_body_at(expr, index) { + return Binaryen['_BinaryenTryRemoveCatchBodyAt'](expr, index); +} + +//Provides: caml_binaryen_try_has_catch_all +//Requires: Binaryen +function caml_binaryen_try_has_catch_all(expr) { + return Binaryen['_BinaryenTryHasCatchAll'](expr); +} + +//Provides: caml_binaryen_try_get_delegate_target +//Requires: Binaryen, caml_string_of_jsstring +function caml_binaryen_try_get_delegate_target(expr) { + const retval = Binaryen['_BinaryenTryGetDelegateTarget'](expr); + return retval ? [0, caml_string_of_jsstring(retval)] : null; +} + +//Provides: caml_binaryen_try_set_delegate_target +//Requires: Binaryen, caml_jsstring_of_string +function caml_binaryen_try_set_delegate_target(expr, delegateTarget) { + Binaryen['_BinaryenTrySetDelegateTarget'](expr, delegateTarget); +} + +//Provides: caml_binaryen_try_is_delegate +//Requires: Binaryen +function caml_binaryen_try_is_delegate(expr) { + return Binaryen['_BinaryenTryIsDelegate'](expr); +} + +//Provides: caml_binaryen_throw_get_tag +//Requires: Binaryen, caml_string_of_jsstring +function caml_binaryen_throw_get_tag(expr) { + return caml_string_of_jsstring(Binaryen['_BinaryenThrowGetTag'](expr)); +} + +//Provides: caml_binaryen_throw_set_tag +//Requires: Binaryen, caml_jsstring_of_string +function caml_binaryen_throw_set_tag(expr, tagName) { + Binaryen['_BinaryenThrowSetTag'](expr, tagName); +} + +//Provides: caml_binaryen_throw_get_num_operands +//Requires: Binaryen +function caml_binaryen_throw_get_num_operands(expr) { + return Binaryen['_BinaryenThrowGetNumOperands'](expr); +} + +//Provides: caml_binaryen_throw_get_operand_at +//Requires: Binaryen +function caml_binaryen_throw_get_operand_at(expr, index) { + return Binaryen['_BinaryenThrowGetOperandAt'](expr, index); +} + +//Provides: caml_binaryen_throw_set_operand_at +//Requires: Binaryen +function caml_binaryen_throw_set_operand_at(expr, index, operandExpr) { + Binaryen['_BinaryenThrowSetOperandAt'](expr, index, operandExpr); +} + +//Provides: caml_binaryen_throw_append_operand +//Requires: Binaryen +function caml_binaryen_throw_append_operand(expr, operandExpr) { + return Binaryen['_BinaryenThrowAppendOperand'](expr, operandExpr); +} + +//Provides: caml_binaryen_throw_insert_operand_at +//Requires: Binaryen +function caml_binaryen_throw_insert_operand_at(expr, index, operandExpr) { + Binaryen['_BinaryenThrowInsertOperandAt'](expr, index, operandExpr); +} + +//Provides: caml_binaryen_throw_remove_operand_at +//Requires: Binaryen +function caml_binaryen_throw_remove_operand_at(expr, index) { + return Binaryen['_BinaryenThrowRemoveOperandAt'](expr, index); +} + +//Provides: caml_binaryen_rethrow_get_target +//Requires: Binaryen, caml_string_of_jsstring +function caml_binaryen_rethrow_get_target(expr) { + return caml_string_of_jsstring(Binaryen['_BinaryenRethrowGetTarget'](expr)); +} + +//Provides: caml_binaryen_rethrow_set_target +//Requires: Binaryen, caml_jsstring_of_string +function caml_binaryen_rethrow_set_target(expr, target) { + Binaryen['_BinaryenRethrowSetTarget'](expr, target); +} + // Table operations //Provides: caml_binaryen_table_get diff --git a/src/expression.ml b/src/expression.ml index 829b2ef..3e2bada 100644 --- a/src/expression.ml +++ b/src/expression.ml @@ -853,24 +853,153 @@ end module Try = struct external make : Module.t -> string option -> t -> string list -> t list -> string option -> t = "caml_binaryen_try_bytecode" "caml_binaryen_try_native" (** Module, name, body, catch tags, catch bodies, delegate target *) + external get_name : t -> string = "caml_binaryen_try_get_name" + (** expr *) + + external set_name : t -> string -> unit = "caml_binaryen_try_set_name" + (** expr, name *) + + external get_body : t -> t = "caml_binaryen_try_get_body" + (** expr *) + + external set_body : t -> t -> unit = "caml_binaryen_try_set_body" + (** expr, bodyExpr *) + + external get_num_catch_tags : t -> int = "caml_binaryen_try_get_num_catch_tags" + (** expr *) + + external get_num_catch_bodies : t -> int = "caml_binaryen_try_get_num_catch_bodies" + (** expr *) + + external get_catch_tag_at : t -> int -> string = "caml_binaryen_try_get_catch_tag_at" + (** expr, index *) + + external set_catch_tag_at : t -> int -> string -> unit = "caml_binaryen_try_set_catch_tag_at" + (** expr, index, catchTag *) + + external append_catch_tag : t -> string -> int = "caml_binaryen_try_append_catch_tag" + (** expr, catchTag *) + + external insert_catch_tag_at : t -> int -> string -> unit = "caml_binaryen_try_insert_catch_tag_at" + (** expr, index, catchTag *) + + external remove_catch_tag_at : t -> int -> string = "caml_binaryen_try_remove_catch_tag_at" + (** expr, index *) + + external get_catch_body_at : t -> int -> t = "caml_binaryen_try_get_catch_body_at" + (** expr, index *) + + external set_catch_body_at : t -> int -> t -> unit = "caml_binaryen_try_set_catch_body_at" + (** expr, index, catchExpr *) + + external append_catch_body : t -> t -> int = "caml_binaryen_try_append_catch_body" + (** expr, catchExpr *) + + external insert_catch_body_at : t -> int -> t -> unit = "caml_binaryen_try_insert_catch_body_at" + (** expr, index, catchExpr *) + + external remove_catch_body_at : t -> int -> t = "caml_binaryen_try_remove_catch_body_at" + (** expr, index *) + + external has_catch_all : t -> bool = "caml_binaryen_try_has_catch_all" + (** expr *) + + external get_delegate_target : t -> string option = "caml_binaryen_try_get_delegate_target" + (** expr *) + + external set_delegate_target : t -> string -> unit = "caml_binaryen_try_set_delegate_target" + (** expr, delegateTarget *) + + external is_delegate : t -> bool = "caml_binaryen_try_is_delegate" + (** expr *) end module Try_Catch = struct let make module_ name body catch_tags catch_bodies = Try.make module_ name body catch_tags catch_bodies None + let get_name = Try.get_name + let set_name = Try.set_name + let get_body = Try.get_body + let set_body = Try.set_body + let get_num_catch_tags = Try.get_num_catch_tags + let get_num_catch_bodies = Try.get_num_catch_bodies + let get_catch_tag_at = Try.get_catch_tag_at + let set_catch_tag_at = Try.set_catch_tag_at + let append_catch_tag = Try.append_catch_tag + let insert_catch_tag_at = Try.insert_catch_tag_at + let remove_catch_tag_at = Try.remove_catch_tag_at + let get_catch_body_at = Try.get_catch_body_at + let set_catch_body_at = Try.set_catch_body_at + let append_catch_body = Try.append_catch_body + let insert_catch_body_at = Try.insert_catch_body_at + let remove_catch_body_at = Try.remove_catch_body_at + let has_catch_all = Try.has_catch_all + let get_delegate_target = Try.get_delegate_target + let set_delegate_target = Try.set_delegate_target + let is_delegate = Try.is_delegate end module Try_Delegate = struct let make module_ name body delegate = Try.make module_ name body [] [] (Some delegate) + let get_name = Try.get_name + let set_name = Try.set_name + let get_body = Try.get_body + let set_body = Try.set_body + let get_num_catch_tags = Try.get_num_catch_tags + let get_num_catch_bodies = Try.get_num_catch_bodies + let get_catch_tag_at = Try.get_catch_tag_at + let set_catch_tag_at = Try.set_catch_tag_at + let append_catch_tag = Try.append_catch_tag + let insert_catch_tag_at = Try.insert_catch_tag_at + let remove_catch_tag_at = Try.remove_catch_tag_at + let get_catch_body_at = Try.get_catch_body_at + let set_catch_body_at = Try.set_catch_body_at + let append_catch_body = Try.append_catch_body + let insert_catch_body_at = Try.insert_catch_body_at + let remove_catch_body_at = Try.remove_catch_body_at + let has_catch_all = Try.has_catch_all + let get_delegate_target = Try.get_delegate_target + let set_delegate_target = Try.set_delegate_target + let is_delegate = Try.is_delegate end module Throw = struct external make : Module.t -> string -> t list -> t = "caml_binaryen_throw" (** Module, tag, operands *) + + external get_tag : t -> string = "caml_binaryen_throw_get_tag" + (** expr *) + + external set_tag : t -> string -> unit = "caml_binaryen_throw_set_tag" + (** expr, tagName *) + + external get_num_operands : t -> int = "caml_binaryen_throw_get_num_operands" + (** expr *) + + external get_operand_at : t -> int -> t = "caml_binaryen_throw_get_operand_at" + (** expr, index *) + + external set_operand_at : t -> int -> t -> unit = "caml_binaryen_throw_set_operand_at" + (** expr, index, operandExpr *) + + external append_operand : t -> t -> int = "caml_binaryen_throw_append_operand" + (** expr, operandExpr *) + + external insert_operand_at : t -> int -> t -> unit = "caml_binaryen_throw_insert_operand_at" + (** expr, index, operandExpr *) + + external remove_operand_at : t -> int -> t = "caml_binaryen_throw_remove_operand_at" + (** expr, index *) end module Rethrow = struct external make : Module.t -> string -> t = "caml_binaryen_rethrow" (** Module, target *) + + external get_target : t -> string = "caml_binaryen_rethrow_get_target" + (** expr *) + + external set_target : t -> string -> unit = "caml_binaryen_rethrow_set_target" + (** expr, target *) end module Table = struct diff --git a/src/expression.mli b/src/expression.mli index d916345..4a23617 100644 --- a/src/expression.mli +++ b/src/expression.mli @@ -354,26 +354,234 @@ end module Try : sig val make : Module.t -> string option -> t -> string list -> t list -> string option -> t (** Module, name, body, catch tags, catch bodies, delegate target *) + val get_name : t -> string + (** expr *) + + val set_name : t -> string -> unit + (** expr, name *) + + val get_body : t -> t + (** expr *) + + val set_body : t -> t -> unit + (** expr, bodyExpr *) + + val get_num_catch_tags : t -> int + (** expr *) + + val get_num_catch_bodies : t -> int + (** expr *) + + val get_catch_tag_at : t -> int -> string + (** expr, index *) + + val set_catch_tag_at : t -> int -> string -> unit + (** expr, index, catchTag *) + + val append_catch_tag : t -> string -> int + (** expr, catchTag *) + + val insert_catch_tag_at : t -> int -> string -> unit + (** expr, index, catchTag *) + + val remove_catch_tag_at : t -> int -> string + (** expr, index *) + + val get_catch_body_at : t -> int -> t + (** expr, index *) + + val set_catch_body_at : t -> int -> t -> unit + (** expr, index, catchExpr *) + + val append_catch_body : t -> t -> int + (** expr, catchExpr *) + + val insert_catch_body_at : t -> int -> t -> unit + (** expr, index, catchExpr *) + + val remove_catch_body_at : t -> int -> t + (** expr, index *) + + val has_catch_all : t -> bool + (** expr *) + + val get_delegate_target : t -> string option + (** expr *) + + val set_delegate_target : t -> string -> unit + (** expr, delegateTarget *) + + val is_delegate : t -> bool + (** expr *) end module Try_Catch : sig val make : Module.t -> string option -> t -> string list -> t list -> t (** Module, name, body, catch tags, catch bodies *) + + val get_name : t -> string + (** expr *) + + val set_name : t -> string -> unit + (** expr, name *) + + val get_body : t -> t + (** expr *) + + val set_body : t -> t -> unit + (** expr, bodyExpr *) + + val get_num_catch_tags : t -> int + (** expr *) + + val get_num_catch_bodies : t -> int + (** expr *) + + val get_catch_tag_at : t -> int -> string + (** expr, index *) + + val set_catch_tag_at : t -> int -> string -> unit + (** expr, index, catchTag *) + + val append_catch_tag : t -> string -> int + (** expr, catchTag *) + + val insert_catch_tag_at : t -> int -> string -> unit + (** expr, index, catchTag *) + + val remove_catch_tag_at : t -> int -> string + (** expr, index *) + + val get_catch_body_at : t -> int -> t + (** expr, index *) + + val set_catch_body_at : t -> int -> t -> unit + (** expr, index, catchExpr *) + + val append_catch_body : t -> t -> int + (** expr, catchExpr *) + + val insert_catch_body_at : t -> int -> t -> unit + (** expr, index, catchExpr *) + + val remove_catch_body_at : t -> int -> t + (** expr, index *) + + val has_catch_all : t -> bool + (** expr *) + + val get_delegate_target : t -> string option + (** expr *) + + val set_delegate_target : t -> string -> unit + (** expr, delegateTarget *) + + val is_delegate : t -> bool + (** expr *) end module Try_Delegate : sig val make : Module.t -> string option -> t -> string -> t (** Module, name, body, delegate *) + + val get_name : t -> string + (** expr *) + + val set_name : t -> string -> unit + (** expr, name *) + + val get_body : t -> t + (** expr *) + + val set_body : t -> t -> unit + (** expr, bodyExpr *) + + val get_num_catch_tags : t -> int + (** expr *) + + val get_num_catch_bodies : t -> int + (** expr *) + + val get_catch_tag_at : t -> int -> string + (** expr, index *) + + val set_catch_tag_at : t -> int -> string -> unit + (** expr, index, catchTag *) + + val append_catch_tag : t -> string -> int + (** expr, catchTag *) + + val insert_catch_tag_at : t -> int -> string -> unit + (** expr, index, catchTag *) + + val remove_catch_tag_at : t -> int -> string + (** expr, index *) + + val get_catch_body_at : t -> int -> t + (** expr, index *) + + val set_catch_body_at : t -> int -> t -> unit + (** expr, index, catchExpr *) + + val append_catch_body : t -> t -> int + (** expr, catchExpr *) + + val insert_catch_body_at : t -> int -> t -> unit + (** expr, index, catchExpr *) + + val remove_catch_body_at : t -> int -> t + (** expr, index *) + + val has_catch_all : t -> bool + (** expr *) + + val get_delegate_target : t -> string option + (** expr *) + + val set_delegate_target : t -> string -> unit + (** expr, delegateTarget *) + + val is_delegate : t -> bool + (** expr *) end module Throw : sig val make : Module.t -> string -> t list -> t (** Module, tag, operands *) + val get_tag : t -> string + (** expr *) + + val set_tag : t -> string -> unit + (** expr, tagName *) + + val get_num_operands : t -> int + (** expr *) + + val get_operand_at : t -> int -> t + (** expr, index *) + + val set_operand_at : t -> int -> t -> unit + (** expr, index, operandExpr *) + + val append_operand : t -> t -> int + (** expr, operandExpr *) + + val insert_operand_at : t -> int -> t -> unit + (** expr, index, operandExpr *) + + val remove_operand_at : t -> int -> t + (** expr, index *) end module Rethrow : sig val make : Module.t -> string -> t (** Module, target *) + + val get_target : t -> string + (** expr *) + + val set_target : t -> string -> unit + (** expr, target *) end module Table : sig