From 3045a5ed2372d06200a2b91ac328648e9f72cda6 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Tue, 3 Sep 2024 15:33:49 +0200
Subject: [PATCH] WSOO side of "Distinguish float field accesses in the Code
 IR"

See ocsigen/js_of_ocaml#1649
---
 compiler/lib/wasm/wa_generate.ml  | 17 +++++++++++++++--
 compiler/lib/wasm/wa_globalize.ml |  4 ++--
 compiler/lib/wasm/wa_liveness.ml  |  4 ++--
 compiler/lib/wasm/wa_spilling.ml  |  4 ++--
 4 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml
index 87a18b578..b7c2cd8ab 100644
--- a/compiler/lib/wasm/wa_generate.ml
+++ b/compiler/lib/wasm/wa_generate.ml
@@ -156,7 +156,11 @@ module Generate (Target : Wa_target_sig.S) = struct
         return (W.Call (apply, args @ [ closure ]))
     | Block (tag, a, _, _) ->
         Memory.allocate stack_ctx x ~tag (List.map ~f:(fun x -> `Var x) (Array.to_list a))
-    | Field (x, n) -> Memory.field (load x) n
+    | Field (x, n, Non_float) -> Memory.field (load x) n
+    | Field (x, n, Float) ->
+        Memory.float_array_get
+          (load x)
+          (Constant.translate (Int (Int31.of_int_warning_on_overflow n)))
     | Closure _ ->
         Closure.translate
           ~context:ctx.global_context
@@ -667,7 +671,16 @@ module Generate (Target : Wa_target_sig.S) = struct
           if ctx.live.(Var.idx x) = 0
           then drop (translate_expr ctx stack_ctx context x e)
           else store x (translate_expr ctx stack_ctx context x e)
-      | Set_field (x, n, y) -> Memory.set_field (load x) n (load y)
+      | Set_field (x, n, Non_float, y) ->
+          Memory.set_field
+            (load x)
+            n
+            (load y)
+      | Set_field (x, n, Float, y) ->
+          Memory.float_array_set
+            (load x)
+            (Constant.translate (Int (Int31.of_int_warning_on_overflow n)))
+            (load y)
       | Offset_ref (x, n) ->
           Memory.set_field
             (load x)
diff --git a/compiler/lib/wasm/wa_globalize.ml b/compiler/lib/wasm/wa_globalize.ml
index deaed96b3..5c2cc2d47 100644
--- a/compiler/lib/wasm/wa_globalize.ml
+++ b/compiler/lib/wasm/wa_globalize.ml
@@ -74,7 +74,7 @@ let traverse_expression x e st =
   | Code.Apply { f; args; _ } ->
       st |> use f |> fun st -> List.fold_left ~f:(fun st x -> use x st) ~init:st args
   | Block (_, a, _, _) -> Array.fold_right ~f:use a ~init:st
-  | Field (x, _) -> st |> use x
+  | Field (x, _, _) -> st |> use x
   | Closure _ ->
       List.fold_left
         ~f:(fun st x -> use x st)
@@ -95,7 +95,7 @@ let traverse_instruction st i =
   match fst i with
   | Code.Let (x, e) -> st |> declare x |> traverse_expression x e
   | Assign (_, x) | Offset_ref (x, _) -> st |> use x
-  | Set_field (x, _, y) -> st |> use x |> use y
+  | Set_field (x, _, _, y) -> st |> use x |> use y
   | Array_set (x, y, z) -> st |> use x |> use y |> use z
 
 let traverse_block p st pc =
diff --git a/compiler/lib/wasm/wa_liveness.ml b/compiler/lib/wasm/wa_liveness.ml
index 4a2dd9084..59c528411 100644
--- a/compiler/lib/wasm/wa_liveness.ml
+++ b/compiler/lib/wasm/wa_liveness.ml
@@ -109,12 +109,12 @@ let expr_used ~context ~closures ~ctx x e s =
   | Prim (_, l) -> add_prim_args ~ctx s l
   | Closure _ -> add_list ~ctx s (function_free_variables ~context ~closures x)
   | Constant _ | Special _ -> s
-  | Field (x, _) -> add_var ~ctx s x
+  | Field (x, _, _) -> add_var ~ctx s x
 
 let propagate_through_instr ~context ~closures ~ctx (i, _) s =
   match i with
   | Let (x, e) -> expr_used ~context ~closures ~ctx x e (Var.Set.remove x s)
-  | Set_field (x, _, y) -> add_var ~ctx (add_var ~ctx s x) y
+  | Set_field (x, _, _, y) -> add_var ~ctx (add_var ~ctx s x) y
   | Assign (_, x) | Offset_ref (x, _) -> add_var ~ctx s x
   | Array_set (x, y, z) -> add_var ~ctx (add_var ~ctx (add_var ~ctx s x) y) z
 
diff --git a/compiler/lib/wasm/wa_spilling.ml b/compiler/lib/wasm/wa_spilling.ml
index 2d1051c7b..f1eaa1b80 100644
--- a/compiler/lib/wasm/wa_spilling.ml
+++ b/compiler/lib/wasm/wa_spilling.ml
@@ -309,10 +309,10 @@ let spilled_variables
                         fv
                         ~init:Var.Set.empty
                   | Constant _ | Special _ -> Var.Set.empty
-                  | Field (x, _) -> check_spilled ~ctx loaded x Var.Set.empty)
+                  | Field (x, _, _) -> check_spilled ~ctx loaded x Var.Set.empty)
               | Assign (_, x) | Offset_ref (x, _) ->
                   check_spilled ~ctx loaded x Var.Set.empty
-              | Set_field (x, _, y) ->
+              | Set_field (x, _, _, y) ->
                   Var.Set.empty
                   |> check_spilled ~ctx loaded x
                   |> check_spilled ~ctx loaded y