Distinguish the different kind of integers

Co-authored-by: Olivier Nicole <[email protected]>

Author: vouillon

compiler/lib/code.ml

@@ -363,9 +363,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 int32
 
 let rec constant_equal a b =
   match a, b with
@@ -383,26 +385,58 @@ 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 a, Int b -> Some (Int32.equal a b)
   | 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 _) ->
-      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 _) ->
+  | ( 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
+  | ( 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
@@ -492,7 +526,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
@@ -509,7 +546,6 @@ module Print = struct
               constant f a.(i)
             done;
             Format.fprintf f ")")
-    | Int i -> Format.fprintf f "%ld" i
 
   let arg f a =
     match a with

compiler/lib/code.mli

@@ -181,9 +181,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 int32
 
 val constant_equal : constant -> constant -> bool option
 

compiler/lib/eval.ml

@@ -110,8 +110,8 @@ 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))
+      | "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 ( ~-. )
@@ -130,9 +130,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 = Int32.to_int 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 (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 ] ->
@@ -332,10 +332,12 @@ let the_cond_of info x =
     info
     (fun x ->
       match Flow.Info.def info x with
-      | Some (Constant (Int 0l)) -> Zero
+      | Some (Constant (Int 0l | Int32 0l | NativeInt 0n)) -> Zero
       | Some
           (Constant
             ( Int _
+            | Int32 _
+            | NativeInt _
             | Float _
             | Tuple _
             | String _

compiler/lib/generate.ml

@@ -490,6 +490,8 @@ let rec constant_rec ~ctx x level instrs =
           in
           Mlvalue.Block.make ~tag ~args:l, instrs)
   | Int i -> int32 i, instrs
+  | Int32 _ | NativeInt _ ->
+      assert false (* Should not be produced when compiling to Javascript *)
 
 let constant ~ctx x level =
   let expr, instr = constant_rec ~ctx x level [] in

compiler/lib/parse_bytecode.ml

@@ -515,7 +515,7 @@ end = struct
     | Float_array _ -> false
     | Int64 _ -> false
     | Tuple _ -> false
-    | Int _ -> true
+    | Int _ | Int32 _ | NativeInt _ -> true
 end
 
 let const i = Constant (Int i)