Compiler: introduce Targetint

Author: hhugo

compiler/lib/code.ml

@@ -327,7 +327,7 @@ type constant =
   | NativeString of Native_string.t
   | Float of float
   | Float_array of float array
-  | Int of Int32.t
+  | Int of Targetint.t
   | Int32 of Int32.t
   | Int64 of Int64.t
   | NativeInt of Int32.t (* Native int are 32bit on all known backend *)
@@ -352,7 +352,8 @@ module Constant = struct
             | Some s, Some c -> same := Some (s && c)
           done;
           !same
-    | Int a, Int b | Int32 a, Int32 b -> Some (Int32.equal a b)
+    | Int a, Int b -> Some (Targetint.equal a b)
+    | Int32 a, Int32 b -> Some (Int32.equal a b)
     | Int64 a, Int64 b -> Some (Int64.equal a b)
     | NativeInt a, NativeInt b -> Some (Int32.equal a b)
     | Float_array a, Float_array b -> Some (Array.equal Float.ieee_equal a b)
@@ -497,7 +498,7 @@ module Print = struct
           Format.fprintf f "%.12g" a.(i)
         done;
         Format.fprintf f "|]"
-    | Int i -> Format.fprintf f "%ld" i
+    | Int i -> Format.fprintf f "%s" (Targetint.to_string i)
     | Int32 i -> Format.fprintf f "%ldl" i
     | Int64 i -> Format.fprintf f "%LdL" i
     | NativeInt i -> Format.fprintf f "%ldn" i

compiler/lib/code.mli

@@ -173,7 +173,7 @@ type constant =
   | NativeString of Native_string.t
   | Float of float
   | Float_array of float array
-  | Int of Int32.t
+  | Int of Targetint.t
   | Int32 of Int32.t  (** Only produced when compiling to WebAssembly. *)
   | Int64 of Int64.t
   | NativeInt of Int32.t  (** Only produced when compiling to WebAssembly. *)

compiler/lib/effects.ml

@@ -300,7 +300,7 @@ let cps_branch ~st ~src (pc, args) loc =
           (* We are jumping to a block that is also used as a continuation.
              We pass it a dummy argument. *)
           let x = Var.fresh () in
-          [ x ], [ Let (x, Constant (Int 0l)), noloc ]
+          [ x ], [ Let (x, Constant (Int Targetint.zero)), noloc ]
         else args, []
       in
       (* We check the stack depth only for backward edges (so, at
@@ -402,7 +402,9 @@ let cps_last ~st ~alloc_jump_closures pc ((last, last_loc) : last * loc) ~k :
                         ( x'
                         , Prim
                             ( Extern "caml_maybe_attach_backtrace"
-                            , [ Pv x; Pc (Int (if force then 1l else 0l)) ] ) )
+                            , [ Pv x
+                              ; Pc (Int (if force then Targetint.one else Targetint.zero))
+                              ] ) )
                     , noloc )
                   ]
                 in
@@ -483,7 +485,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 (Targetint.succ a)) ])
             )
       | _ -> assert false)
   | Let (x, Apply { f; args; _ }) when not (Var.Set.mem x st.cps_needed) ->
@@ -562,7 +565,7 @@ let cps_block ~st ~k pc block =
               [ arg; k' ]
               loc)
     | Prim (Extern "%perform", [ Pv effect_ ]) ->
-        perform_effect ~effect_ ~continuation:(Pc (Int 0l)) loc
+        perform_effect ~effect_ ~continuation:(Pc (Int Targetint.zero)) loc
     | Prim (Extern "%reperform", [ Pv effect_; continuation ]) ->
         perform_effect ~effect_ ~continuation loc
     | _ -> None

compiler/lib/eval.ml

@@ -29,7 +29,7 @@ let set_static_env s value = Hashtbl.add static_env s value
 
 let get_static_env s = try Some (Hashtbl.find static_env s) with Not_found -> None
 
-module Int = Int32
+module Int = Targetint
 
 let int_binop l f =
   match l with
@@ -38,16 +38,16 @@ let int_binop l f =
 
 let shift l f =
   match l with
-  | [ Int i; Int j ] -> Some (Int (f i (Int32.to_int j land 0x1f)))
+  | [ Int i; Int j ] -> Some (Int (f i (Targetint.to_int_exn j land 0x1f)))
   | _ -> None
 
 let float_binop_aux (l : constant list) (f : float -> float -> 'a) : 'a option =
   let args =
     match l with
     | [ Float i; Float j ] -> Some (i, j)
-    | [ Int i; Int j ] -> Some (Int32.to_float i, Int32.to_float j)
-    | [ Int i; Float j ] -> Some (Int32.to_float i, j)
-    | [ Float i; Int j ] -> Some (i, Int32.to_float j)
+    | [ Int i; Int j ] -> Some (Targetint.to_float i, Targetint.to_float j)
+    | [ Int i; Float j ] -> Some (Targetint.to_float i, j)
+    | [ Float i; Int j ] -> Some (i, Targetint.to_float j)
     | _ -> None
   in
   match args with
@@ -62,10 +62,10 @@ let float_binop (l : constant list) (f : float -> float -> float) : constant opt
 let float_unop (l : constant list) (f : float -> float) : constant option =
   match l with
   | [ Float i ] -> Some (Float (f i))
-  | [ Int i ] -> Some (Float (f (Int32.to_float i)))
+  | [ Int i ] -> Some (Float (f (Targetint.to_float i)))
   | _ -> None
 
-let bool' b = Int (if b then 1l else 0l)
+let bool' b = Int Targetint.(if b then one else zero)
 
 let bool b = Some (bool' b)
 
@@ -76,20 +76,20 @@ let float_binop_bool l f =
 
 let eval_prim x =
   match x with
-  | Not, [ Int i ] -> bool Int32.(i = 0l)
-  | Lt, [ Int i; Int j ] -> bool Int32.(i < j)
-  | Le, [ Int i; Int j ] -> bool Int32.(i <= j)
-  | Eq, [ Int i; Int j ] -> bool Int32.(i = j)
-  | Neq, [ Int i; Int j ] -> bool Int32.(i <> j)
-  | Ult, [ Int i; Int j ] -> bool (Int32.(j < 0l) || Int32.(i < j))
+  | Not, [ Int i ] -> bool (Targetint.is_zero i)
+  | Lt, [ Int i; Int j ] -> bool Targetint.(i < j)
+  | Le, [ Int i; Int j ] -> bool Targetint.(i <= j)
+  | Eq, [ Int i; Int j ] -> bool Targetint.(i = j)
+  | Neq, [ Int i; Int j ] -> bool Targetint.(i <> j)
+  | Ult, [ Int i; Int j ] -> bool (Targetint.(j < zero) || Targetint.(i < j))
   | Extern name, l -> (
       let name = Primitive.resolve name in
       match name, l with
       (* int *)
       | "%int_add", _ -> int_binop l Int.add
       | "%int_sub", _ -> int_binop l Int.sub
       | "%direct_int_mul", _ -> int_binop l Int.mul
-      | "%direct_int_div", [ _; Int 0l ] -> None
+      | "%direct_int_div", [ _; Int maybe_zero ] when Targetint.is_zero maybe_zero -> None
       | "%direct_int_div", _ -> int_binop l Int.div
       | "%direct_int_mod", _ -> int_binop l Int.rem
       | "%int_and", _ -> int_binop l Int.logand
@@ -111,9 +111,7 @@ let eval_prim x =
       | "caml_mul_float", _ -> float_binop l ( *. )
       | "caml_div_float", _ -> float_binop l ( /. )
       | "caml_fmod_float", _ -> float_binop l mod_float
-      | "caml_int_of_float", [ Float f ] -> Some (Int (Int32.of_float f))
-      | "to_int", [ Float f ] -> Some (Int (Int32.of_float f))
-      | "to_int", [ Int i ] -> Some (Int i)
+      | "caml_int_of_float", [ Float f ] -> Some (Int (Targetint.of_float f))
       (* Math *)
       | "caml_neg_float", _ -> float_unop l ( ~-. )
       | "caml_abs_float", _ -> float_unop l abs_float
@@ -131,9 +129,9 @@ let eval_prim x =
       | "caml_sqrt_float", _ -> float_unop l sqrt
       | "caml_tan_float", _ -> float_unop l tan
       | ("caml_string_get" | "caml_string_unsafe_get"), [ String s; Int pos ] ->
-          let pos = Int.to_int pos in
+          let pos = Int.to_int_exn pos in
           if Config.Flag.safe_string () && pos >= 0 && pos < String.length s
-          then Some (Int (Int.of_int (Char.code s.[pos])))
+          then Some (Int (Int.of_int_exn (Char.code s.[pos])))
           else None
       | "caml_string_equal", [ String s1; String s2 ] -> bool (String.equal s1 s2)
       | "caml_string_notequal", [ String s1; String s2 ] ->
@@ -142,10 +140,11 @@ let eval_prim x =
           match get_static_env s with
           | Some env -> Some (String env)
           | None -> None)
-      | "caml_sys_const_word_size", [ _ ] -> Some (Int 32l)
-      | "caml_sys_const_int_size", [ _ ] -> Some (Int 32l)
-      | "caml_sys_const_big_endian", [ _ ] -> Some (Int 0l)
-      | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int 0l)
+      | "caml_sys_const_word_size", [ _ ] -> Some (Int (Targetint.of_int_exn 32))
+      | "caml_sys_const_int_size", [ _ ] ->
+          Some (Int (Targetint.of_int_exn Targetint.num_bits))
+      | "caml_sys_const_big_endian", [ _ ] -> Some (Int Targetint.zero)
+      | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int Targetint.zero)
       | _ -> None)
   | _ -> None
 
@@ -154,14 +153,14 @@ let the_length_of info x =
     info
     (fun x ->
       match Flow.Info.def info x with
-      | Some (Constant (String s)) -> Some (Int32.of_int (String.length s))
+      | Some (Constant (String s)) -> Some (Targetint.of_int_exn (String.length s))
       | Some (Prim (Extern "caml_create_string", [ arg ]))
       | Some (Prim (Extern "caml_create_bytes", [ arg ])) -> the_int info arg
       | None | Some _ -> None)
     None
     (fun u v ->
       match u, v with
-      | Some l, Some l' when Int32.(l = l') -> Some l
+      | Some l, Some l' when Targetint.(l = l') -> Some l
       | _ -> None)
     x
 
@@ -225,7 +224,7 @@ let the_cont_of info x (a : cont array) =
     (fun x ->
       match Flow.Info.def info x with
       | Some (Prim (Extern "%direct_obj_tag", [ b ])) -> the_tag_of info b get
-      | Some (Constant (Int j)) -> get (Int32.to_int j)
+      | Some (Constant (Int j)) -> get (Targetint.to_int_exn j)
       | None | Some _ -> None)
     None
     (fun u v ->
@@ -237,7 +236,7 @@ let the_cont_of info x (a : cont array) =
 (* If [constant_js_equal a b = Some v], then [caml_js_equals a b = v]). *)
 let constant_js_equal a b =
   match a, b with
-  | Int i, Int j -> Some (Int32.equal i j)
+  | Int i, Int j -> Some (Targetint.equal i j)
   | Float a, Float b -> Some (Float.ieee_equal a b)
   | NativeString a, NativeString b -> Some (Native_string.equal a b)
   | String a, String b when Config.Flag.use_js_string () -> Some (String.equal a b)
@@ -289,7 +288,7 @@ let eval_instr info ((x, loc) as i) =
   | Let (x, Prim (Extern "caml_ml_string_length", [ s ])) -> (
       let c =
         match s with
-        | Pc (String s) -> Some (Int32.of_int (String.length s))
+        | Pc (String s) -> Some (Targetint.of_int_exn (String.length s))
         | Pv v -> the_length_of info v
         | _ -> None
       in
@@ -324,7 +323,7 @@ let eval_instr info ((x, loc) as i) =
   | Let (x, Prim (Extern "%direct_obj_tag", [ y ])) -> (
       match the_tag_of info y (fun x -> Some x) with
       | Some tag ->
-          let c = Constant (Int (Int32.of_int tag)) in
+          let c = Constant (Int (Targetint.of_int_exn tag)) in
           Flow.Info.update_def info x c;
           [ Let (x, c), loc ]
       | None -> [ i ])
@@ -381,11 +380,10 @@ let the_cond_of info x =
     info
     (fun x ->
       match Flow.Info.def info x with
-      | Some (Constant (Int 0l)) -> Zero
+      | Some (Constant (Int x)) -> if Targetint.is_zero x then Zero else Non_zero
       | Some
           (Constant
-            ( Int _
-            | Int32 _
+            ( Int32 _
             | NativeInt _
             | Float _
             | Tuple _

compiler/lib/flow.ml

@@ -345,7 +345,7 @@ let the_def_of info x =
    = true]) and if both are floats, they are bitwise equal. *)
 let constant_identical a b =
   match a, b with
-  | Int i, Int j -> Int32.equal i j
+  | Int i, Int j -> Targetint.equal i j
   | Float a, Float b -> Float.bitwise_equal a b
   | NativeString a, NativeString b -> Native_string.equal a b
   | String a, String b -> Config.Flag.use_js_string () && String.equal a b

compiler/lib/flow.mli

@@ -58,6 +58,6 @@ val the_string_of : Info.t -> Code.prim_arg -> string option
 
 val the_native_string_of : Info.t -> Code.prim_arg -> Code.Native_string.t option
 
-val the_int : Info.t -> Code.prim_arg -> int32 option
+val the_int : Info.t -> Code.prim_arg -> Stdlib.Targetint.t option
 
 val f : ?skip_param:bool -> Code.program -> Code.program * Info.t

compiler/lib/generate.ml

@@ -309,9 +309,9 @@ type edge_kind =
 
 let var x = J.EVar (J.V x)
 
-let int n = J.ENum (J.Num.of_int32 (Int32.of_int n))
+let int n = J.ENum (J.Num.of_targetint (Targetint.of_int_exn n))
 
-let int32 n = J.ENum (J.Num.of_int32 n)
+let targetint n = J.ENum (J.Num.of_targetint n)
 
 let to_int cx = J.EBin (J.Bor, cx, int 0)
 
@@ -325,7 +325,7 @@ let unsigned x =
   in
   let pos_int32 =
     match x with
-    | J.ENum num -> ( try Int32.(J.Num.to_int32 num >= 0l) with _ -> false)
+    | J.ENum num -> ( try Targetint.(J.Num.to_targetint num >= zero) with _ -> false)
     | _ -> false
   in
   if pos_int32 then x else unsigned' x
@@ -455,7 +455,8 @@ let rec constant_rec ~ctx x level instrs =
       let constant_max_depth = Config.Param.constant_max_depth () in
       let rec detect_list n acc = function
         | Tuple (0, [| x; l |], _) -> detect_list (succ n) (x :: acc) l
-        | Int 0l -> if n > constant_max_depth then Some acc else None
+        | Int maybe_zero when Targetint.is_zero maybe_zero ->
+            if n > constant_max_depth then Some acc else None
         | _ -> None
       in
       match detect_list 0 [] x with
@@ -492,7 +493,7 @@ let rec constant_rec ~ctx x level instrs =
             else List.map ~f:(fun x -> J.Element x) (List.rev l), instrs
           in
           Mlvalue.Block.make ~tag ~args:l, instrs)
-  | Int i -> int32 i, instrs
+  | Int i -> targetint i, instrs
   | Int32 _ | NativeInt _ ->
       assert false (* Should not be produced when compiling to Javascript *)
 
@@ -568,9 +569,9 @@ module DTree = struct
 
   type cond =
     | IsTrue
-    | CEq of int32
-    | CLt of int32
-    | CLe of int32
+    | CEq of Targetint.t
+    | CLt of Targetint.t
+    | CLe of Targetint.t
 
   type 'a branch = int list * 'a
 
@@ -609,9 +610,9 @@ module DTree = struct
           (* try to optimize when there are only 2 branch *)
           match array_norm with
           | [| (b1, ([ i1 ] as l1)); (b2, l2) |] ->
-              If (CEq (Int32.of_int i1), Branch (l1, b1), Branch (l2, b2))
+              If (CEq (Targetint.of_int_exn i1), Branch (l1, b1), Branch (l2, b2))
           | [| (b1, l1); (b2, ([ i2 ] as l2)) |] ->
-              If (CEq (Int32.of_int i2), Branch (l2, b2), Branch (l1, b1))
+              If (CEq (Targetint.of_int_exn i2), Branch (l2, b2), Branch (l1, b1))
           | [| (b1, l1); (b2, l2) |] ->
               let bound l1 =
                 match l1, List.rev l1 with
@@ -621,9 +622,9 @@ module DTree = struct
               let min1, max1 = bound l1 in
               let min2, max2 = bound l2 in
               if max1 < min2
-              then If (CLt (Int32.of_int max1), Branch (l2, b2), Branch (l1, b1))
+              then If (CLt (Targetint.of_int_exn max1), Branch (l2, b2), Branch (l1, b1))
               else if max2 < min1
-              then If (CLt (Int32.of_int max2), Branch (l1, b1), Branch (l2, b2))
+              then If (CLt (Targetint.of_int_exn max2), Branch (l1, b1), Branch (l2, b2))
               else raise Not_found
           | _ -> raise Not_found
         with Not_found -> (
@@ -641,7 +642,7 @@ module DTree = struct
             let range1 = snd ai.(h) and range2 = snd ai.(succ h) in
             match range1, range2 with
             | [], _ | _, [] -> assert false
-            | _, lower_bound2 :: _ -> If (CLe (Int32.of_int lower_bound2), b2, b1))
+            | _, lower_bound2 :: _ -> If (CLe (Targetint.of_int_exn lower_bound2), b2, b1))
     in
     let len = Array.length ai in
     assert (len > 0);
@@ -1269,7 +1270,7 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
             let i, queue =
               let (_px, cx), queue = access_queue' ~ctx queue size in
               match cx with
-              | J.ENum i -> Int32.to_int (J.Num.to_int32 i), queue
+              | J.ENum i -> Targetint.to_int_exn (J.Num.to_targetint i), queue
               | _ -> assert false
             in
             let args = Array.to_list (Array.init i ~f:(fun _ -> J.V (Var.fresh ()))) in
@@ -1668,9 +1669,9 @@ and compile_decision_tree kind st scope_stack loc cx dtree ~fall_through =
         let e' =
           match cond with
           | IsTrue -> cx
-          | CEq n -> J.EBin (J.EqEqEq, int32 n, cx)
-          | CLt n -> J.EBin (J.LtInt, int32 n, cx)
-          | CLe n -> J.EBin (J.LeInt, int32 n, cx)
+          | CEq n -> J.EBin (J.EqEqEq, targetint n, cx)
+          | CLt n -> J.EBin (J.LtInt, targetint n, cx)
+          | CLe n -> J.EBin (J.LeInt, targetint n, cx)
         in
         ( never1 && never2
         , Js_simpl.if_statement