From d7de3b6702a6d5029d23407b26679ea2114f97e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=B4me=20Vouillon?= Date: Fri, 20 Sep 2024 10:40:52 +0200 Subject: [PATCH] Fixes --- compiler/lib/eval.ml | 15 +++++++-------- compiler/lib/generate_closure.ml | 15 +++++---------- compiler/lib/inline.ml | 2 +- 3 files changed, 13 insertions(+), 19 deletions(-) diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml index 21b1041dc..77eb5e332 100644 --- 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 index 3094ac98c..87f5d0cfe 100644 --- 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 index 40cebb0ad..16b9ae535 100644 --- 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)