ocaml-flambda · alanechang · Dec 15, 2023 · Jul 28, 2023 · Nov 30, 2023 · Nov 30, 2023
diff --git a/backend/cmm_helpers.ml b/backend/cmm_helpers.ml
@@ -1082,8 +1082,6 @@ module Extended_machtype = struct
 
   let typ_any_int = [| Extended_machtype_component.Any_int |]
 
-  let typ_int64 = [| Extended_machtype_component.Any_int |]
-
   let typ_float = [| Extended_machtype_component.Float |]
 
   let typ_vec128 = [| Extended_machtype_component.Vec128 |]
@@ -3202,12 +3200,6 @@ let emit_gc_roots_table ~symbols cont =
 
 (* Helper functions and values used by Flambda 2. *)
 
-let typ_int64 =
-  match Arch.size_int with
-  | 4 -> [| Cmm.Int; Cmm.Int |]
-  | 8 -> [| Cmm.Int |]
-  | _ -> Misc.fatal_errorf "Unsupported Arch.size_int = %d" Arch.size_int
-
 let void = Ctuple []
 
 let unit ~dbg = Cconst_int (1, dbg)

diff --git a/backend/cmm_helpers.mli b/backend/cmm_helpers.mli
@@ -255,8 +255,6 @@ module Extended_machtype : sig
 
   val typ_any_int : t
 
-  val typ_int64 : t
-
   val typ_float : t
 
   val typ_void : t
@@ -534,9 +532,6 @@ val emit_float_array_constant :
 
 (** {1} Helper functions and values used by Flambda 2. *)
 
-(** An adequate Cmm machtype for an int64 (including on a 32-bit target). *)
-val typ_int64 : Cmm.machtype
-
 (* CR mshinwell: [dbg] should not be optional. *)
 
 (** The void (i.e. empty tuple) cmm value. Not to be confused with [() : unit]. *)

diff --git a/middle_end/flambda2/to_cmm/to_cmm_shared.ml b/middle_end/flambda2/to_cmm/to_cmm_shared.ml
@@ -50,9 +50,9 @@ let machtype_of_kind (kind : Flambda_kind.With_subkind.t) =
     | Value_array | Generic_array ->
       Cmm.typ_val)
   | Naked_number Naked_float -> Cmm.typ_float
-  | Naked_number Naked_int64 -> typ_int64
   | Naked_number Naked_vec128 -> Cmm.typ_vec128
-  | Naked_number (Naked_immediate | Naked_int32 | Naked_nativeint) ->
+  | Naked_number (Naked_immediate | Naked_int32 | Naked_int64 | Naked_nativeint)
+    ->
     Cmm.typ_int
   | Region | Rec_info -> assert false
 
@@ -66,9 +66,9 @@ let extended_machtype_of_kind (kind : Flambda_kind.With_subkind.t) =
     | Value_array | Generic_array ->
       Extended_machtype.typ_val)
   | Naked_number Naked_float -> Extended_machtype.typ_float
-  | Naked_number Naked_int64 -> Extended_machtype.typ_int64
   | Naked_number Naked_vec128 -> Extended_machtype.typ_vec128
-  | Naked_number (Naked_immediate | Naked_int32 | Naked_nativeint) ->
+  | Naked_number (Naked_immediate | Naked_int32 | Naked_int64 | Naked_nativeint)
+    ->
     Extended_machtype.typ_any_int
   | Region | Rec_info -> assert false
 

diff --git a/ocaml/asmcomp/cmm_helpers.ml b/ocaml/asmcomp/cmm_helpers.ml
@@ -910,8 +910,6 @@ module Extended_machtype = struct
 
   let typ_any_int = [| Extended_machtype_component.Any_int |]
 
-  let typ_int64 = [| Extended_machtype_component.Any_int |]
-
   let typ_float = [| Extended_machtype_component.Float |]
 
   let typ_void = [||]

diff --git a/ocaml/asmcomp/cmm_helpers.mli b/ocaml/asmcomp/cmm_helpers.mli
@@ -311,8 +311,6 @@ module Extended_machtype : sig
 
   val typ_any_int : t
 
-  val typ_int64 : t
-
   val typ_float : t
 
   val typ_void : t

diff --git a/ocaml/asmcomp/cmmgen.ml b/ocaml/asmcomp/cmmgen.ml
@@ -355,12 +355,16 @@ let exttype_of_sort (s : Jkind.Sort.const) =
   match s with
   | Value -> XInt
   | Float64 -> XFloat
+  | Word -> XInt
+  | Bits32 -> XInt32
+  | Bits64 -> XInt64
   | Void -> Misc.fatal_error "Cmmgen.exttype_of_sort: void encountered"
 
 let machtype_of_sort (s : Jkind.Sort.const) =
   match s with
   | Value -> typ_val
   | Float64 -> typ_float
+  | Word | Bits32 | Bits64 -> typ_int
   | Void -> Misc.fatal_error "Cmmgen.machtype_of_sort: void encountered"
 
 let is_unboxed_number_cmm ~strict cmm =

diff --git a/ocaml/boot/menhir/parser.ml b/ocaml/boot/menhir/parser.ml
diff --git a/ocaml/boot/ocamlc b/ocaml/boot/ocamlc
diff --git a/ocaml/boot/ocamllex b/ocaml/boot/ocamllex
diff --git a/ocaml/lambda/lambda.ml b/ocaml/lambda/lambda.ml
@@ -729,6 +729,9 @@ let layout_module_field = Pvalue Pgenval
 let layout_functor = Pvalue Pgenval
 let layout_boxed_float = Pvalue Pfloatval
 let layout_unboxed_float = Punboxed_float
+let layout_unboxed_nativeint = Punboxed_int Pnativeint
+let layout_unboxed_int32 = Punboxed_int Pint32
+let layout_unboxed_int64 = Punboxed_int Pint64
 let layout_string = Pvalue Pgenval
 let layout_boxedint bi = Pvalue (Pboxedintval bi)
 
@@ -1560,6 +1563,9 @@ let layout_of_native_repr : Primitive.native_repr -> _ = function
     begin match s with
     | Value -> layout_any_value
     | Float64 -> layout_unboxed_float
+    | Word -> layout_unboxed_nativeint
+    | Bits32 -> layout_unboxed_int32
+    | Bits64 -> layout_unboxed_int64
     | Void -> assert false
     end
 

diff --git a/ocaml/lambda/matching.ml b/ocaml/lambda/matching.ml
@@ -123,7 +123,9 @@ let check_record_field_jkind lbl =
   | Float64, (Record_boxed _ | Record_inlined _
              | Record_unboxed | Record_float) ->
     raise (Error (lbl.lbl_loc, Illegal_record_field Float64))
-  | (Any | Void) as c, _ -> raise (Error (lbl.lbl_loc, Illegal_record_field c))
+  | (Any | Void | Word | Bits32 | Bits64) as c, _ ->
+    (* CR layouts v2.1: support unboxed ints here *)
+    raise (Error (lbl.lbl_loc, Illegal_record_field c))
 
 (*
    Compatibility predicate that considers potential rebindings of constructors

diff --git a/ocaml/lambda/translcore.ml b/ocaml/lambda/translcore.ml
@@ -73,6 +73,9 @@ let check_record_field_sort loc sort repres =
     raise (Error (loc, Illegal_record_field Float64))
   | Void, _ ->
     raise (Error (loc, Illegal_record_field Void))
+  | (Word | Bits32 | Bits64 as const), _ ->
+    (* CR layouts v2.1: support unboxed ints here *)
+    raise (Error (loc, Illegal_record_field const))
 
 (* Forward declaration -- to be filled in by Translmod.transl_module *)
 let transl_module =

diff --git a/ocaml/lambda/translprim.ml b/ocaml/lambda/translprim.ml
@@ -460,6 +460,12 @@ let lookup_primitive loc poly pos p =
     | "%perform" -> Primitive (Pperform, 1)
     | "%resume" -> Primitive (Presume, 3)
     | "%dls_get" -> Primitive (Pdls_get, 1)
+    | "%unbox_nativeint" -> Primitive(Punbox_int Pnativeint, 1)
+    | "%box_nativeint" -> Primitive(Pbox_int (Pnativeint, mode), 1)
+    | "%unbox_int32" -> Primitive(Punbox_int Pint32, 1)
+    | "%box_int32" -> Primitive(Pbox_int (Pint32, mode), 1)
+    | "%unbox_int64" -> Primitive(Punbox_int Pint64, 1)
+    | "%box_int64" -> Primitive(Pbox_int (Pint64, mode), 1)
     | s when String.length s > 0 && s.[0] = '%' ->
        raise(Error(loc, Unknown_builtin_primitive s))
     | _ -> External p

diff --git a/ocaml/parsing/parser.mly b/ocaml/parsing/parser.mly
@@ -999,13 +999,15 @@ let unboxed_float sloc sign (f, m) =
 
 (* Unboxed float type *)
 
-let assert_unboxed_float_type ~loc =
+let assert_unboxed_type ~loc =
     Language_extension.(
       Jane_syntax_parsing.assert_extension_enabled ~loc Layouts Stable)
 
-let unboxed_float_type sloc tys =
-  assert_unboxed_float_type ~loc:(make_loc sloc);
-  Ptyp_constr (mkloc (Lident "float#") (make_loc sloc), tys)
+(* Invariant: [lident] must end with an [Lident] that ends with a ["#"]. *)
+let unboxed_type sloc lident tys =
+  let loc = make_loc sloc in
+  assert_unboxed_type ~loc;
+  Ptyp_constr (mkloc lident loc, tys)
 %}
 
 /* Tokens */
@@ -4408,23 +4410,11 @@ atomic_type:
     | UNDERSCORE
         { Ptyp_any }
     | tys = actual_type_parameters
-      tid = mkrhs(type_longident)
-      HASH_SUFFIX
-        { match tid.txt with
-          | Lident "float" ->
-              let ident_start = fst $loc(tid) in
-              let hash_end = snd $loc($3) in
-              unboxed_float_type (ident_start, hash_end) tys
-          | _ ->
-            (* CR layouts v2.1: We should avoid [not_expecting] in long-lived
-               code. When we support unboxed types other than float, we should
-               consider moving this check into the typechecker.
-            *)
-              not_expecting $sloc "Unboxed type other than float#"
-        }
+      tid = mkrhs(type_unboxed_longident)
+        { unboxed_type $loc(tid) tid.txt tys }
     | tys = actual_type_parameters
       tid = mkrhs(type_longident)
-        { Ptyp_constr(tid, tys) } %prec below_HASH
+        { Ptyp_constr(tid, tys) }
     | LESS meth_list GREATER
         { let (f, c) = $2 in Ptyp_object (f, c) }
     | LESS GREATER
@@ -4676,8 +4666,17 @@ val_longident:
 label_longident:
     mk_longident(mod_longident, LIDENT) { $1 }
 ;
+type_trailing_no_hash:
+  LIDENT  { $1 } %prec below_HASH
+;
+type_trailing_hash:
+  LIDENT HASH_SUFFIX  { $1 ^ "#" }
+;
 type_longident:
-    mk_longident(mod_ext_longident, LIDENT)  { $1 }
+    mk_longident(mod_ext_longident, type_trailing_no_hash)  { $1 }
+;
+type_unboxed_longident:
+    mk_longident(mod_ext_longident, type_trailing_hash)  { $1 }
 ;
 
 mod_longident:

diff --git a/ocaml/stdlib/.depend b/ocaml/stdlib/.depend
@@ -522,6 +522,16 @@ stdlib__Int32.cmx : int32.ml \
     stdlib__Int32.cmi
 stdlib__Int32.cmi : int32.mli \
     stdlib.cmi
+stdlib__Int32_u.cmo : int32_u.ml \
+    stdlib.cmi \
+    stdlib__Int32.cmi \
+    stdlib__Int32_u.cmi
+stdlib__Int32_u.cmx : int32_u.ml \
+    stdlib.cmx \
+    stdlib__Int32.cmx \
+    stdlib__Int32_u.cmi
+stdlib__Int32_u.cmi : int32_u.mli \
+    stdlib.cmi
 stdlib__Int64.cmo : int64.ml \
     stdlib.cmi \
     stdlib__Int64.cmi
@@ -530,6 +540,16 @@ stdlib__Int64.cmx : int64.ml \
     stdlib__Int64.cmi
 stdlib__Int64.cmi : int64.mli \
     stdlib.cmi
+stdlib__Int64_u.cmo : int64_u.ml \
+    stdlib.cmi \
+    stdlib__Int64.cmi \
+    stdlib__Int64_u.cmi
+stdlib__Int64_u.cmx : int64_u.ml \
+    stdlib.cmx \
+    stdlib__Int64.cmx \
+    stdlib__Int64_u.cmi
+stdlib__Int64_u.cmi : int64_u.mli \
+    stdlib.cmi
 stdlib__Lazy.cmo : lazy.ml \
     stdlib.cmi \
     stdlib__Obj.cmi \
@@ -645,6 +665,16 @@ stdlib__Nativeint.cmx : nativeint.ml \
     stdlib__Nativeint.cmi
 stdlib__Nativeint.cmi : nativeint.mli \
     stdlib.cmi
+stdlib__Nativeint_u.cmo : nativeint_u.ml \
+    stdlib.cmi \
+    stdlib__Nativeint.cmi \
+    stdlib__Nativeint_u.cmi
+stdlib__Nativeint_u.cmx : nativeint_u.ml \
+    stdlib.cmx \
+    stdlib__Nativeint.cmx \
+    stdlib__Nativeint_u.cmi
+stdlib__Nativeint_u.cmi : nativeint_u.mli \
+    stdlib.cmi
 stdlib__Obj.cmo : obj.ml \
     stdlib__Sys.cmi \
     stdlib.cmi \

diff --git a/ocaml/stdlib/Makefile b/ocaml/stdlib/Makefile
@@ -208,27 +208,27 @@ stdlib.cmx: stdlib.ml
 	 -pp "$(AWK) -f ./expand_module_aliases.awk" -c $<
 
 
-# special cases to add the extension flag when compiling float_u
+# special cases to add the extension flag when compiling float_u etc.
 # CR layouts: eventually these can be just [-extension layouts]
-stdlib__Float_u.cmi:
+stdlib__%_u.cmi:
 	$(CAMLC) $(COMPFLAGS) -extension layouts_alpha \
 	         -o $@ -c $(filter %.mli, $^)
 
-stdlib__Float_u.cmo:
+stdlib__%_u.cmo:
 	$(CAMLC) $(COMPFLAGS) -extension layouts_alpha \
 	         -o $@ -c $(filter %.ml, $^)
 
-stdlib__Float_u.cmx:
+stdlib__%_u.cmx:
 	$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -extension layouts_alpha \
 	           -o $@ -c $(filter %.ml, $^)
 
-float_u.cmi: %.mli
+%_u.cmi: %_u.mli
 	$(CAMLC) $(COMPFLAGS) -extension layouts_alpha -c $<
 
-float_u.cmo: %.ml
+%_u.cmo: %_u.ml
 	$(CAMLC) $(COMPFLAGS) -extension layouts_alpha -c $<
 
-float_u.cmx: %.ml
+%_u.cmx: %_u.ml
 	$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -extension layouts_alpha -c $<
 
 %.cmi: %.mli

diff --git a/ocaml/stdlib/StdlibModules b/ocaml/stdlib/StdlibModules
@@ -61,8 +61,11 @@ STDLIB_MODULE_BASENAMES = \
   float \
   float_u \
   int32 \
+  int32_u \
   int64 \
+  int64_u \
   nativeint \
+  nativeint_u \
   lexing \
   parsing \
   set \

diff --git a/ocaml/stdlib/dune b/ocaml/stdlib/dune
@@ -142,8 +142,12 @@
   int.mli
   int32.ml
   int32.mli
+  int32_u.ml
+  int32_u.mli
   int64.ml
   int64.mli
+  int64_u.ml
+  int64_u.mli
   lazy.ml
   lazy.mli
   lexing.ml
@@ -162,6 +166,8 @@
   mutex.mli
   nativeint.ml
   nativeint.mli
+  nativeint_u.ml
+  nativeint_u.mli
   obj.ml
   obj.mli
   oo.ml
@@ -301,9 +307,15 @@
   .stdlib.objs/byte/stdlib__Int32.cmi
   .stdlib.objs/byte/stdlib__Int32.cmt
   .stdlib.objs/byte/stdlib__Int32.cmti
+  .stdlib.objs/byte/stdlib__Int32_u.cmi
+  .stdlib.objs/byte/stdlib__Int32_u.cmt
+  .stdlib.objs/byte/stdlib__Int32_u.cmti
   .stdlib.objs/byte/stdlib__Int64.cmi
   .stdlib.objs/byte/stdlib__Int64.cmt
   .stdlib.objs/byte/stdlib__Int64.cmti
+  .stdlib.objs/byte/stdlib__Int64_u.cmi
+  .stdlib.objs/byte/stdlib__Int64_u.cmt
+  .stdlib.objs/byte/stdlib__Int64_u.cmti
   .stdlib.objs/byte/stdlib__Lazy.cmi
   .stdlib.objs/byte/stdlib__Lazy.cmt
   .stdlib.objs/byte/stdlib__Lazy.cmti
@@ -331,6 +343,9 @@
   .stdlib.objs/byte/stdlib__Nativeint.cmi
   .stdlib.objs/byte/stdlib__Nativeint.cmt
   .stdlib.objs/byte/stdlib__Nativeint.cmti
+  .stdlib.objs/byte/stdlib__Nativeint_u.cmi
+  .stdlib.objs/byte/stdlib__Nativeint_u.cmt
+  .stdlib.objs/byte/stdlib__Nativeint_u.cmti
   .stdlib.objs/byte/stdlib__Obj.cmi
   .stdlib.objs/byte/stdlib__Obj.cmt
   .stdlib.objs/byte/stdlib__Obj.cmti
@@ -446,6 +461,7 @@
   .stdlib.objs/native/stdlib__Bigarray.cmx
   .stdlib.objs/native/stdlib__Array.cmx
   .stdlib.objs/native/stdlib__Int32.cmx
+  .stdlib.objs/native/stdlib__Int32_u.cmx
   .stdlib.objs/native/stdlib__Lexing.cmx
   .stdlib.objs/native/stdlib__ArrayLabels.cmx
   .stdlib.objs/native/stdlib__Obj.cmx
@@ -466,6 +482,7 @@
   .stdlib.objs/native/stdlib__Ephemeron.cmx
   .stdlib.objs/native/stdlib__String.cmx
   .stdlib.objs/native/stdlib__Nativeint.cmx
+  .stdlib.objs/native/stdlib__Nativeint_u.cmx
   .stdlib.objs/native/stdlib__Set.cmx
   .stdlib.objs/native/stdlib__ListLabels.cmx
   .stdlib.objs/native/stdlib__Bool.cmx
@@ -474,6 +491,7 @@
   .stdlib.objs/native/stdlib__Random.cmx
   .stdlib.objs/native/stdlib__Int.cmx
   .stdlib.objs/native/stdlib__Int64.cmx
+  .stdlib.objs/native/stdlib__Int64_u.cmx
   .stdlib.objs/native/stdlib__Scanf.cmx
   .stdlib.objs/native/stdlib__Printf.cmx
   .stdlib.objs/native/stdlib__Complex.cmx