Tuple extract arity

OCamlPro · Oct 7, 2024 · f7a76ba · f7a76ba
1 parent ec3b90b
commit f7a76ba
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 8 deletions.
diff --git a/wasm/emit_wat.ml b/wasm/emit_wat.ml
@@ -87,10 +87,10 @@ module Conv = struct
         let var = Local.fresh "call_result" in
         let body : Expr.t =
           If_then_else
-            { cond = Unop (Tuple_extract 0, Var (V var))
+            { cond = Unop (Tuple_extract { arity = 2; field = 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))
+                NR (raise handler (Unop (Tuple_extract { arity = 2; field = 1 }, Var (V var))))
+            ; else_expr = Unop (Tuple_extract { arity = 2; field = 1 }, Var (V var))
             }
         in
         Let
@@ -2083,7 +2083,8 @@ module ToWasm = struct
       Cst.node name [ arg ]
     | Abs_float -> Cst.node "f64.abs" [ arg ]
     | Neg_float -> Cst.node "f64.neg" [ arg ]
-    | Tuple_extract i -> C.tuple_extract i arg
+    | Tuple_extract { arity; field } ->
+        C.tuple_extract ~arity ~field arg
 
   let irelop_name nn (op : Expr.irelop) =
     match op with
@@ -2187,14 +2188,15 @@ module ToWasm = struct
           | [ (None, _typ) ] -> [ C.drop body ]
           | [ (Some var, _typ) ] -> [ C.local_set (Expr.Local.V var) body ]
           | _ ->
+            let arity = List.length params in
             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))
+                        C.tuple_extract ~arity ~field: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)

diff --git a/wasm/wat.ml b/wasm/wat.ml
@@ -356,7 +356,7 @@ module C = struct
   let opt_tuple fields =
     [ tuple_make fields ]
 
-  let tuple_extract field tuple = node "tuple.extract" [ int field; tuple ]
+  let tuple_extract ~arity ~field tuple = node "tuple.extract" [ int arity; int field; tuple ]
 
   let rec_ l = node "rec" l
 

diff --git a/wasm/wexpr.ml b/wasm/wexpr.ml
@@ -102,7 +102,7 @@ type unop =
       }
   | Abs_float
   | Neg_float
-  | Tuple_extract of int
+  | Tuple_extract of { field : int; arity : int }
 
 (* Every expression returns exactly one value *)
 type t =
@@ -345,7 +345,8 @@ let print_unop ppf = function
       print_sign sign
   | Abs_float -> Format.fprintf ppf "Abs_float"
   | Neg_float -> Format.fprintf ppf "Neg_float"
-  | Tuple_extract i -> Format.fprintf ppf "Tuple_extract.%i" i
+  | Tuple_extract { arity = _; field = i } ->
+      Format.fprintf ppf "Tuple_extract.%i" i
 
 let rec print ppf = function
   | Var l -> Local.print ppf l