diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml index 66c79a3e..5b4e3103 100644 --- a/compiler/lib/effects.ml +++ b/compiler/lib/effects.ml @@ -483,9 +483,8 @@ let cps_instr ~st (instr : instr) : instr = | Pc (Int a) -> Let ( x - , Prim - ( Extern "caml_alloc_dummy_function" - , [ size; Pc (Int (Int32.succ a)) ] ) ) + , Prim (Extern "caml_alloc_dummy_function", [ size; Pc (Int (Int32.succ a)) ]) + ) | _ -> assert false) | Let (x, Apply { f; args; _ }) when not (Var.Set.mem x st.cps_needed) -> (* At the moment, we turn into CPS any function not called with diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml index 5cf40258..c37a9a30 100644 --- a/compiler/lib/flow.ml +++ b/compiler/lib/flow.ml @@ -325,7 +325,7 @@ let the_def_of info x = (* If [constant_identical a b = true], then the two values cannot be distinguished, i.e., they are not different objects (and [caml_js_equals a b = true]) and if both are floats, they are bitwise equal. *) -let constant_identical ~(target : [`JavaScript | `Wasm]) a b = +let constant_identical ~(target : [ `JavaScript | `Wasm ]) a b = match a, b, target with | Int i, Int j, _ -> Int32.equal i j | Float a, Float b, `JavaScript -> Float.bitwise_equal a b @@ -347,7 +347,7 @@ let constant_identical ~(target : [`JavaScript | `Wasm]) a b = | NativeInt _, _, _ | _, NativeInt _, _ | Tuple _, _, _ - | _, Tuple _, _-> false + | _, Tuple _, _ -> false let the_const_of ~target info x = match x with diff --git a/compiler/lib/flow.mli b/compiler/lib/flow.mli index 23cffa5a..956ccec1 100644 --- a/compiler/lib/flow.mli +++ b/compiler/lib/flow.mli @@ -54,13 +54,16 @@ val get_approx : val the_def_of : info -> Code.prim_arg -> Code.expr option -val the_const_of : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> Code.constant option +val the_const_of : + target:[ `JavaScript | `Wasm ] -> info -> Code.prim_arg -> Code.constant option -val the_string_of : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> string option +val the_string_of : + target:[ `JavaScript | `Wasm ] -> info -> Code.prim_arg -> string option -val the_native_string_of : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> Code.Native_string.t option +val the_native_string_of : + target:[ `JavaScript | `Wasm ] -> info -> Code.prim_arg -> Code.Native_string.t option -val the_int : target:[`JavaScript | `Wasm ] -> info -> Code.prim_arg -> int32 option +val the_int : target:[ `JavaScript | `Wasm ] -> info -> Code.prim_arg -> int32 option val update_def : info -> Code.Var.t -> Code.expr -> unit diff --git a/compiler/lib/ocaml_compiler.ml b/compiler/lib/ocaml_compiler.ml index 1e8f6656..9b2cf1d9 100644 --- a/compiler/lib/ocaml_compiler.ml +++ b/compiler/lib/ocaml_compiler.ml @@ -25,21 +25,21 @@ let rec constant_of_const ~target c : Code.constant = | Const_base (Const_int i) -> Int (match target with - | `JavaScript -> Int32.of_int_warning_on_overflow i - | `Wasm -> Int31.of_int_warning_on_overflow i) + | `JavaScript -> Int32.of_int_warning_on_overflow i + | `Wasm -> Int31.of_int_warning_on_overflow i) | Const_base (Const_char c) -> Int (Int32.of_int (Char.code c)) | ((Const_base (Const_string (s, _))) [@if ocaml_version < (4, 11, 0)]) | ((Const_base (Const_string (s, _, _))) [@if ocaml_version >= (4, 11, 0)]) -> String s | Const_base (Const_float s) -> Float (float_of_string s) - | Const_base (Const_int32 i) -> - (match target with - | `JavaScript -> Int i - | `Wasm -> Int32 i) + | Const_base (Const_int32 i) -> ( + match target with + | `JavaScript -> Int i + | `Wasm -> Int32 i) | Const_base (Const_int64 i) -> Int64 i - | Const_base (Const_nativeint i) -> - (match target with - | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i) - | `Wasm -> NativeInt i) + | Const_base (Const_nativeint i) -> ( + match target with + | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i) + | `Wasm -> NativeInt i) | Const_immstring s -> String s | Const_float_array sl -> let l = List.map ~f:(fun f -> float_of_string f) sl in diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml index 9f5c4fa4..155c3cf3 100644 --- a/compiler/lib/parse_bytecode.ml +++ b/compiler/lib/parse_bytecode.ml @@ -465,16 +465,16 @@ end = struct else if tag = Obj.custom_tag then match ident_of_custom x with - | Some name when same_ident name ident_32 -> + | Some name when same_ident name ident_32 -> ( let i : int32 = Obj.magic x in - (match target with - | `JavaScript -> Int i - | `Wasm -> Int32 i) - | Some name when same_ident name ident_native -> + match target with + | `JavaScript -> Int i + | `Wasm -> Int32 i) + | Some name when same_ident name ident_native -> ( let i : nativeint = Obj.magic x in - (match target with - | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i) - | `Wasm -> NativeInt i) + match target with + | `JavaScript -> Int (Int32.of_nativeint_warning_on_overflow i) + | `Wasm -> NativeInt i) | Some name when same_ident name ident_64 -> Int64 (Obj.magic x : int64) | Some name -> failwith @@ -493,8 +493,8 @@ end = struct let i : int = Obj.magic x in Int (match target with - | `JavaScript -> Int32.of_int_warning_on_overflow i - | `Wasm -> Int31.of_int_warning_on_overflow i) + | `JavaScript -> Int32.of_int_warning_on_overflow i + | `Wasm -> Int31.of_int_warning_on_overflow i) let inlined = function | String _ | NativeString _ -> false @@ -2385,10 +2385,7 @@ and compile infos pc state instrs = (pc + 1) state (( Let - ( m - , Prim - ( Extern "caml_get_public_method" - , [ Pv obj; Pv tag; Pc (Int 0l) ] ) ) + (m, Prim (Extern "caml_get_public_method", [ Pv obj; Pv tag; Pc (Int 0l) ])) , loc ) :: instrs) | GETMETHOD -> @@ -3104,7 +3101,8 @@ let predefined_exceptions ~target = (Int ((* Predefined exceptions are registered in Symtable.init with [-index - 1] *) - Int32.of_int (-index - 1) ))) + Int32.of_int + (-index - 1))) ) , noloc ) ; Let (exn, Block (248, [| v_name; v_index |], NotArray, Immutable)), noloc ; ( Let diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml index 66f1c7fa..39f02090 100644 --- a/compiler/lib/specialize_js.ml +++ b/compiler/lib/specialize_js.ml @@ -283,9 +283,7 @@ let f_once p = | "caml_floatarray_unsafe_set" ) , [ _; _; _ ] ) as p) ) -> let x' = Code.Var.fork x in - let acc = - (Let (x', p), loc) :: (Let (x, Constant (Int 0l)), loc) :: acc - in + let acc = (Let (x', p), loc) :: (Let (x, Constant (Int 0l)), loc) :: acc in loop acc r | _ -> loop ((i, loc) :: acc) r) in diff --git a/compiler/lib/wasm/wa_generate.ml b/compiler/lib/wasm/wa_generate.ml index 9eedaa7e..d01daad0 100644 --- a/compiler/lib/wasm/wa_generate.ml +++ b/compiler/lib/wasm/wa_generate.ml @@ -672,11 +672,7 @@ 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, Non_float, 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)