update codegen to latest binaryen

wasm/emit_wat.ml

@@ -84,24 +84,21 @@ module Conv = struct
     let function_call_handling handler ~tail call : Expr.t =
       if tail then call
       else
-        match mode with
-        | Reference -> failwith "TODO reference call"
-        | Binarien ->
-          let var = Local.fresh "call_result" in
-          let body : Expr.t =
-            If_then_else
-              { cond = Unop (Tuple_extract 0, Var (V var))
-              ; if_expr =
-                  NR (raise handler (Unop (Tuple_extract 1, Var (V var))))
-              ; else_expr = Unop (Tuple_extract 1, Var (V var))
-              }
-          in
-          Let
-            { var
-            ; typ = Type.Tuple [ I32; ref_eq ]
-            ; defining_expr = call
-            ; body
+        let var = Local.fresh "call_result" in
+        let body : Expr.t =
+          If_then_else
+            { cond = Unop (Tuple_extract 0, Var (V var))
+            ; if_expr =
+                NR (raise handler (Unop (Tuple_extract 1, Var (V var))))
+            ; else_expr = Unop (Tuple_extract 1, Var (V var))
             }
+        in
+        Let
+          { var
+          ; typ = Type.Tuple [ I32; ref_eq ]
+          ; defining_expr = call
+          ; body
+          }
   end
 
   let exceptions_module =
@@ -2169,6 +2166,7 @@ module ToWasm = struct
           C.block cont result_types [ C.br fallthrough [ conv_expr_group body ] ]
         in
         let handler_expr = conv_expr handler in
+        (*
         match mode with
         | Reference ->
           let handler =
@@ -2182,29 +2180,30 @@ module ToWasm = struct
           in
           [ C.block fallthrough [ ref_eq ] (body :: handler) ]
         | Binarien ->
-          let set_locals =
-            match params with
-            | [] -> [ body ]
-            | [ (None, _typ) ] -> [ C.drop body ]
-            | [ (Some var, _typ) ] -> [ C.local_set (Expr.Local.V var) body ]
-            | _ ->
-              let local_tuple = Expr.Local.Block_result cont in
-              let _i, assigns =
-                List.fold_left
-                  (fun (i, assigns) (var, _typ) ->
-                      match var with
-                      | Some var ->
-                        let project =
-                          C.tuple_extract i (C.local_get (Expr.Local.V local_tuple))
-                        in
-                        let expr = C.local_set (Expr.Local.V var) project in
-                        (i + 1, expr :: assigns)
-                      | None -> (i + 1, assigns) )
-                  (0, []) params
-              in
-              [ C.local_set (Expr.Local.V local_tuple) body ] @ assigns
-          in
-          [ C.block fallthrough [ ref_eq ] (set_locals @ handler_expr) ]
+            *)
+        let set_locals =
+          match params with
+          | [] -> [ body ]
+          | [ (None, _typ) ] -> [ C.drop body ]
+          | [ (Some var, _typ) ] -> [ C.local_set (Expr.Local.V var) body ]
+          | _ ->
+            let local_tuple = Expr.Local.Block_result cont in
+            let _i, assigns =
+              List.fold_left
+                (fun (i, assigns) (var, _typ) ->
+                    match var with
+                    | Some var ->
+                      let project =
+                        C.tuple_extract i (C.local_get (Expr.Local.V local_tuple))
+                      in
+                      let expr = C.local_set (Expr.Local.V var) project in
+                      (i + 1, expr :: assigns)
+                    | None -> (i + 1, assigns) )
+                (0, []) params
+            in
+            [ C.local_set (Expr.Local.V local_tuple) body ] @ assigns
+        in
+        [ C.block fallthrough [ ref_eq ] (set_locals @ handler_expr) ]
       end
     | Br_on_cast { value; typ; if_cast; if_else } ->
       [ C.drop (C.br_on_cast if_cast typ (conv_expr_group value)) ]
@@ -2213,16 +2212,10 @@ module ToWasm = struct
       [ C.br_if if_true (conv_expr_group cond) ] @ conv_expr if_else
     | Br_table { cond; cases; default } ->
       [ C.br_table (conv_expr_group cond) (cases @ [ default ]) ]
-    | Try { body; handler; result_typ; param = local, typ } -> begin
-        match mode with
-        | Reference ->
-          Format.eprintf "Warning exception not supported@.";
-          conv_expr body
-        | Binarien ->
-          let body = conv_expr body in
-          let handler = C.local_set (V local) (C.pop typ) :: conv_expr handler in
-          [ C.try_ ~result_typ ~body ~handler ~typ ]
-      end
+    | Try { body; handler; result_typ; param = local, typ } ->
+      let body = conv_expr body in
+      let handler = C.local_set (V local) (C.pop typ) :: conv_expr handler in
+      [ C.try_ ~result_typ ~body ~handler ~typ ]
     | Unit e -> conv_no_value e @ [ unit ]
     | NR nr -> conv_no_return nr
 
@@ -2289,11 +2282,7 @@ module ToWasm = struct
     | NR_br { cont; args } ->
       [ C.br cont [ C.br cont (List.map conv_expr_group args) ] ]
     | NR_return args -> [ C.return (List.map conv_expr_group args) ]
-    | Throw e -> begin
-        match mode with
-        | Reference -> [ C.unreachable ]
-        | Binarien -> [ C.throw (conv_expr_group e) ]
-      end
+    | Throw e -> [ C.throw (conv_expr_group e) ]
     | Unreachable -> [ C.unreachable ]
 
   let conv_const name export (const : Const.t) =

wasm/wat.ml

@@ -1,4 +1,3 @@
-open Wstate
 open Wident
 module Expr = Wexpr
 module Type = Wtype
@@ -166,19 +165,11 @@ module C = struct
   let reft name = node "ref" [ type_name name ]
 
   let struct_new_canon typ fields =
-    let name =
-      match mode with
-      | Binarien -> "struct.new"
-      | Reference -> "struct.new_canon"
-    in
-    node name (type_name typ :: fields)
+    node "struct.new" (type_name typ :: fields)
 
   let array_new_canon_fixed typ size args =
-    match mode with
-    | Binarien -> node "array.init_static" ([ type_name typ ] @ args)
-    | Reference ->
-      node "array.new_canon_fixed"
-        ([ type_name typ; Int (Int64.of_int size) ] @ args)
+    node "array.new_fixed"
+      ([ type_name typ; Int (Int64.of_int size) ] @ args)
 
   let int i =
     (* XXX TODO remove this is wrong,
@@ -288,19 +279,10 @@ module C = struct
   let field f = node "field" [ node "mut" [ type_atom f ] ]
 
   let struct_type ~sub fields =
-    match mode with
-    | Reference -> begin
-        let descr = node "struct" (List.map field fields) in
-        match sub with
-        | None -> descr
-        | Some name -> node "sub" [ type_name name; descr ]
-      end
-    | Binarien -> begin
-        match sub with
-        | None -> node "struct" (List.map field fields)
-        | Some name ->
-          node "struct_subtype" (List.map field fields @ [ type_name name ])
-      end
+    let descr = node "struct" (List.map field fields) in
+    match sub with
+    | None -> descr
+    | Some name -> node "sub" [ type_name name; descr ]
 
   let array_type f = node "array" [ node "mut" [ type_atom f ] ]
 
@@ -317,13 +299,6 @@ module C = struct
     node "func" (name @ typ @ List.map param_t params @ res)
 
   let if_then_else typ cond if_expr else_expr =
-    let nopise e =
-      match mode with
-      | Reference -> e
-      | Binarien -> ( match e with [] -> [ node_p "nop" [] ] | _ -> e )
-    in
-    let if_expr = nopise if_expr in
-    let else_expr = nopise else_expr in
     node "if"
       [ results typ; cond; node_p "then" if_expr; node_p "else" else_expr ]
 
@@ -336,29 +311,15 @@ module C = struct
     nodehv "loop" [ !$(Block_id.name id); results result ] body
 
   let br id args =
-    match (mode, args) with
-    | Binarien, _ :: _ :: _ ->
-      node "br" [ !$(Block_id.name id); node "tuple.make" args ]
-    | _ -> node "br" ([ !$(Block_id.name id) ] @ args)
+    node "br" ([ !$(Block_id.name id) ] @ args)
 
   let br' id = node "br" [ !$(Block_id.name id) ]
 
   let return args =
-    match (mode, args) with
-    | Binarien, _ :: _ :: _ -> node "return" [ node "tuple.make" args ]
-    | _ -> node "return" args
+    node "return" args
 
   let br_on_cast id typ arg =
-    match mode with
-    | Binarien -> begin
-        match typ with
-        | Type.Var.I31 ->
-          node "drop" [ node "br_on_i31" [ !$(Block_id.name id); arg ] ]
-        | _ ->
-          node "br_on_cast_static" [ !$(Block_id.name id); type_name typ; arg ]
-      end
-    | Reference ->
-      node "br_on_cast" [ !$(Block_id.name id); type_name typ; arg ]
+    node "br_on_cast" [ !$(Block_id.name id); type_name typ; arg ]
 
   let br_if id cond = node "br_if" [ !$(Block_id.name id); cond ]
 
@@ -383,14 +344,10 @@ module C = struct
       ]
 
   let sub name descr =
-    match mode with
-    | Binarien -> descr
-    | Reference -> node "sub" [ type_name name; descr ]
+    node "sub" [ type_name name; descr ]
 
   let opt_tuple fields =
-    match mode with
-    | Binarien -> [ node "tuple.make" fields ]
-    | Reference -> fields
+    fields
 
   let tuple_make fields = node "tuple.make" fields
 
@@ -407,7 +364,7 @@ module C = struct
       (node "tag" [ !$"exc"; node "param" [ node "ref" [ atom "eq" ] ] ])
 
   let module_ m =
-    let m = match mode with Reference -> m | Binarien -> import_tag :: m in
+    let m = import_tag :: m in
     nodev "module" m
 
   let register name = node "register" [ String (module_name name) ]

wasm/wexpr.ml

@@ -1,4 +1,3 @@
-open Wstate
 module Type = Wtype
 open Wident
 module Local = Wident.Local
@@ -499,8 +498,8 @@ let required_locals body =
         acc params
     in
     let acc =
-      match (mode, params) with
-      | Binarien, _ :: _ :: _ ->
+      match ( params) with
+      | _ :: _ :: _ ->
         let var = Local.Block_result cont in
         add var (Type.Tuple (List.map snd params)) acc
       | _ -> acc

wasm/wstate.ml

@@ -6,13 +6,6 @@ type block_repr =
   | Struct_block
   | Array_block
 
-type mode =
-  | Reference
-  | Binarien
-
-let mode = Binarien
-(* let mode = Reference *)
-
 let block_repr = Array_block
 (* let block_repr = Struct_block *)