From bad19930858e443cf87434e7348cf5b9b17adacb Mon Sep 17 00:00:00 2001 From: Jacob Van Buren Date: Thu, 12 Dec 2024 12:19:46 -0500 Subject: [PATCH] added stdlib and conversion primitives --- bytecomp/bytegen.ml | 4 +- lambda/lambda.ml | 7 + lambda/lambda.mli | 2 + lambda/printlambda.ml | 4 + lambda/tmc.ml | 1 + lambda/translprim.ml | 5 + lambda/value_rec_compiler.ml | 2 + .../from_lambda/closure_conversion.ml | 8 +- .../lambda_to_flambda_primitives.ml | 19 ++- otherlibs/stdlib_beta/.ocamlformat-enable | 4 + otherlibs/stdlib_beta/int16_u.ml | 87 +++++++++++ otherlibs/stdlib_beta/int16_u.mli | 146 ++++++++++++++++++ otherlibs/stdlib_beta/int8_u.ml | 87 +++++++++++ otherlibs/stdlib_beta/int8_u.mli | 146 ++++++++++++++++++ otherlibs/stdlib_beta/stdlib_beta.ml | 2 + otherlibs/stdlib_beta/stdlib_beta.mli | 2 + typing/primitive.ml | 8 + 17 files changed, 527 insertions(+), 7 deletions(-) create mode 100644 otherlibs/stdlib_beta/int16_u.ml create mode 100644 otherlibs/stdlib_beta/int16_u.mli create mode 100644 otherlibs/stdlib_beta/int8_u.ml create mode 100644 otherlibs/stdlib_beta/int8_u.mli diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index 88c42154dd2..edf8d13867e 100644 --- a/bytecomp/bytegen.ml +++ b/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], _) -> diff --git a/lambda/lambda.ml b/lambda/lambda.ml index 2b306b6947e..765a6ce6527 100644 --- a/lambda/lambda.ml +++ b/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; _ } -> diff --git a/lambda/lambda.mli b/lambda/lambda.mli index 9f539135bd9..14a1043b77a 100644 --- a/lambda/lambda.mli +++ b/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 diff --git a/lambda/printlambda.ml b/lambda/printlambda.ml index 0c88f6d5b02..27cf862bf6a 100644 --- a/lambda/printlambda.ml +++ b/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" diff --git a/lambda/tmc.ml b/lambda/tmc.ml index 389418f2091..4fdf06287d8 100644 --- a/lambda/tmc.ml +++ b/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 *) diff --git a/lambda/translprim.ml b/lambda/translprim.ml index dd9716be0d7..47009c3b895 100644 --- a/lambda/translprim.ml +++ b/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 diff --git a/lambda/value_rec_compiler.ml b/lambda/value_rec_compiler.ml index b6a7bf4c78b..14facc3a2a2 100644 --- a/lambda/value_rec_compiler.ml +++ b/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 _ diff --git a/middle_end/flambda2/from_lambda/closure_conversion.ml b/middle_end/flambda2/from_lambda/closure_conversion.ml index ea9f7363d6b..f81d32eb9b1 100644 --- a/middle_end/flambda2/from_lambda/closure_conversion.ml +++ b/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 *) diff --git a/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml b/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml index bbf4bde884b..1c2897b3dce 100644 --- a/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml +++ b/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 ), ([] | _ :: _ :: _ | [([] | _ :: _ :: _)]) ) -> diff --git a/otherlibs/stdlib_beta/.ocamlformat-enable b/otherlibs/stdlib_beta/.ocamlformat-enable index 6a5f81486bb..faaf4fcd888 100644 --- a/otherlibs/stdlib_beta/.ocamlformat-enable +++ b/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 diff --git a/otherlibs/stdlib_beta/int16_u.ml b/otherlibs/stdlib_beta/int16_u.ml new file mode 100644 index 00000000000..5eb1ac9044c --- /dev/null +++ b/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) diff --git a/otherlibs/stdlib_beta/int16_u.mli b/otherlibs/stdlib_beta/int16_u.mli new file mode 100644 index 00000000000..62363bc275f --- /dev/null +++ b/otherlibs/stdlib_beta/int16_u.mli @@ -0,0 +1,146 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* The OCaml programmers *) +(* Jacob Van Buren, Jane Street, New York *) +(* *) +(* Copyright 20116 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* 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. *) +(* *) +(**************************************************************************) + +(** Signed 16-bit integer values. + + These integers are {16} bits wide and use two's complement + representation. All operations are taken modulo + 2{^16}. They do not fail on overflow. *) + +(** {1:ints 16-bit Integers} *) + +(** The type for 16-bit integer values. *) +type t = int16# + +(* CR layouts v5: add back all the thunked constants in this module when we + support [bits16]s in structures. *) + +(** 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"] + +(** [int_size] is the number of bits in an integer (i.e., 16). *) +val int_size : int + +(** [zero] is the integer [0]. *) +val zero : unit -> int16# + +(** [one] is the integer [1]. *) +val one : unit -> int16# + +(** [minus_one] is the integer [-1]. *) +val minus_one : unit -> int16# + +(** [neg x] is [~-x]. *) +val neg : int16# -> int16# + +(** [add x y] is the addition [x + y]. *) +val add : int16# -> int16# -> int16# + +(** [sub x y] is the subtraction [x - y]. *) +val sub : int16# -> int16# -> int16# + +(** [mul x y] is the multiplication [x * y]. *) +val mul : int16# -> int16# -> int16# + +(** [div x y] is the division [x / y]. See {!Stdlib.( / )} for details. *) +val div : int16# -> int16# -> int16# + +(** [rem x y] is the remainder [x mod y]. See {!Stdlib.( mod )} for details. *) +val rem : int16# -> int16# -> int16# + +(** [succ x] is [add x 1]. *) +val succ : int16# -> int16# + +(** [pred x] is [sub x 1]. *) +val pred : int16# -> int16# + +(** [abs x] is the absolute value of [x]. That is [x] if [x] is positive + and [neg x] if [x] is negative. {b Warning.} This may be negative if + the argument is {!min_int}. *) +val abs : int16# -> int16# + +(** [max_int] is the greatest representable integer, + [2{^[16 - 1]} - 1]. *) +val max_int : unit -> int16# + +(** [min_int] is the smallest representable integer, + [-2{^[16 - 1]}]. *) +val min_int : unit -> int16# + +(** [logand x y] is the bitwise logical and of [x] and [y]. *) +val logand : int16# -> int16# -> int16# + +(** [logor x y] is the bitwise logical or of [x] and [y]. *) +val logor : int16# -> int16# -> int16# + +(** [logxor x y] is the bitwise logical exclusive or of [x] and [y]. *) +val logxor : int16# -> int16# -> int16# + +(** [lognot x] is the bitwise logical negation of [x]. *) +val lognot : int16# -> int16# + +(** [shift_left x n] shifts [x] to the left by [n] bits. The result + is unspecified if [n < 0] or [n > ]{!16}. *) +val shift_left : int16# -> int -> int16# + +(** [shift_right x n] shifts [x] to the right by [n] bits. This is an + arithmetic shift: the sign bit of [x] is replicated and inserted + in the vacated bits. The result is unspecified if [n < 0] or + [n > ]{!16}. *) +val shift_right : int16# -> int -> int16# + +(** [shift_right x n] shifts [x] to the right by [n] bits. This is a + logical shift: zeroes are inserted in the vacated bits regardless + of the sign of [x]. The result is unspecified if [n < 0] or + [n > ]{!16}. *) +val shift_right_logical : int16# -> int -> int16# + +(** {1:preds Predicates and comparisons} *) + +(** [equal x y] is [true] if and only if [x = y]. *) +val equal : int16# -> int16# -> bool + +(** [compare x y] is {!Stdlib.compare}[ x y] but more efficient. *) +val compare : int16# -> int16# -> int + +(** Return the smaller of the two arguments. *) +val min : int16# -> int16# -> int16# + +(** Return the greater of the two arguments. *) +val max : int16# -> int16# -> int16# + +(** {1:convert Converting} *) + +(** [to_int x] is [x] as an {!int}. *) +val to_int : int16# -> int + +(** [of_int x] represents [x] as an 16-bit integer. *) +val of_int : int -> int16# + +(** [to_float x] is [x] as a floating point number. *) +val to_float : int16# -> float + +(** [of_float x] truncates [x] to an integer. The result is + unspecified if the argument is [nan] or falls outside the range of + representable integers. *) +val of_float : float -> int16# + +(** [to_string x] is the written representation of [x] in decimal. *) +val to_string : int16# -> string diff --git a/otherlibs/stdlib_beta/int8_u.ml b/otherlibs/stdlib_beta/int8_u.ml new file mode 100644 index 00000000000..9b85353d237 --- /dev/null +++ b/otherlibs/stdlib_beta/int8_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 = int8# + +[@@@ocaml.flambda_o3] + +(** Tag a [int8#] *) +external to_int8 : int8# -> int8 = "%tag_int8" [@@warning "-187"] + +(** Untag a tagged [int8] *) +external of_int8 : int8 -> int8# = "%untag_int8" [@@warning "-187"] + +let int_size = Int8.int_size + +let zero () = of_int8 Int8.zero + +let one () = of_int8 Int8.one + +let minus_one () = of_int8 Int8.minus_one + +let max_int () = of_int8 Int8.max_int + +let min_int () = of_int8 Int8.min_int + +let neg x = of_int8 (Int8.neg (to_int8 x)) + +let add x y = of_int8 (Int8.add (to_int8 x) (to_int8 y)) + +let sub x y = of_int8 (Int8.sub (to_int8 x) (to_int8 y)) + +let mul x y = of_int8 (Int8.mul (to_int8 x) (to_int8 y)) + +let div x y = of_int8 (Int8.div (to_int8 x) (to_int8 y)) + +let rem x y = of_int8 (Int8.rem (to_int8 x) (to_int8 y)) + +let succ x = of_int8 (Int8.succ (to_int8 x)) + +let pred x = of_int8 (Int8.pred (to_int8 x)) + +let abs x = of_int8 (Int8.abs (to_int8 x)) + +let logand x y = of_int8 (Int8.logand (to_int8 x) (to_int8 y)) + +let logor x y = of_int8 (Int8.logor (to_int8 x) (to_int8 y)) + +let logxor x y = of_int8 (Int8.logxor (to_int8 x) (to_int8 y)) + +let lognot x = of_int8 (Int8.lognot (to_int8 x)) + +let shift_left x y = of_int8 (Int8.shift_left (to_int8 x) y) + +let shift_right x y = of_int8 (Int8.shift_right (to_int8 x) y) + +let shift_right_logical x y = of_int8 (Int8.shift_right_logical (to_int8 x) y) + +let equal x y = Int8.equal (to_int8 x) (to_int8 y) + +let compare x y = Int8.compare (to_int8 x) (to_int8 y) + +let min x y = of_int8 (Int8.min (to_int8 x) (to_int8 y)) + +let max x y = of_int8 (Int8.max (to_int8 x) (to_int8 y)) + +let of_float f = of_int8 (Int8.of_float f) + +let to_float t = Int8.to_float (to_int8 t) + +let to_string t = Int8.to_string (to_int8 t) + +let to_int t = Int8.to_int (to_int8 t) + +let of_int i = of_int8 (Int8.of_int i) diff --git a/otherlibs/stdlib_beta/int8_u.mli b/otherlibs/stdlib_beta/int8_u.mli new file mode 100644 index 00000000000..d9890b61ebe --- /dev/null +++ b/otherlibs/stdlib_beta/int8_u.mli @@ -0,0 +1,146 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* The OCaml programmers *) +(* Jacob Van Buren, Jane Street, New York *) +(* *) +(* Copyright 2018 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* 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. *) +(* *) +(**************************************************************************) + +(** Signed 8-bit integer values. + + These integers are {8} bits wide and use two's complement + representation. All operations are taken modulo + 2{^8}. They do not fail on overflow. *) + +(** {1:ints 8-bit Integers} *) + +(** The type for 8-bit integer values. *) +type t = int8# + +(* CR layouts v5: add back all the thunked constants in this module when we + support [bits8]s in structures. *) + +(** Tag a [int8#] *) +external to_int8 : int8# -> int8 = "%tag_int8" [@@warning "-187"] + +(** Untag a tagged [int8] *) +external of_int8 : int8 -> int8# = "%untag_int8" [@@warning "-187"] + +(** [int_size] is the number of bits in an integer (i.e., 8). *) +val int_size : int + +(** [zero] is the integer [0]. *) +val zero : unit -> int8# + +(** [one] is the integer [1]. *) +val one : unit -> int8# + +(** [minus_one] is the integer [-1]. *) +val minus_one : unit -> int8# + +(** [neg x] is [~-x]. *) +val neg : int8# -> int8# + +(** [add x y] is the addition [x + y]. *) +val add : int8# -> int8# -> int8# + +(** [sub x y] is the subtraction [x - y]. *) +val sub : int8# -> int8# -> int8# + +(** [mul x y] is the multiplication [x * y]. *) +val mul : int8# -> int8# -> int8# + +(** [div x y] is the division [x / y]. See {!Stdlib.( / )} for details. *) +val div : int8# -> int8# -> int8# + +(** [rem x y] is the remainder [x mod y]. See {!Stdlib.( mod )} for details. *) +val rem : int8# -> int8# -> int8# + +(** [succ x] is [add x 1]. *) +val succ : int8# -> int8# + +(** [pred x] is [sub x 1]. *) +val pred : int8# -> int8# + +(** [abs x] is the absolute value of [x]. That is [x] if [x] is positive + and [neg x] if [x] is negative. {b Warning.} This may be negative if + the argument is {!min_int}. *) +val abs : int8# -> int8# + +(** [max_int] is the greatest representable integer, + [2{^[8 - 1]} - 1]. *) +val max_int : unit -> int8# + +(** [min_int] is the smallest representable integer, + [-2{^[8 - 1]}]. *) +val min_int : unit -> int8# + +(** [logand x y] is the bitwise logical and of [x] and [y]. *) +val logand : int8# -> int8# -> int8# + +(** [logor x y] is the bitwise logical or of [x] and [y]. *) +val logor : int8# -> int8# -> int8# + +(** [logxor x y] is the bitwise logical exclusive or of [x] and [y]. *) +val logxor : int8# -> int8# -> int8# + +(** [lognot x] is the bitwise logical negation of [x]. *) +val lognot : int8# -> int8# + +(** [shift_left x n] shifts [x] to the left by [n] bits. The result + is unspecified if [n < 0] or [n > ]{!8}. *) +val shift_left : int8# -> int -> int8# + +(** [shift_right x n] shifts [x] to the right by [n] bits. This is an + arithmetic shift: the sign bit of [x] is replicated and inserted + in the vacated bits. The result is unspecified if [n < 0] or + [n > ]{!8}. *) +val shift_right : int8# -> int -> int8# + +(** [shift_right x n] shifts [x] to the right by [n] bits. This is a + logical shift: zeroes are inserted in the vacated bits regardless + of the sign of [x]. The result is unspecified if [n < 0] or + [n > ]{!8}. *) +val shift_right_logical : int8# -> int -> int8# + +(** {1:preds Predicates and comparisons} *) + +(** [equal x y] is [true] if and only if [x = y]. *) +val equal : int8# -> int8# -> bool + +(** [compare x y] is {!Stdlib.compare}[ x y] but more efficient. *) +val compare : int8# -> int8# -> int + +(** Return the smaller of the two arguments. *) +val min : int8# -> int8# -> int8# + +(** Return the greater of the two arguments. *) +val max : int8# -> int8# -> int8# + +(** {1:convert Converting} *) + +(** [to_int x] is [x] as an {!int}. *) +val to_int : int8# -> int + +(** [of_int x] represents [x] as an 8-bit integer. *) +val of_int : int -> int8# + +(** [to_float x] is [x] as a floating point number. *) +val to_float : int8# -> float + +(** [of_float x] truncates [x] to an integer. The result is + unspecified if the argument is [nan] or falls outside the range of + representable integers. *) +val of_float : float -> int8# + +(** [to_string x] is the written representation of [x] in decimal. *) +val to_string : int8# -> string diff --git a/otherlibs/stdlib_beta/stdlib_beta.ml b/otherlibs/stdlib_beta/stdlib_beta.ml index d8afd4b7f68..d3ead8bb464 100644 --- a/otherlibs/stdlib_beta/stdlib_beta.ml +++ b/otherlibs/stdlib_beta/stdlib_beta.ml @@ -1,2 +1,4 @@ module Int8 = Int8 +module Int8_u = Int8_u module Int16 = Int16 +module Int16_u = Int16_u diff --git a/otherlibs/stdlib_beta/stdlib_beta.mli b/otherlibs/stdlib_beta/stdlib_beta.mli index d8afd4b7f68..d3ead8bb464 100644 --- a/otherlibs/stdlib_beta/stdlib_beta.mli +++ b/otherlibs/stdlib_beta/stdlib_beta.mli @@ -1,2 +1,4 @@ module Int8 = Int8 +module Int8_u = Int8_u module Int16 = Int16 +module Int16_u = Int16_u diff --git a/typing/primitive.ml b/typing/primitive.ml index f2e4735a2f3..af194fc9cea 100644 --- a/typing/primitive.ml +++ b/typing/primitive.ml @@ -694,6 +694,14 @@ let prim_has_valid_reprs ~loc prim = exactly [Same_as_ocaml_repr C.word; Same_as_ocaml_repr C.value] | "%unbox_nativeint" -> exactly [Same_as_ocaml_repr C.value; Same_as_ocaml_repr C.word] + | "%tag_int8" -> + exactly [Same_as_ocaml_repr C.bits8; Same_as_ocaml_repr C.value] + | "%untag_int8" -> + exactly [Same_as_ocaml_repr C.value; Same_as_ocaml_repr C.bits8] + | "%tag_int16" -> + exactly [Same_as_ocaml_repr C.bits16; Same_as_ocaml_repr C.value] + | "%untag_int16" -> + exactly [Same_as_ocaml_repr C.value; Same_as_ocaml_repr C.bits16] | "%box_int32" -> exactly [Same_as_ocaml_repr C.bits32; Same_as_ocaml_repr C.value] | "%unbox_int32" ->