Refactor distinction between integer types

compiler/lib/code.ml

@@ -284,9 +284,11 @@ type constant =
   | NativeString of Native_string.t
   | Float of float
   | Float_array of float array
+  | Int of int32
+  | Int32 of int32
   | Int64 of int64
+  | NativeInt of nativeint
   | Tuple of int * constant array * array_or_not
-  | Int of int_kind * int32
 
 let rec constant_equal a b =
   match a, b with
@@ -304,26 +306,59 @@ let rec constant_equal a b =
           | Some s, Some c -> same := Some (s && c)
         done;
         !same
+  | Int a, Int b | Int32 a, Int32 b -> Some (Int32.equal a b)
   | Int64 a, Int64 b -> Some (Int64.equal a b)
+  | NativeInt a, NativeInt b -> Some (Nativeint.equal a b)
   | Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
-  | Int (k, a), Int (k', b) -> if Poly.(k = k') then Some (Int32.equal a b) else None
   | Float a, Float b -> Some (Float.equal a b)
   | String _, NativeString _ | NativeString _, String _ -> None
   | Int _, Float _ | Float _, Int _ -> None
   | Tuple ((0 | 254), _, _), Float_array _ -> None
   | Float_array _, Tuple ((0 | 254), _, _) -> None
-  | Tuple _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Float_array _) ->
+  | ( Tuple _
+    , ( String _
+      | NativeString _
+      | Int64 _
+      | Int _
+      | Int32 _
+      | NativeInt _
+      | Float _
+      | Float_array _ ) ) -> Some false
+  | ( Float_array _
+    , ( String _
+      | NativeString _
+      | Int64 _
+      | Int _
+      | Int32 _
+      | NativeInt _
+      | Float _
+      | Tuple _ ) ) -> Some false
+  | ( String _
+    , (Int64 _ | Int _ | Int32 _ | NativeInt _ | Float _ | Tuple _ | Float_array _) ) ->
       Some false
-  | Float_array _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Tuple _) ->
-      Some false
-  | String _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
-  | NativeString _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
-  | Int64 _, (String _ | NativeString _ | Int _ | Float _ | Tuple _ | Float_array _) ->
+  | ( NativeString _
+    , (Int64 _ | Int _ | Int32 _ | NativeInt _ | Float _ | Tuple _ | Float_array _) ) ->
       Some false
+  | ( Int64 _
+    , ( String _
+      | NativeString _
+      | Int _
+      | Int32 _
+      | NativeInt _
+      | Float _
+      | Tuple _
+      | Float_array _ ) ) -> Some false
   | Float _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
       Some false
-  | Int _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
+  | ( (Int _ | Int32 _ | NativeInt _)
+    , (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ) ->
       Some false
+  (* Note: the following cases should not occur when compiling to Javascript *)
+  | Int _, (Int32 _ | NativeInt _)
+  | Int32 _, (Int _ | NativeInt _)
+  | NativeInt _, (Int _ | Int32 _)
+  | (Int32 _ | NativeInt _), Float _
+  | Float _, (Int32 _ | NativeInt _) -> None
 
 type loc =
   | No
@@ -413,7 +448,10 @@ module Print = struct
           Format.fprintf f "%.12g" a.(i)
         done;
         Format.fprintf f "|]"
+    | Int i -> Format.fprintf f "%ld" i
+    | Int32 i -> Format.fprintf f "%ldl" i
     | Int64 i -> Format.fprintf f "%LdL" i
+    | NativeInt i -> Format.fprintf f "%ndn" i
     | Tuple (tag, a, _) -> (
         Format.fprintf f "<%d>" tag;
         match Array.length a with
@@ -430,15 +468,6 @@ module Print = struct
               constant f a.(i)
             done;
             Format.fprintf f ")")
-    | Int (k, i) ->
-        Format.fprintf
-          f
-          "%ld%s"
-          i
-          (match k with
-          | Regular -> ""
-          | Int32 -> "l"
-          | Native -> "n")
 
   let arg f a =
     match a with

compiler/lib/code.mli

@@ -162,9 +162,11 @@ type constant =
   | NativeString of Native_string.t
   | Float of float
   | Float_array of float array
+  | Int of int32
+  | Int32 of int32  (** Only produced when compiling to WebAssembly. *)
   | Int64 of int64
+  | NativeInt of nativeint  (** Only produced when compiling to WebAssembly. *)
   | Tuple of int * constant array * array_or_not
-  | Int of int_kind * int32
 
 val constant_equal : constant -> constant -> bool option
 

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 (Regular, 0l))), noloc ]
+          [ x ], [ Let (x, Constant (Int 0l)), noloc ]
         else args, []
       in
       (* We check the stack depth only for backward edges (so, at
@@ -402,7 +402,7 @@ 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 (Regular, if force then 1l else 0l)) ] ) )
+                            , [ Pv x; Pc (Int (if force then 1l else 0l)) ] ) )
                     , noloc )
                   ]
                 in
@@ -480,12 +480,12 @@ let cps_instr ~st (instr : instr) : instr =
       Let (x, Closure (params @ [ k ], cont))
   | Let (x, Prim (Extern "caml_alloc_dummy_function", [ size; arity ])) -> (
       match arity with
-      | Pc (Int (_, a)) ->
+      | Pc (Int a) ->
           Let
             ( x
             , Prim
                 ( Extern "caml_alloc_dummy_function"
-                , [ size; Pc (Int (Regular, Int32.succ a)) ] ) )
+                , [ 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
@@ -563,7 +563,7 @@ let cps_block ~st ~k pc block =
               [ arg; k' ]
               loc)
     | Prim (Extern "%perform", [ Pv effect ]) ->
-        perform_effect ~effect ~continuation:(Pc (Int (Regular, 0l))) loc
+        perform_effect ~effect ~continuation:(Pc (Int 0l)) loc
     | Prim (Extern "%reperform", [ Pv effect; continuation ]) ->
         perform_effect ~effect ~continuation loc
     | _ -> None

compiler/lib/eval.ml

@@ -33,22 +33,22 @@ module Int = Int32
 
 let int_binop l w f =
   match l with
-  | [ Int (_, i); Int (_, j) ] -> Some (Int (Regular, w (f i j)))
+  | [ Int i; Int j ] -> Some (Int (w (f i j)))
   | _ -> None
 
 let shift l w t f =
   match l with
-  | [ Int (_, i); Int (_, j) ] ->
-      Some (Int (Regular, 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 f =
   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 (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)
     | _ -> None
   in
   match args with
@@ -63,25 +63,25 @@ let float_binop l f =
 let float_unop l f =
   match l with
   | [ Float i ] -> Some (Float (f i))
-  | [ Int (_, i) ] -> Some (Float (f (Int32.to_float i)))
+  | [ Int i ] -> Some (Float (f (Int32.to_float i)))
   | _ -> None
 
 let float_binop_bool l f =
   match float_binop_aux l f with
-  | Some true -> Some (Int (Regular, 1l))
-  | Some false -> Some (Int (Regular, 0l))
+  | Some true -> Some (Int 1l)
+  | Some false -> Some (Int 0l)
   | None -> None
 
-let bool b = Some (Int (Regular, if b then 1l else 0l))
+let bool b = Some (Int (if b then 1l else 0l))
 
 let eval_prim ~target 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 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))
   | Extern name, l -> (
       let name = Primitive.resolve name in
       let wrap =
@@ -94,7 +94,7 @@ let eval_prim ~target x =
       | "%int_add", _ -> int_binop l wrap Int.add
       | "%int_sub", _ -> int_binop l wrap Int.sub
       | "%direct_int_mul", _ -> int_binop l wrap Int.mul
-      | "%direct_int_div", [ _; Int (_, 0l) ] -> None
+      | "%direct_int_div", [ _; Int 0l ] -> None
       | "%direct_int_div", _ -> int_binop l wrap Int.div
       | "%direct_int_mod", _ -> int_binop l wrap Int.rem
       | "%int_and", _ -> int_binop l wrap Int.logand
@@ -110,7 +110,7 @@ let eval_prim ~target x =
             | `Wasm -> fun i -> Int.logand i 0x7fffffffl)
             Int.shift_right_logical
       | "%int_asr", _ -> shift l wrap Fun.id Int.shift_right
-      | "%int_neg", [ Int (_, i) ] -> Some (Int (Regular, Int.neg i))
+      | "%int_neg", [ Int i ] -> Some (Int (Int.neg i))
       (* float *)
       | "caml_eq_float", _ -> float_binop_bool l Float.( = )
       | "caml_neq_float", _ -> float_binop_bool l Float.( <> )
@@ -123,9 +123,9 @@ let eval_prim ~target 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 (Regular, Int.of_float f))
-      | "to_int", [ Float f ] -> Some (Int (Regular, Int.of_float f))
-      | "to_int", [ Int (_, i) ] -> Some (Int (Regular, i))
+      | "caml_int_of_float", [ Float f ] -> Some (Int (Int.of_float f))
+      | "to_int", [ Float f ] -> Some (Int (Int.of_float f))
+      | "to_int", [ Int i ] -> Some (Int i)
       (* Math *)
       | "caml_neg_float", _ -> float_unop l ( ~-. )
       | "caml_abs_float", _ -> float_unop l abs_float
@@ -142,10 +142,10 @@ let eval_prim ~target x =
       | "caml_sin_float", _ -> float_unop l sin
       | "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) ] ->
+      | ("caml_string_get" | "caml_string_unsafe_get"), [ String s; Int pos ] ->
           let pos = Int32.to_int pos in
           if Config.Flag.safe_string () && pos >= 0 && pos < String.length s
-          then Some (Int (Regular, Int32.of_int (Char.code s.[pos])))
+          then Some (Int (Int32.of_int (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 ] ->
@@ -154,16 +154,15 @@ let eval_prim ~target x =
           match get_static_env s with
           | Some env -> Some (String env)
           | None -> None)
-      | "caml_sys_const_word_size", [ _ ] -> Some (Int (Regular, 32l))
+      | "caml_sys_const_word_size", [ _ ] -> Some (Int 32l)
       | "caml_sys_const_int_size", [ _ ] ->
           Some
             (Int
-               ( Regular
-               , match target with
-                 | `JavaScript -> 32l
-                 | `Wasm -> 31l ))
-      | "caml_sys_const_big_endian", [ _ ] -> Some (Int (Regular, 0l))
-      | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int (Regular, 0l))
+               (match target with
+                | `JavaScript -> 32l
+                | `Wasm -> 31l ))
+      | "caml_sys_const_big_endian", [ _ ] -> Some (Int 0l)
+      | "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int 0l)
       | _ -> None)
   | _ -> None
 
@@ -195,8 +194,8 @@ let is_int ~target info x =
         info
         (fun x ->
           match info.info_defs.(Var.idx x) with
-          | Expr (Constant (Int (Regular, _))) -> Y
-          | Expr (Constant (Int _)) -> (
+          | Expr (Constant (Int _)) -> Y
+          | Expr (Constant (Int32 _ | NativeInt _)) -> (
               match target with
               | `JavaScript -> Y
               | `Wasm -> N)
@@ -209,8 +208,8 @@ let is_int ~target info x =
           | N, N -> N
           | _ -> Unknown)
         x
-  | Pc (Int (Regular, _)) -> Y
-  | Pc (Int _) -> (
+  | Pc (Int _) -> Y
+  | Pc (Int32 _ | NativeInt _) -> (
       match target with
       | `JavaScript -> Y
       | `Wasm -> N)
@@ -247,7 +246,7 @@ let the_cont_of info x (a : cont array) =
     (fun x ->
       match info.info_defs.(Var.idx x) with
       | Expr (Prim (Extern "%direct_obj_tag", [ b ])) -> the_tag_of info b get
-      | Expr (Constant (Int (_, j))) -> get (Int32.to_int j)
+      | Expr (Constant (Int j)) -> get (Int32.to_int j)
       | _ -> None)
     None
     (fun u v ->
@@ -265,7 +264,7 @@ let eval_instr ~target info ((x, loc) as i) =
           | None -> [ i ]
           | Some c ->
               let c = if c then 1l else 0l in
-              let c = Constant (Int (Regular, c)) in
+              let c = Constant (Int c) in
               Flow.update_def info x c;
               [ Let (x, c), loc ])
       | _ -> [ i ])
@@ -279,7 +278,7 @@ let eval_instr ~target info ((x, loc) as i) =
       match c with
       | None -> [ i ]
       | Some c ->
-          let c = Constant (Int (Regular, c)) in
+          let c = Constant (Int c) in
           Flow.update_def info x c;
           [ Let (x, c), loc ])
   | Let
@@ -302,13 +301,13 @@ let eval_instr ~target info ((x, loc) as i) =
       | Unknown -> [ i ]
       | (Y | N) as b ->
           let b = if Poly.(b = N) then 0l else 1l in
-          let c = Constant (Int (Regular, b)) in
+          let c = Constant (Int b) in
           Flow.update_def info x c;
           [ Let (x, c), loc ])
   | 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 (Regular, Int32.of_int tag)) in
+          let c = Constant (Int (Int32.of_int tag)) in
           Flow.update_def info x c;
           [ Let (x, c), loc ]
       | None -> [ i ])
@@ -374,11 +373,13 @@ let the_cond_of info x =
   get_approx
     info
     (fun x ->
-      match info.info_defs.(Var.idx x) with
-      | Expr (Constant (Int (_, 0l))) -> Zero
-      | Expr
+      match Flow.Info.def info x with
+      | Some (Constant (Int 0l)) -> Zero
+      | Some
           (Constant
             ( Int _
+            | Int32 _
+            | NativeInt _
             | Float _
             | Tuple _
             | String _

compiler/lib/flow.ml

@@ -344,7 +344,7 @@ let the_const_of info x =
 
 let the_int info x =
   match the_const_of info x with
-  | Some (Int (_, i)) -> Some i
+  | Some (Int i) -> Some i
   | _ -> None
 
 let the_string_of info x =