Fixes

ocaml-wasm · Sep 20, 2024 · d7de3b6 · d7de3b6
1 parent 989a1d6
commit d7de3b6
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 19 deletions.
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
@@ -38,8 +38,7 @@ let int_binop l w f =
 
 let shift l w t f =
   match l with
-  | [ Int i; Int j ] ->
-      Some (Int (w (f (t i) (Int32.to_int j land 0x1f))))
+  | [ Int i; Int j ] -> Some (Int (w (f (t i) (Int32.to_int j land 0x1f))))
   | _ -> None
 
 let float_binop_aux (l : constant list) (f : float -> float -> 'a) : 'a option =
@@ -159,8 +158,8 @@ let eval_prim ~target x =
           Some
             (Int
                (match target with
-                | `JavaScript -> 32l
-                | `Wasm -> 31l ))
+               | `JavaScript -> 32l
+               | `Wasm -> 31l))
       | "caml_sys_const_big_endian", [ _ ] -> Some (Int 0l)
       | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int 0l)
       | _ -> None)
@@ -351,7 +350,7 @@ let eval_instr ~target info ((x, loc) as i) =
                 , Prim
                     ( prim
                     , List.map2 prim_args prim_args' ~f:(fun arg c ->
-                          match (c : constant), target with
+                          match (c : constant option), target with
                           | Some ((Int _ | NativeString _) as c), _ -> Pc c
                           | Some (Float _ as c), `JavaScript -> Pc c
                           | Some (String _ as c), `JavaScript
@@ -373,9 +372,9 @@ let the_cond_of info x =
   get_approx
     info
     (fun x ->
-      match Flow.Info.def info x with
-      | Some (Constant (Int 0l)) -> Zero
-      | Some
+      match info.info_defs.(Var.idx x) with
+      | Expr (Constant (Int 0l)) -> Zero
+      | Expr
           (Constant
             ( Int _
             | Int32 _

diff --git a/compiler/lib/generate_closure.ml b/compiler/lib/generate_closure.ml
@@ -105,9 +105,7 @@ module Trampoline = struct
         let counter_plus_1 = Code.Var.fork counter in
         { params = []
         ; body =
-            [ ( Let
-                  ( counter_plus_1
-                  , Prim (Extern "%int_add", [ Pv counter; Pc (Int 1l) ]) )
+            [ ( Let (counter_plus_1, Prim (Extern "%int_add", [ Pv counter; Pc (Int 1l) ]))
               , noloc )
             ; Let (return, Apply { f; args = counter_plus_1 :: args; exact = true }), loc
             ]
@@ -121,9 +119,8 @@ module Trampoline = struct
     ; body =
         [ ( Let
               ( new_args
-              , Prim
-                  ( Extern "%js_array"
-                  , Pc (Int 0l) :: List.map args ~f:(fun x -> Pv x) ) )
+              , Prim (Extern "%js_array", Pc (Int 0l) :: List.map args ~f:(fun x -> Pv x))
+              )
           , noloc )
         ; Let (return, Prim (Extern "caml_trampoline_return", [ Pv f; Pv new_args ])), loc
         ]
@@ -246,9 +243,7 @@ module Trampoline = struct
                                     , Prim
                                         ( Lt
                                         , [ Pv counter
-                                          ; Pc
-                                              (Int
-                                                 (Int32.of_int tailcall_max_depth))
+                                          ; Pc (Int (Int32.of_int tailcall_max_depth))
                                           ] ) )
                                 , noloc )
                               in
@@ -388,7 +383,7 @@ let rewrite_mutable
           ]
           @ List.mapi closures_extern ~f:(fun i x ->
                 match x with
-                | Let (x, Closure _), loc -> Let (x, Field (closure', i)), loc
+                | Let (x, Closure _), loc -> Let (x, Field (closure', i, Non_float)), loc
                 | _ -> assert false)
         in
         free_pc, blocks, body

diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
@@ -170,7 +170,7 @@ let simple blocks cont mapping =
           | Special _ -> `Exp exp
           | Block (tag, args, aon, mut) ->
               `Exp (Block (tag, Array.map args ~f:(map_var mapping), aon, mut))
-          | Field (x, i) -> `Exp (Field (map_var mapping x, i))
+          | Field (x, i, kind) -> `Exp (Field (map_var mapping x, i, kind))
           | Closure _ -> `Fail
           | Constant _ -> `Fail
           | Apply _ -> `Fail)