@grain/binaryen.ml 0.34.0 → 0.36.0

binaryen-archive/src/type_builder.ml

@@ -0,0 +1,67 @@
+type t
+
+type struct_field = {
+  type_ : Type.t;
+  packed_type : Packed_type.t;
+  mutable_ : bool;
+}
+
+(* Source: https://github.com/WebAssembly/binaryen/blob/64ba23996a10e229d46e41eb37736a55af87f79a/src/binaryen-c.h#L3618 *)
+type error =
+  | SelfSupertype of int
+  | InvalidSupertype of int
+  | ForwardSupertypeReference of int
+  | ForwardChildReference of int
+
+external make : int -> t = "caml_type_builder_create"
+external grow : t -> int -> unit = "caml_type_builder_grow"
+external size : t -> int = "caml_type_builder_get_size"
+
+external set_signature_type : t -> int -> Type.t -> Type.t -> unit
+  = "caml_type_builder_set_signature_type"
+
+external set_struct_type :
+  t -> int -> Type.t list -> Packed_type.t list -> bool list -> int -> unit
+  = "caml_type_builder_set_struct_type__bytecode"
+    "caml_type_builder_set_struct_type"
+
+let set_struct_type builder index fields =
+  let split_fields fields =
+    List.fold_right
+      (fun { type_; packed_type; mutable_ } (types, packed_types, mutables) ->
+        (type_ :: types, packed_type :: packed_types, mutable_ :: mutables))
+      fields ([], [], [])
+  in
+  let types, packed_types, mutables = split_fields fields in
+  set_struct_type builder index types packed_types mutables (List.length types)
+
+external set_array_type : t -> int -> Type.t -> Packed_type.t -> bool -> unit
+  = "caml_type_builder_set_array_type"
+
+external get_temp_heap_type : t -> int -> Heap_type.t
+  = "caml_type_builder_get_temp_heap_type"
+
+external get_temp_tuple_type : t -> Type.t list -> Type.t
+  = "caml_type_builder_get_temp_tuple_type"
+
+external get_temp_ref_type : t -> Heap_type.t -> bool -> Type.t
+  = "caml_type_builder_get_temp_ref_type"
+
+external set_sub_type : t -> int -> Heap_type.t -> unit
+  = "caml_type_builder_set_sub_type"
+
+external set_open : t -> int -> unit = "caml_type_builder_set_open"
+
+external create_rec_group : t -> int -> int -> unit
+  = "caml_type_builder_create_rec_group"
+
+external build_and_dispose : t -> (Heap_type.t array, int * int) result
+  = "caml_type_builder_build_and_dispose"
+
+let build_and_dispose builder =
+  match build_and_dispose builder with
+  | Ok types -> Ok (Array.to_list types)
+  | Error (idx, 0) -> Error (SelfSupertype idx)
+  | Error (idx, 1) -> Error (InvalidSupertype idx)
+  | Error (idx, 2) -> Error (ForwardSupertypeReference idx)
+  | Error (idx, _) -> Error (ForwardChildReference idx)

binaryen-archive/src/type_builder.mli

@@ -0,0 +1,28 @@
+type t
+
+type struct_field = {
+  type_ : Type.t;
+  packed_type : Packed_type.t;
+  mutable_ : bool;
+}
+
+(* Source: https://github.com/WebAssembly/binaryen/blob/64ba23996a10e229d46e41eb37736a55af87f79a/src/binaryen-c.h#L3618 *)
+type error =
+  | SelfSupertype of int
+  | InvalidSupertype of int
+  | ForwardSupertypeReference of int
+  | ForwardChildReference of int
+
+val make : int -> t
+val grow : t -> int -> unit
+val size : t -> int
+val set_signature_type : t -> int -> Type.t -> Type.t -> unit
+val set_struct_type : t -> int -> struct_field list -> unit
+val set_array_type : t -> int -> Type.t -> Packed_type.t -> bool -> unit
+val get_temp_heap_type : t -> int -> Heap_type.t
+val get_temp_tuple_type : t -> Type.t list -> Type.t
+val get_temp_ref_type : t -> Heap_type.t -> bool -> Type.t
+val set_sub_type : t -> int -> Heap_type.t -> unit
+val set_open : t -> int -> unit
+val create_rec_group : t -> int -> int -> unit
+val build_and_dispose : t -> (Heap_type.t list, error) result

binaryen-archive/test/test.expected

@@ -7,11 +7,16 @@
  (i32.const 0)
 )
 (module
- (type $0 (func (param i32 i32) (result i32)))
- (type $1 (func))
- (type $2 (func (param anyref i32 i32) (result i32)))
- (type $3 (func (param anyref) (result i32)))
- (import "future-wasi" "write" (func $write (type $2) (param anyref i32 i32) (result i32)))
+ (type $List (struct (field $head i31ref) (field $tail (ref null $List))))
+ (type $1 (array (mut i8)))
+ (type $2 (func (param i32)))
+ (type $3 (func (param i32 i32) (result i32)))
+ (type $4 (func))
+ (type $5 (func (param anyref i32 i32) (result i32)))
+ (type $6 (func (param anyref) (result i32)))
+ (type $7 (func (param anyref) (result anyref anyref)))
+ (type $8 (func (result (ref $1) (ref $List))))
+ (import "future-wasi" "write" (func $write (type $5) (param anyref i32 i32) (result i32)))
  (global $max_int64 i64 (i64.const 9223372036854775807))
  (global $max_int64_mut (mut i64) (i64.const 9223372036854775807))
  (global $test_float64_bits f64 (f64.const 1.23))
@@ -20,11 +25,15 @@
  (data $world "world")
  (table $table 1 1 funcref)
  (elem $elem (i32.const 0) $adder)
+ (tag $foo (type $2) (param i32))
+ (tag $bar (type $2) (param i32))
  (export "adder" (func $adder))
  (export "memory" (memory $0))
  (export "hello" (func $hello))
+ (export "try" (func $try))
+ (export "gc" (func $gc))
  (start $start)
- (func $adder (type $0) (param $0 i32) (param $1 i32) (result i32)
+ (func $adder (type $3) (param $0 i32) (param $1 i32) (result i32)
   (block $add (result i32)
    (if
     (i32.const 0)
@@ -44,7 +53,7 @@
    )
   )
  )
- (func $start (type $1)
+ (func $start (type $4)
   (block $start
    (memory.init $world
     (i32.const 2048)
@@ -52,7 +61,7 @@
     (i32.const 5)
    )
    (drop
-    (call_indirect $table (type $0)
+    (call_indirect $table (type $3)
      (i32.const 3)
      (i32.const 5)
      (i32.const 0)
@@ -60,30 +69,151 @@
    )
   )
  )
- (func $hello (type $3) (param $0 anyref) (result i32)
+ (func $hello (type $6) (param $0 anyref) (result i32)
   (call $write
    (local.get $0)
    (i32.const 0)
    (i32.const 1)
   )
  )
+ (func $try (type $4)
+  (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)
+      )
+     )
+    )
+   )
+   (try $tc2
+    (do
+     (throw $foo
+      (i32.const 1)
+     )
+    )
+    (catch $foo
+     (block $tc2blk2
+      (drop
+       (pop i32)
+      )
+     )
+    )
+    (catch $bar
+     (block $tc2blk3
+      (drop
+       (pop i32)
+      )
+     )
+    )
+   )
+   (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)
+     )
+    )
+   )
+  )
+ )
+ (func $gc (type $7) (param $0 anyref) (result anyref anyref)
+  (local $1 (ref $1))
+  (local $2 (ref $List))
+  (block $gc_block (type $8) (result (ref $1) (ref $List))
+   (local.set $1
+    (array.new_fixed $1 2
+     (i32.const 0)
+     (i32.const 255)
+    )
+   )
+   (array.set $1
+    (local.get $1)
+    (i32.const 1)
+    (i32.const 42)
+   )
+   (local.set $2
+    (struct.new $List
+     (ref.cast i31ref
+      (local.get $0)
+     )
+     (struct.new $List
+      (ref.i31
+       (i32.const 1)
+      )
+      (struct.new $List
+       (ref.i31
+        (i32.const 2)
+       )
+       (struct.new $List
+        (ref.i31
+         (i32.const 3)
+        )
+        (ref.null none)
+       )
+      )
+     )
+    )
+   )
+   (tuple.make 2
+    (local.get $1)
+    (local.get $2)
+   )
+  )
+ )
 )
 (module
- (type $0 (func (param i32 i32) (result i32)))
- (type $1 (func))
- (type $2 (func (param anyref i32 i32) (result i32)))
- (type $3 (func (param anyref) (result i32)))
- (import "future-wasi" "write" (func $write (type $2) (param anyref i32 i32) (result i32)))
+ (type $List (struct (field $head i31ref) (field $tail (ref null $List))))
+ (type $1 (array (mut i8)))
+ (type $2 (func (param i32)))
+ (type $3 (func))
+ (type $4 (func (param i32 i32) (result i32)))
+ (type $5 (func (param anyref i32 i32) (result i32)))
+ (type $6 (func (param anyref) (result i32)))
+ (type $7 (func (param anyref) (result anyref anyref)))
+ (type $8 (func (result (ref (exact $1)) (ref (exact $List)))))
+ (import "future-wasi" "write" (func $write (type $5) (param anyref i32 i32) (result i32)))
  (memory $0 1)
  (data $hello (i32.const 0) "hello")
  (data $world "world")
  (table $table 1 1 funcref)
  (elem $elem (i32.const 0) $adder)
+ (tag $foo (type $2) (param i32))
+ (tag $bar (type $2) (param i32))
  (export "adder" (func $adder))
  (export "memory" (memory $0))
  (export "hello" (func $hello))
+ (export "try" (func $try))
+ (export "gc" (func $gc))
  (start $start)
- (func $adder (type $0) (param $0 i32) (param $1 i32) (result i32)
+ (func $adder (type $4) (param $0 i32) (param $1 i32) (result i32)
   (i32.add
    (select
     (local.get $0)
@@ -95,7 +225,7 @@
    (local.get $1)
   )
  )
- (func $start (type $1)
+ (func $start (type $3)
   (memory.init $world
    (i32.const 2048)
    (i32.const 0)
@@ -108,20 +238,101 @@
    )
   )
  )
- (func $hello (type $3) (param $0 anyref) (result i32)
+ (func $hello (type $6) (param $0 anyref) (result i32)
   (call $write
    (local.get $0)
    (i32.const 0)
    (i32.const 1)
   )
  )
+ (func $try (type $3)
+  (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)
+    )
+   )
+  )
+  (try
+   (do
+    (throw $foo
+     (i32.const 1)
+    )
+   )
+   (catch $foo
+    (drop
+     (pop i32)
+    )
+   )
+   (catch $bar
+    (drop
+     (pop i32)
+    )
+   )
+  )
+ )
+ (func $gc (type $7) (param $0 anyref) (result anyref anyref)
+  (local $1 (ref (exact $1)))
+  (array.set $1
+   (local.tee $1
+    (array.new_fixed $1 2
+     (i32.const 0)
+     (i32.const 255)
+    )
+   )
+   (i32.const 1)
+   (i32.const 42)
+  )
+  (tuple.make 2
+   (local.get $1)
+   (struct.new $List
+    (ref.cast i31ref
+     (local.get $0)
+    )
+    (struct.new $List
+     (ref.i31
+      (i32.const 1)
+     )
+     (struct.new $List
+      (ref.i31
+       (i32.const 2)
+      )
+      (struct.new $List
+       (ref.i31
+        (i32.const 3)
+       )
+       (ref.null none)
+      )
+     )
+    )
+   )
+  )
+ )
 )
 (module
- (type $type (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)))
- (import "future-wasi" "write" (func $fimport$0 (type $type) (param anyref i32 i32) (result i32)))
+ (type $type_7 (struct (field i31ref) (field (ref null $type_7))))
+ (type $type_6 (array (mut i8)))
+ (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)))
+ (type $type_5 (func (param anyref) (result anyref anyref)))
+ (type $type_8 (func (result anyref anyref)))
+ (import "future-wasi" "write" (func $fimport$0 (type $type_1) (param anyref i32 i32) (result i32)))
  (memory $0 1)
  (data $0 (i32.const 0) "hello")
  (data $1 "world")
@@ -130,8 +341,10 @@
  (export "adder" (func $0))
  (export "memory" (memory $0))
  (export "hello" (func $2))
+ (export "try" (func $3))
+ (export "gc" (func $4))
  (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)
@@ -143,7 +356,7 @@
    (local.get $1)
   )
  )
- (func $1 (type $type_2)
+ (func $1 (type $type_3)
   (memory.init $1
    (i32.const 2048)
    (i32.const 0)
@@ -156,20 +369,67 @@
    )
   )
  )
- (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
+   (unreachable)
+  )
+  (unreachable)
+ )
+ (func $4 (type $type_5) (param $0 anyref) (result anyref anyref)
+  (local $1 (ref (exact $type_6)))
+  (array.set $type_6
+   (local.tee $1
+    (array.new_fixed $type_6 2
+     (i32.const 0)
+     (i32.const 255)
+    )
+   )
+   (i32.const 1)
+   (i32.const 42)
+  )
+  (tuple.make 2
+   (local.get $1)
+   (struct.new $type_7
+    (ref.cast i31ref
+     (local.get $0)
+    )
+    (struct.new $type_7
+     (ref.i31
+      (i32.const 1)
+     )
+     (struct.new $type_7
+      (ref.i31
+       (i32.const 2)
+      )
+      (struct.new $type_7
+       (ref.i31
+        (i32.const 3)
+       )
+       (ref.null none)
+      )
+     )
+    )
+   )
+  )
+ )
 )
 (module
- (type $type (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)))
- (import "future-wasi" "write" (func $fimport$0 (type $type) (param anyref i32 i32) (result i32)))
+ (type $type_7 (struct (field i31ref) (field (ref null $type_7))))
+ (type $type_6 (array (mut i8)))
+ (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)))
+ (type $type_5 (func (param anyref) (result anyref anyref)))
+ (type $type_8 (func (result anyref anyref)))
+ (import "future-wasi" "write" (func $fimport$0 (type $type_1) (param anyref i32 i32) (result i32)))
  (memory $0 1)
  (data $0 (i32.const 0) "hello")
  (data $1 "world")
@@ -178,8 +438,10 @@
  (export "adder" (func $0))
  (export "memory" (memory $0))
  (export "hello" (func $2))
+ (export "try" (func $3))
+ (export "gc" (func $4))
  (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
@@ -188,7 +450,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
@@ -198,10 +460,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)
+  unreachable
+ )
+ (func $4 (type $type_5) (param $0 anyref) (result anyref anyref)
+  (local $1 (ref (exact $type_6)))
+  i32.const 0
+  i32.const 255
+  array.new_fixed $type_6 2
+  local.tee $1
+  i32.const 1
+  i32.const 42
+  array.set $type_6
+  local.get $1
+  local.get $0
+  ref.cast i31ref
+  i32.const 1
+  ref.i31
+  i32.const 2
+  ref.i31
+  i32.const 3
+  ref.i31
+  ref.null none
+  struct.new $type_7
+  struct.new $type_7
+  struct.new $type_7
+  struct.new $type_7
+  tuple.make 2
+ )
 )