added stdlib and conversion primitives

bytecomp/bytegen.ml

@@ -146,6 +146,7 @@ let preserve_tailcall_for_prim = function
   | Prunstack | Pperform | Presume | Preperform
   | Pbox_float (_, _) | Punbox_float _
   | Pbox_vector (_, _) | Punbox_vector _
+  | Ptag_int _ | Puntag_int _
   | Pbox_int _ | Punbox_int _ ->
       true
   | Pbytes_to_string | Pbytes_of_string
@@ -726,6 +727,7 @@ let comp_primitive stack_info p sz args =
   | Pmakemixedblock _
   | Pprobe_is_enabled _
   | Punbox_float _ | Pbox_float (_, _) | Punbox_int _ | Pbox_int _
+  | Ptag_int _ | Puntag_int _
     ->
       fatal_error "Bytegen.comp_primitive"
 
@@ -853,7 +855,7 @@ let rec comp_expr stack_info env exp sz cont =
          (comp_expr stack_info
             (add_vars rec_idents (sz+1) env) body (sz + ndecl)
             (add_pop ndecl cont)))
-  | Lprim((Popaque _ | Pobj_magic _), [arg], _) ->
+  | Lprim((Popaque _ | Pobj_magic _ | Ptag_int _ | Puntag_int _), [arg], _) ->
       comp_expr stack_info env arg sz cont
   | Lprim((Pbox_float ((Boxed_float64 | Boxed_float32), _)
   | Punbox_float (Boxed_float64 | Boxed_float32)), [arg], _) ->

lambda/lambda.ml

@@ -315,6 +315,8 @@ type primitive =
   | Pobj_magic of layout
   | Punbox_float of boxed_float
   | Pbox_float of boxed_float * locality_mode
+  | Puntag_int of unboxed_integer
+  | Ptag_int of unboxed_integer
   | Punbox_int of boxed_integer
   | Pbox_int of boxed_integer * locality_mode
   | Punbox_vector of boxed_vector
@@ -1922,6 +1924,7 @@ let primitive_may_allocate : primitive -> locality_mode option = function
   | Pobj_dup -> Some alloc_heap
   | Pobj_magic _ -> None
   | Punbox_float _ | Punbox_int _ | Punbox_vector _ -> None
+  | Ptag_int _ | Puntag_int _ -> None
   | Pbox_float (_, m) | Pbox_int (_, m) | Pbox_vector (_, m) -> Some m
   | Prunstack | Presume | Pperform | Preperform
     (* CR mshinwell: check *)
@@ -2090,6 +2093,8 @@ let primitive_can_raise prim =
   | Pbox_float (_, _)
   | Punbox_float _
   | Pbox_vector (_, _)
+  | Ptag_int _
+  | Puntag_int _
   | Punbox_vector _ | Punbox_int _ | Pbox_int _ | Pmake_unboxed_product _
   | Punboxed_product_field _ | Pget_header _ ->
     false
@@ -2250,6 +2255,8 @@ let primitive_result_layout (p : primitive) =
   | Plslbint (bi, _) | Plsrbint (bi, _) | Pasrbint (bi, _)
   | Pbbswap (bi, _) | Pbox_int (bi, _) ->
     layout_boxed_int bi
+  | Ptag_int _ -> layout_int
+  | Puntag_int i -> layout_unboxed_int i
   | Punbox_int bi -> Punboxed_int (Primitive.unbox_integer bi)
   | Pstring_load_32 { boxed = true; _ } | Pbytes_load_32 { boxed = true; _ }
   | Pbigstring_load_32 { boxed = true; _ } ->

lambda/lambda.mli

@@ -310,6 +310,8 @@ type primitive =
   | Pobj_magic of layout
   | Punbox_float of boxed_float
   | Pbox_float of boxed_float * locality_mode
+  | Puntag_int of unboxed_integer
+  | Ptag_int of unboxed_integer
   | Punbox_int of boxed_integer
   | Pbox_int of boxed_integer * locality_mode
   | Punbox_vector of boxed_vector

lambda/printlambda.ml

@@ -907,6 +907,8 @@ let primitive ppf = function
   | Punbox_int bi -> fprintf ppf "unbox_%s" (boxed_integer bi)
   | Pbox_int (bi, m) ->
       fprintf ppf "box_%s%s" (boxed_integer bi) (locality_kind m)
+  | Puntag_int i -> fprintf ppf "untag_%s" (unboxed_integer i)
+  | Ptag_int i -> fprintf ppf "tag_%s" (unboxed_integer i)
   | Punbox_vector bi -> fprintf ppf "unbox_%s" (boxed_vector bi)
   | Pbox_vector (bi, m) ->
       fprintf ppf "box_%s%s" (boxed_vector bi) (locality_kind m)
@@ -1081,6 +1083,8 @@ let name_of_primitive = function
   | Pobj_magic _ -> "Pobj_magic"
   | Punbox_float _ -> "Punbox_float"
   | Pbox_float (_, _) -> "Pbox_float"
+  | Puntag_int _ -> "Puntag_int"
+  | Ptag_int _ -> "Ptag_int"
   | Punbox_int _ -> "Punbox_int"
   | Pbox_int _ -> "Pbox_int"
   | Punbox_vector _ -> "Punbox_vector"

lambda/tmc.ml

@@ -905,6 +905,7 @@ let rec choice ctx t =
     | Patomic_exchange | Patomic_cas | Patomic_fetch_add | Patomic_load _
     | Punbox_float _ | Pbox_float (_, _)
     | Punbox_int _ | Pbox_int _
+    | Puntag_int _ | Ptag_int _
     | Punbox_vector _ | Pbox_vector (_, _)
 
     (* we don't handle array indices as destinations yet *)

lambda/translprim.ml

@@ -879,6 +879,10 @@ let lookup_primitive loc ~poly_mode ~poly_sort pos p =
     | "%poll" -> Primitive (Ppoll, 1)
     | "%unbox_nativeint" -> Primitive(Punbox_int Boxed_nativeint, 1)
     | "%box_nativeint" -> Primitive(Pbox_int (Boxed_nativeint, mode), 1)
+    | "%untag_int8" -> Primitive(Puntag_int Unboxed_int8, 1)
+    | "%tag_int8" -> Primitive(Ptag_int Unboxed_int8, 1)
+    | "%untag_int16" -> Primitive(Puntag_int Unboxed_int16, 1)
+    | "%tag_int16" -> Primitive(Ptag_int Unboxed_int16, 1)
     | "%unbox_int32" -> Primitive(Punbox_int Boxed_int32, 1)
     | "%box_int32" -> Primitive(Pbox_int (Boxed_int32, mode), 1)
     | "%unbox_int64" -> Primitive(Punbox_int Boxed_int64, 1)
@@ -1797,6 +1801,7 @@ let lambda_primitive_needs_event_after = function
   | Pdls_get
   | Pobj_magic _ | Punbox_float _ | Punbox_int _ | Punbox_vector _
   | Preinterpret_unboxed_int64_as_tagged_int63
+  | Puntag_int _ | Ptag_int _
   (* These don't allocate in bytecode; they're just identity functions: *)
   | Pbox_float (_, _) | Pbox_int _ | Pbox_vector (_, _)
     -> false

lambda/value_rec_compiler.ml

@@ -396,6 +396,8 @@ let compute_static_size lam =
     | Pobj_magic _
     | Punbox_float _
     | Pbox_float (_, _)
+    | Puntag_int _
+    | Ptag_int _
     | Punbox_int _
     | Pbox_int (_, _)
     | Punbox_vector _

middle_end/flambda2/from_lambda/closure_conversion.ml

@@ -1056,10 +1056,10 @@ let close_primitive acc env ~let_bound_ids_with_kinds named
       | Pbox_float (_, _)
       | Punbox_vector _
       | Pbox_vector (_, _)
-      | Punbox_int _ | Pbox_int _ | Pmake_unboxed_product _
-      | Punboxed_product_field _ | Pget_header _ | Prunstack | Pperform
-      | Presume | Preperform | Patomic_exchange | Patomic_cas
-      | Patomic_fetch_add | Pdls_get | Ppoll | Patomic_load _
+      | Puntag_int _ | Ptag_int _ | Punbox_int _ | Pbox_int _
+      | Pmake_unboxed_product _ | Punboxed_product_field _ | Pget_header _
+      | Prunstack | Pperform | Presume | Preperform | Patomic_exchange
+      | Patomic_cas | Patomic_fetch_add | Pdls_get | Ppoll | Patomic_load _
       | Preinterpret_tagged_int63_as_unboxed_int64
       | Preinterpret_unboxed_int64_as_tagged_int63 ->
         (* Inconsistent with outer match *)

middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml

@@ -1650,6 +1650,20 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
             ( Naked_vec128,
               Alloc_mode.For_allocations.from_lambda mode ~current_region ),
           arg ) ]
+  | Puntag_int dst, [[arg]] ->
+    [ Unary
+        ( Num_conv
+            { src = Tagged_immediate;
+              dst = standard_int_or_float_of_unboxed_integer dst
+            },
+          arg ) ]
+  | Ptag_int src, [[arg]] ->
+    [ Unary
+        ( Num_conv
+            { src = standard_int_or_float_of_unboxed_integer src;
+              dst = Tagged_immediate
+            },
+          arg ) ]
   | Punbox_int bi, [[arg]] ->
     let kind = boxable_number_of_boxed_integer bi in
     [Unary (Unbox_number kind, arg)]
@@ -2379,8 +2393,9 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
       | Pbox_float (_, _)
       | Punbox_vector _
       | Pbox_vector (_, _)
-      | Punbox_int _ | Pbox_int _ | Punboxed_product_field _ | Pget_header _
-      | Pufloatfield _ | Patomic_load _ | Pmixedfield _
+      | Puntag_int _ | Ptag_int _ | Punbox_int _ | Pbox_int _
+      | Punboxed_product_field _ | Pget_header _ | Pufloatfield _
+      | Patomic_load _ | Pmixedfield _
       | Preinterpret_unboxed_int64_as_tagged_int63
       | Preinterpret_tagged_int63_as_unboxed_int64 ),
       ([] | _ :: _ :: _ | [([] | _ :: _ :: _)]) ) ->

otherlibs/stdlib_beta/.ocamlformat-enable

@@ -4,3 +4,7 @@ int8.ml
 int8.mli
 int16.ml
 int16.mli
+int8_u.ml
+int8_u.mli
+int16_u.ml
+int16_u.mli

otherlibs/stdlib_beta/int16_u.ml

@@ -0,0 +1,87 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                 Jacob Van Buren, Jane Street, New York                 *)
+(*                                                                        *)
+(*   Copyright 2024 Jane Street Group LLC                                 *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open! Stdlib
+
+type t = int16#
+
+[@@@ocaml.flambda_o3]
+
+(** Tag a [int16#] *)
+external to_int16 : int16# -> int16 = "%tag_int16" [@@warning "-187"]
+
+(** Untag a tagged [int16] *)
+external of_int16 : int16 -> int16# = "%untag_int16" [@@warning "-187"]
+
+let int_size = Int16.int_size
+
+let zero () = of_int16 Int16.zero
+
+let one () = of_int16 Int16.one
+
+let minus_one () = of_int16 Int16.minus_one
+
+let max_int () = of_int16 Int16.max_int
+
+let min_int () = of_int16 Int16.min_int
+
+let neg x = of_int16 (Int16.neg (to_int16 x))
+
+let add x y = of_int16 (Int16.add (to_int16 x) (to_int16 y))
+
+let sub x y = of_int16 (Int16.sub (to_int16 x) (to_int16 y))
+
+let mul x y = of_int16 (Int16.mul (to_int16 x) (to_int16 y))
+
+let div x y = of_int16 (Int16.div (to_int16 x) (to_int16 y))
+
+let rem x y = of_int16 (Int16.rem (to_int16 x) (to_int16 y))
+
+let succ x = of_int16 (Int16.succ (to_int16 x))
+
+let pred x = of_int16 (Int16.pred (to_int16 x))
+
+let abs x = of_int16 (Int16.abs (to_int16 x))
+
+let logand x y = of_int16 (Int16.logand (to_int16 x) (to_int16 y))
+
+let logor x y = of_int16 (Int16.logor (to_int16 x) (to_int16 y))
+
+let logxor x y = of_int16 (Int16.logxor (to_int16 x) (to_int16 y))
+
+let lognot x = of_int16 (Int16.lognot (to_int16 x))
+
+let shift_left x y = of_int16 (Int16.shift_left (to_int16 x) y)
+
+let shift_right x y = of_int16 (Int16.shift_right (to_int16 x) y)
+
+let shift_right_logical x y = of_int16 (Int16.shift_right_logical (to_int16 x) y)
+
+let equal x y = Int16.equal (to_int16 x) (to_int16 y)
+
+let compare x y = Int16.compare (to_int16 x) (to_int16 y)
+
+let min x y = of_int16 (Int16.min (to_int16 x) (to_int16 y))
+
+let max x y = of_int16 (Int16.max (to_int16 x) (to_int16 y))
+
+let of_float f = of_int16 (Int16.of_float f)
+
+let to_float t = Int16.to_float (to_int16 t)
+
+let to_string t = Int16.to_string (to_int16 t)
+
+let to_int t = Int16.to_int (to_int16 t)
+
+let of_int i = of_int16 (Int16.of_int i)