before removing int8 and int16 from boxable numbers

bytecomp/bytegen.ml

@@ -397,6 +397,8 @@ let indexing_primitive (index_kind : Lambda.array_index_kind) prefix =
     | Ptagged_int_index -> ""
     | Punboxed_int_index Unboxed_int64 -> "_indexed_by_int64"
     | Punboxed_int_index Unboxed_int32 -> "_indexed_by_int32"
+    | Punboxed_int_index Unboxed_int16 -> "_indexed_by_int16"
+    | Punboxed_int_index Unboxed_int8 -> "_indexed_by_int8"
     | Punboxed_int_index Unboxed_nativeint -> "_indexed_by_nativeint"
   in
   prefix ^ suffix

lambda/lambda.ml

@@ -384,6 +384,8 @@ and flat_element = Types.flat_element =
   | Float_boxed
   | Float64
   | Float32
+  | Bits8
+  | Bits16
   | Bits32
   | Bits64
   | Vec128
@@ -465,6 +467,8 @@ and unboxed_integer = Primitive.unboxed_integer =
   | Unboxed_int64
   | Unboxed_nativeint
   | Unboxed_int32
+  | Unboxed_int16
+  | Unboxed_int8
 
 and unboxed_vector = Primitive.unboxed_vector =
   | Unboxed_vec128
@@ -977,8 +981,10 @@ let layout_functor = non_null_value Pgenval
 let layout_boxed_float f = non_null_value (Pboxedfloatval f)
 let layout_unboxed_float f = Punboxed_float f
 let layout_unboxed_nativeint = Punboxed_int Unboxed_nativeint
-let layout_unboxed_int32 = Punboxed_int Unboxed_int32
 let layout_unboxed_int64 = Punboxed_int Unboxed_int64
+let layout_unboxed_int32 = Punboxed_int Unboxed_int32
+let layout_unboxed_int16 = Punboxed_int Unboxed_int16
+let layout_unboxed_int8 = Punboxed_int Unboxed_int8
 let layout_string = non_null_value Pgenval
 let layout_unboxed_int ubi = Punboxed_int ubi
 let layout_boxed_int bi = non_null_value (Pboxedintval bi)
@@ -1369,7 +1375,7 @@ let get_mixed_block_element = Types.get_mixed_product_element
 let flat_read_non_float flat_element =
   match flat_element with
   | Float_boxed -> Misc.fatal_error "flat_element_read_non_float Float_boxed"
-  | Imm | Float64 | Float32 | Bits32 | Bits64 | Vec128 | Word as flat_element ->
+  | Imm | Float64 | Float32 | Bits8 | Bits16 | Bits32 | Bits64 | Vec128 | Word as flat_element ->
       Flat_read flat_element
 
 let flat_read_float_boxed locality_mode = Flat_read_float_boxed locality_mode
@@ -2172,6 +2178,8 @@ let layout_of_mixed_field (kind : mixed_block_read) =
       | Imm -> layout_int
       | Float64 -> layout_unboxed_float Unboxed_float64
       | Float32 -> layout_unboxed_float Unboxed_float32
+      | Bits8 -> layout_unboxed_int8
+      | Bits16 -> layout_unboxed_int16
       | Bits32 -> layout_unboxed_int32
       | Bits64 -> layout_unboxed_int64
       | Vec128 -> layout_unboxed_vector Unboxed_vec128
@@ -2239,20 +2247,20 @@ let primitive_result_layout (p : primitive) =
   | Pandbint (bi, _) | Porbint (bi, _) | Pxorbint (bi, _)
   | Plslbint (bi, _) | Plsrbint (bi, _) | Pasrbint (bi, _)
   | Pbbswap (bi, _) | Pbox_int (bi, _) ->
-      layout_boxed_int bi
+    layout_boxed_int bi
   | Punbox_int bi -> Punboxed_int (Primitive.unbox_integer bi)
   | Pstring_load_32 { boxed = true; _ } | Pbytes_load_32 { boxed = true; _ }
   | Pbigstring_load_32 { boxed = true; _ } ->
-      layout_boxed_int Boxed_int32
+    layout_boxed_int Boxed_int32
   | Pstring_load_f32 { boxed = true; _ } | Pbytes_load_f32 { boxed = true; _ }
   | Pbigstring_load_f32 { boxed = true; _ } ->
-      layout_boxed_float Boxed_float32
+    layout_boxed_float Boxed_float32
   | Pstring_load_64 { boxed = true; _ } | Pbytes_load_64 { boxed = true; _ }
   | Pbigstring_load_64 { boxed = true; _ } ->
-      layout_boxed_int Boxed_int64
+    layout_boxed_int Boxed_int64
   | Pstring_load_128 { boxed = true; _ } | Pbytes_load_128 { boxed = true; _ }
   | Pbigstring_load_128 { boxed = true; _ } ->
-      layout_boxed_vector Boxed_vec128
+    layout_boxed_vector Boxed_vec128
   | Pbigstring_load_32 { boxed = false; _ }
   | Pstring_load_32 { boxed = false; _ }
   | Pbytes_load_32 { boxed = false; _ } -> layout_unboxed_int Unboxed_int32
@@ -2264,7 +2272,7 @@ let primitive_result_layout (p : primitive) =
   | Pbytes_load_64 { boxed = false; _ } -> layout_unboxed_int Unboxed_int64
   | Pstring_load_128 { boxed = false; _ } | Pbytes_load_128 { boxed = false; _ }
   | Pbigstring_load_128 { boxed = false; _ } ->
-      layout_unboxed_vector Unboxed_vec128
+    layout_unboxed_vector Unboxed_vec128
   | Pfloatarray_load_128 { boxed = true; _ }
   | Pfloat_array_load_128 { boxed = true; _ }
   | Punboxed_float_array_load_128 { boxed = true; _ }
@@ -2273,7 +2281,7 @@ let primitive_result_layout (p : primitive) =
   | Punboxed_int64_array_load_128 { boxed = true; _ }
   | Punboxed_nativeint_array_load_128 { boxed = true; _ }
   | Punboxed_int32_array_load_128 { boxed = true; _ } ->
-      layout_boxed_vector Boxed_vec128
+    layout_boxed_vector Boxed_vec128
   | Pfloatarray_load_128 { boxed = false; _ }
   | Pfloat_array_load_128 { boxed = false; _ }
   | Punboxed_float_array_load_128 { boxed = false; _ }
@@ -2282,35 +2290,35 @@ let primitive_result_layout (p : primitive) =
   | Punboxed_int64_array_load_128 { boxed = false; _ }
   | Punboxed_nativeint_array_load_128 { boxed = false; _ }
   | Punboxed_int32_array_load_128 { boxed = false; _ } ->
-      layout_unboxed_vector Unboxed_vec128
+    layout_unboxed_vector Unboxed_vec128
   | Pbigarrayref (_, _, kind, _) ->
-      begin match kind with
-      | Pbigarray_unknown -> layout_any_value
-      | Pbigarray_float16 | Pbigarray_float32 ->
-        (* float32 bigarrays return 64-bit floats for backward compatibility.
-           Likewise for float16. *)
-        layout_boxed_float Boxed_float64
-      | Pbigarray_float32_t -> layout_boxed_float Boxed_float32
-      | Pbigarray_float64 -> layout_boxed_float Boxed_float64
-      | Pbigarray_sint8 | Pbigarray_uint8
-      | Pbigarray_sint16 | Pbigarray_uint16
-      | Pbigarray_caml_int -> layout_int
-      | Pbigarray_int32 -> layout_boxed_int Boxed_int32
-      | Pbigarray_int64 -> layout_boxed_int Boxed_int64
-      | Pbigarray_native_int -> layout_boxed_int Boxed_nativeint
-      | Pbigarray_complex32 | Pbigarray_complex64 ->
-          layout_block
-      end
+    begin match kind with
+    | Pbigarray_unknown -> layout_any_value
+    | Pbigarray_float16 | Pbigarray_float32 ->
+      (* float32 bigarrays return 64-bit floats for backward compatibility.
+         Likewise for float16. *)
+      layout_boxed_float Boxed_float64
+    | Pbigarray_float32_t -> layout_boxed_float Boxed_float32
+    | Pbigarray_float64 -> layout_boxed_float Boxed_float64
+    | Pbigarray_sint8 | Pbigarray_uint8
+    | Pbigarray_sint16 | Pbigarray_uint16
+    | Pbigarray_caml_int -> layout_int
+    | Pbigarray_int32 -> layout_boxed_int Boxed_int32
+    | Pbigarray_int64 -> layout_boxed_int Boxed_int64
+    | Pbigarray_native_int -> layout_boxed_int Boxed_nativeint
+    | Pbigarray_complex32 | Pbigarray_complex64 ->
+      layout_block
+    end
   | Pctconst (
-      Big_endian | Word_size | Int_size | Max_wosize
-      | Ostype_unix | Ostype_cygwin | Ostype_win32 | Backend_type | Runtime5
-    ) ->
-      (* Compile-time constants only ever return ints for now,
-         enumerate them all to be sure to modify this if it becomes wrong. *)
-      layout_int
+    Big_endian | Word_size | Int_size | Max_wosize
+    | Ostype_unix | Ostype_cygwin | Ostype_win32 | Backend_type | Runtime5
+  ) ->
+    (* Compile-time constants only ever return ints for now,
+       enumerate them all to be sure to modify this if it becomes wrong. *)
+    layout_int
   | Pint_as_pointer _ ->
-      (* CR ncourant: use an unboxed int64 here when it exists *)
-      layout_any_value
+    (* CR ncourant: use an unboxed int64 here when it exists *)
+    layout_any_value
   | (Parray_to_iarray | Parray_of_iarray) -> layout_any_value
   | Pget_header _ -> layout_boxed_int Boxed_nativeint
   | Prunstack | Presume | Pperform | Preperform -> layout_any_value

lambda/lambda.mli

@@ -460,6 +460,8 @@ and flat_element = Types.flat_element =
   | Float_boxed
   | Float64
   | Float32
+  | Bits8
+  | Bits16
   | Bits32
   | Bits64
   | Vec128
@@ -496,6 +498,8 @@ and unboxed_integer = Primitive.unboxed_integer =
   | Unboxed_int64
   | Unboxed_nativeint
   | Unboxed_int32
+  | Unboxed_int16
+  | Unboxed_int8
 
 and unboxed_vector = Primitive.unboxed_vector =
   | Unboxed_vec128

lambda/matching.ml

@@ -2373,7 +2373,7 @@ let get_expr_args_record ~scopes head (arg, _mut, sort, layout) rem =
               else
                 let read =
                   match flat_suffix.(pos - value_prefix_len) with
-                  | Imm | Float64 | Float32 | Bits32 | Bits64 | Vec128 | Word as non_float ->
+                  | Imm | Float64 | Float32 | Bits8 | Bits16 | Bits32 | Bits64 | Vec128 | Word as non_float ->
                       flat_read_non_float non_float
                   | Float_boxed ->
                       (* TODO: could optimise to Alloc_local sometimes *)

lambda/printlambda.ml

@@ -20,6 +20,8 @@ open Types
 open Lambda
 
 let unboxed_integer = function
+  | Unboxed_int8 -> "unboxed_int8"
+  | Unboxed_int16 -> "unboxed_int8"
   | Unboxed_nativeint -> "unboxed_nativeint"
   | Unboxed_int32 -> "unboxed_int32"
   | Unboxed_int64 -> "unboxed_int64"
@@ -137,9 +139,7 @@ let array_ref_kind ppf k =
   | Pfloatarray_ref mode -> fprintf ppf "float%a" pp_mode mode
   | Punboxedfloatarray_ref Unboxed_float64 -> fprintf ppf "unboxed_float"
   | Punboxedfloatarray_ref Unboxed_float32 -> fprintf ppf "unboxed_float32"
-  | Punboxedintarray_ref Unboxed_int32 -> fprintf ppf "unboxed_int32"
-  | Punboxedintarray_ref Unboxed_int64 -> fprintf ppf "unboxed_int64"
-  | Punboxedintarray_ref Unboxed_nativeint -> fprintf ppf "unboxed_nativeint"
+  | Punboxedintarray_ref i -> pp_print_string ppf (unboxed_integer i)
   | Punboxedvectorarray_ref Unboxed_vec128 -> fprintf ppf "unboxed_vec128"
   | Pgcscannableproductarray_ref kinds ->
     fprintf ppf "scannableproduct %s" (scannable_product_element_kinds kinds)
@@ -149,9 +149,7 @@ let array_ref_kind ppf k =
 let array_index_kind ppf k =
   match k with
   | Ptagged_int_index -> fprintf ppf "int"
-  | Punboxed_int_index Unboxed_int32 -> fprintf ppf "unboxed_int32"
-  | Punboxed_int_index Unboxed_int64 -> fprintf ppf "unboxed_int64"
-  | Punboxed_int_index Unboxed_nativeint -> fprintf ppf "unboxed_nativeint"
+  | Punboxed_int_index i -> pp_print_string ppf (unboxed_integer i)
 
 let array_set_kind ppf k =
   let pp_mode ppf = function
@@ -165,9 +163,7 @@ let array_set_kind ppf k =
   | Pfloatarray_set -> fprintf ppf "float"
   | Punboxedfloatarray_set Unboxed_float64 -> fprintf ppf "unboxed_float"
   | Punboxedfloatarray_set Unboxed_float32 -> fprintf ppf "unboxed_float32"
-  | Punboxedintarray_set Unboxed_int32 -> fprintf ppf "unboxed_int32"
-  | Punboxedintarray_set Unboxed_int64 -> fprintf ppf "unboxed_int64"
-  | Punboxedintarray_set Unboxed_nativeint -> fprintf ppf "unboxed_nativeint"
+  | Punboxedintarray_set i -> pp_print_string ppf (unboxed_integer i)
   | Punboxedvectorarray_set Unboxed_vec128 -> fprintf ppf "unboxed_vec128"
   | Pgcscannableproductarray_set (mode, kinds) ->
     fprintf ppf "scannableproduct%a %s" pp_mode mode
@@ -350,6 +346,8 @@ let print_boxed_integer name ppf bi m =
 let unboxed_integer_mark name bi m =
   match bi with
   | Unboxed_nativeint -> Printf.sprintf "Nativeint_u.%s%s" name (locality_kind m)
+  | Unboxed_int8 -> Printf.sprintf "Int8_u.%s%s" name (locality_kind m)
+  | Unboxed_int16 -> Printf.sprintf "Int16_u.%s%s" name (locality_kind m)
   | Unboxed_int32 -> Printf.sprintf "Int32_u.%s%s" name (locality_kind m)
   | Unboxed_int64 -> Printf.sprintf "Int64_u.%s%s" name (locality_kind m)
 

lambda/transl_array_comprehension.ml

@@ -727,10 +727,15 @@ let initial_array ~loc ~array_kind ~array_size ~array_sizing =
       ( Mutable,
         Resizable_array.make ~loc array_kind (unboxed_nativeint Targetint.zero)
       )
+    | _, Punboxedintarray (Unboxed_int8 | Unboxed_int16) ->
+      (* The above cases are not actually allowed/tested yet. *)
+      Misc.fatal_error
+        "Comprehensions on arrays of unboxed small integers are not yet \
+         supported."
     | Dynamic_size, Punboxedvectorarray Unboxed_vec128 ->
       (* The above cases are not actually allowed/tested yet. *)
       Misc.fatal_error
-        "Comprehensions on arrays of unboxed types are not yet supported."
+        "Comprehensions on arrays of unboxed vectors are not yet supported."
     | _, (Pgcscannableproductarray _ | Pgcignorableproductarray _) ->
       Misc.fatal_error
         "Transl_array_comprehension.initial_array: unboxed product array"

middle_end/flambda2/identifiers/int_ids.ml

@@ -44,6 +44,8 @@ module Const_data = struct
     | Tagged_immediate of Targetint_31_63.t
     | Naked_float32 of Numeric_types.Float32_by_bit_pattern.t
     | Naked_float of Numeric_types.Float_by_bit_pattern.t
+    | Naked_int8 of Numeric_types.Int8.t
+    | Naked_int16 of Numeric_types.Int16.t
     | Naked_int32 of Int32.t
     | Naked_int64 of Int64.t
     | Naked_nativeint of Targetint_32_64.t
@@ -77,6 +79,18 @@ module Const_data = struct
           Flambda_colours.naked_number
           Numeric_types.Float_by_bit_pattern.print f
           Flambda_colours.pop
+      | Naked_int8 n ->
+        Format.fprintf ppf "%t#%a%t"
+          Flambda_colours.naked_number
+          Numeric_types.Int8.print
+          n
+          Flambda_colours.pop
+      | Naked_int16 n ->
+        Format.fprintf ppf "%t#%a%t"
+          Flambda_colours.naked_number
+          Numeric_types.Int16.print
+          n
+          Flambda_colours.pop
       | Naked_int32 n ->
         Format.fprintf ppf "%t#%ldl%t"
           Flambda_colours.naked_number
@@ -111,6 +125,8 @@ module Const_data = struct
         Numeric_types.Float32_by_bit_pattern.compare f1 f2
       | Naked_float f1, Naked_float f2 ->
         Numeric_types.Float_by_bit_pattern.compare f1 f2
+      | Naked_int8 n1, Naked_int8 n2 -> Numeric_types.Int8.compare n1 n2
+      | Naked_int16 n1, Naked_int16 n2 -> Numeric_types.Int16.compare n1 n2
       | Naked_int32 n1, Naked_int32 n2 -> Int32.compare n1 n2
       | Naked_int64 n1, Naked_int64 n2 -> Int64.compare n1 n2
       | Naked_nativeint n1, Naked_nativeint n2 -> Targetint_32_64.compare n1 n2
@@ -125,6 +141,10 @@ module Const_data = struct
       | _, Naked_float _ -> 1
       | Naked_float32 _, _ -> -1
       | _, Naked_float32 _ -> 1
+      | Naked_int8 _, _ -> -1
+      | _, Naked_int8 _ -> 1
+      | Naked_int16 _, _ -> -1
+      | _, Naked_int16 _ -> 1
       | Naked_int32 _, _ -> -1
       | _, Naked_int32 _ -> 1
       | Naked_int64 _, _ -> -1
@@ -146,15 +166,17 @@ module Const_data = struct
           Numeric_types.Float32_by_bit_pattern.equal f1 f2
         | Naked_float f1, Naked_float f2 ->
           Numeric_types.Float_by_bit_pattern.equal f1 f2
+        | Naked_int8 n1, Naked_int8 n2 -> Numeric_types.Int8.equal n1 n2
+        | Naked_int16 n1, Naked_int16 n2 -> Numeric_types.Int16.equal n1 n2
         | Naked_int32 n1, Naked_int32 n2 -> Int32.equal n1 n2
         | Naked_int64 n1, Naked_int64 n2 -> Int64.equal n1 n2
         | Naked_nativeint n1, Naked_nativeint n2 -> Targetint_32_64.equal n1 n2
         | Naked_vec128 v1, Naked_vec128 v2 ->
           Vector_types.Vec128.Bit_pattern.equal v1 v2
         | Null, Null -> true
         | ( ( Naked_immediate _ | Tagged_immediate _ | Naked_float _
-            | Naked_float32 _ | Naked_vec128 _ | Naked_int32 _ | Naked_int64 _
-            | Naked_nativeint _ | Null ),
+            | Naked_float32 _ | Naked_vec128 _ | Naked_int8 _ | Naked_int16 _
+            | Naked_int32 _ | Naked_int64 _ | Naked_nativeint _ | Null ),
             _ ) ->
           false
 
@@ -164,6 +186,8 @@ module Const_data = struct
       | Tagged_immediate n -> Targetint_31_63.hash n
       | Naked_float32 n -> Numeric_types.Float32_by_bit_pattern.hash n
       | Naked_float n -> Numeric_types.Float_by_bit_pattern.hash n
+      | Naked_int8 n -> Hashtbl.hash n
+      | Naked_int16 n -> Hashtbl.hash n
       | Naked_int32 n -> Hashtbl.hash n
       | Naked_int64 n -> Hashtbl.hash n
       | Naked_nativeint n -> Targetint_32_64.hash n
@@ -295,6 +319,10 @@ module Const = struct
 
   let naked_float f = create (Naked_float f)
 
+  let naked_int8 i = create (Naked_int8 i)
+
+  let naked_int16 i = create (Naked_int16 i)
+
   let naked_int32 i = create (Naked_int32 i)
 
   let naked_int64 i = create (Naked_int64 i)

middle_end/flambda2/identifiers/int_ids.mli

@@ -58,6 +58,10 @@ module Const : sig
 
   val naked_float : Numeric_types.Float_by_bit_pattern.t -> t
 
+  val naked_int8 : Numeric_types.Int8.t -> t
+
+  val naked_int16 : Numeric_types.Int16.t -> t
+
   val naked_int32 : Int32.t -> t
 
   val naked_int64 : Int64.t -> t
@@ -72,6 +76,8 @@ module Const : sig
       | Tagged_immediate of Targetint_31_63.t
       | Naked_float32 of Numeric_types.Float32_by_bit_pattern.t
       | Naked_float of Numeric_types.Float_by_bit_pattern.t
+      | Naked_int8 of Numeric_types.Int8.t
+      | Naked_int16 of Numeric_types.Int16.t
       | Naked_int32 of Int32.t
       | Naked_int64 of Int64.t
       | Naked_nativeint of Targetint_32_64.t