diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 642675b0048..bae0b5cdb81 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -78,39 +78,57 @@ jobs:
             config: --enable-middle-end=flambda2 --disable-warn-error
             os: macos-latest
 
+          - name: flambda2_macos_arm64_irc
+            config: --enable-middle-end=flambda2 --disable-warn-error
+            os: macos-latest
+            build_ocamlparam: '_,w=-46,regalloc=irc'
+            ocamlparam: '_,w=-46,regalloc=irc'
+
+          - name: flambda2_macos_arm64_ls
+            config: --enable-middle-end=flambda2 --disable-warn-error
+            os: macos-latest
+            build_ocamlparam: '_,w=-46,regalloc=ls'
+            ocamlparam: '_,w=-46,regalloc=ls'
+
+          - name: flambda2_macos_arm64_gi
+            config: --enable-middle-end=flambda2 --disable-warn-error
+            os: macos-latest
+            build_ocamlparam: '_,w=-46,regalloc=gi'
+            ocamlparam: '_,w=-46,regalloc=gi'
+
           - name: irc
             config: --enable-middle-end=flambda2
             os: ubuntu-latest
-            build_ocamlparam: '_,w=-46,regalloc=irc,regalloc-param=SPLIT_LIVE_RANGES:on,regalloc-param=IRC_SPILLING_HEURISTICS:flat-uses,regalloc-validate=1'
-            ocamlparam: '_,w=-46,regalloc=irc,regalloc-param=SPLIT_LIVE_RANGES:on,regalloc-param=IRC_SPILLING_HEURISTICS:flat-uses,regalloc-validate=1'
+            build_ocamlparam: '_,w=-46,regalloc=irc'
+            ocamlparam: '_,w=-46,regalloc=irc'
             check_arch: true
 
           - name: irc_polling
             config: --enable-middle-end=flambda2 --enable-poll-insertion
             os: ubuntu-latest
-            build_ocamlparam: '_,w=-46,regalloc=irc,regalloc-param=SPLIT_LIVE_RANGES:on,regalloc-param=IRC_SPILLING_HEURISTICS:flat-uses,regalloc-validate=1'
-            ocamlparam: '_,w=-46,regalloc=irc,regalloc-param=SPLIT_LIVE_RANGES:on,regalloc-param=IRC_SPILLING_HEURISTICS:flat-uses,regalloc-validate=1'
+            build_ocamlparam: '_,w=-46,regalloc=irc'
+            ocamlparam: '_,w=-46,regalloc=irc'
             check_arch: true
 
           - name: irc_frame_pointers
             config: --enable-middle-end=flambda2 --enable-frame-pointers
             os: ubuntu-latest
-            build_ocamlparam: '_,w=-46,regalloc=irc,regalloc-param=SPLIT_LIVE_RANGES:on,regalloc-param=IRC_SPILLING_HEURISTICS:flat-uses,regalloc-validate=1'
-            ocamlparam: '_,w=-46,regalloc=irc,regalloc-param=SPLIT_LIVE_RANGES:on,regalloc-param=IRC_SPILLING_HEURISTICS:flat-uses,regalloc-validate=1'
+            build_ocamlparam: '_,w=-46,regalloc=irc'
+            ocamlparam: '_,w=-46,regalloc=irc'
             check_arch: true
 
           - name: ls
             config: --enable-middle-end=flambda2
             os: ubuntu-latest
-            build_ocamlparam: '_,w=-46,regalloc=ls,regalloc-param=SPLIT_LIVE_RANGES:on,regalloc-param=LS_ORDER:layout,regalloc-validate=1'
-            ocamlparam: '_,w=-46,regalloc=ls,regalloc-param=SPLIT_LIVE_RANGES:on,regalloc-param=LS_ORDER:layout,regalloc-validate=1'
+            build_ocamlparam: '_,w=-46,regalloc=ls'
+            ocamlparam: '_,w=-46,regalloc=ls'
             check_arch: true
 
           - name: gi
             config: --enable-middle-end=flambda2
             os: ubuntu-latest
-            build_ocamlparam: '_,w=-46,regalloc=gi,regalloc-param=SPLIT_LIVE_RANGES:on,regalloc-param=GI_PRIORITY_HEURISTICS:interval-length,regalloc-param=GI_SELECTION_HEURISTICS:first-available,regalloc-param=GI_SPILLING_HEURISTICS:flat-uses,regalloc-validate=1,cfg-cse-optimize=1'
-            ocamlparam: '_,w=-46,regalloc=gi,regalloc-param=SPLIT_LIVE_RANGES:on,regalloc-param=GI_PRIORITY_HEURISTICS:interval-length,regalloc-param=GI_SELECTION_HEURISTICS:first-available,regalloc-param=GI_SPILLING_HEURISTICS:flat-uses,regalloc-validate=1,cfg-cse-optimize=1'
+            build_ocamlparam: '_,w=-46,regalloc=gi,cfg-cse-optimize=1'
+            ocamlparam: '_,w=-46,regalloc=gi,cfg-cse-optimize=1'
             check_arch: true
 
           - name: cfg-selection
@@ -120,6 +138,13 @@ jobs:
             ocamlparam: '_,w=-46,regalloc=cfg,cfg-cse-optimize=1,cfg-selection=1,cfg-zero-alloc-checker=1'
             check_arch: true
 
+          - name: vectorizer
+            config: --enable-middle-end=flambda2
+            os: ubuntu-latest
+            build_ocamlparam: '_,w=-46,regalloc=cfg,vectorize=1'
+            ocamlparam: '_,w=-46,regalloc=cfg,vectorize=1'
+            check_arch: true
+
     env:
       J: "3"
       run_testsuite: "true"
@@ -229,11 +254,20 @@ jobs:
           --with-dune=$GITHUB_WORKSPACE/ocaml-414/_install/bin/dune \
           ${{ matrix.config }}
 
+    - name: Setup for saving core files (not for macOS at the moment)
+      if: matrix.os != 'macos-latest'
+      run: |
+        sudo mkdir /cores
+        sudo chmod 777 /cores
+        # Core filenames will be of the form executable.pid.timestamp:
+        sudo bash -c 'echo "/cores/%e.%p.%t" > /proc/sys/kernel/core_pattern'
+
     - name: Build, install and test Flambda backend
       working-directory: flambda_backend
       run: |
         if [ $run_testsuite = true ]; then target=ci; else target=compiler; fi
         export PATH=$GITHUB_WORKSPACE/ocaml-414/_install/bin:$PATH
+        ulimit -c unlimited
         make $target \
           || (if [ $expected_fail = true ]; then exit 0; else exit 1; fi);
       env:
@@ -247,6 +281,25 @@ jobs:
       if: matrix.check_arch == true
       run: |
         PATH=$GITHUB_WORKSPACE/ocaml-414/_install/bin:$PATH make check_all_arches
+
+    - uses: actions/upload-artifact@v3
+      if: ${{ failure() }} && matrix.os != 'macos-latest'
+      with:
+        name: cores
+        path: /cores
+
+    - uses: actions/upload-artifact@v3
+      if: ${{ failure() }} && matrix.os != 'macos-latest'
+      with:
+        name: _build
+        path: $GITHUB_WORKSPACE/_build
+
+    - uses: actions/upload-artifact@v3
+      if: ${{ failure() }} && matrix.os != 'macos-latest'
+      with:
+        name: _runtest
+        path: $GITHUB_WORKSPACE/_runtest
+
 concurrency:
   group: ${{ github.workflow }}-${{ github.head_ref || github.run_id }}
   cancel-in-progress: true
diff --git a/.github/workflows/ocamlformat.yml b/.github/workflows/ocamlformat.yml
index 6436fb783b9..e4e2a479d95 100644
--- a/.github/workflows/ocamlformat.yml
+++ b/.github/workflows/ocamlformat.yml
@@ -21,7 +21,7 @@ jobs:
         path: 'flambda_backend'
 
     - name: Setup OCaml ${{ matrix.ocaml-compiler }}
-      uses: ocaml/setup-ocaml@v2
+      uses: ocaml/setup-ocaml@v3
       with:
         ocaml-compiler: ${{ matrix.ocaml-compiler }}
 
diff --git a/Makefile b/Makefile
index 324f3249b88..13e2765b885 100644
--- a/Makefile
+++ b/Makefile
@@ -87,7 +87,7 @@ promote:
 
 .PHONY: fmt
 fmt:
-	ocamlformat -i $$(find . \( -name "*.ml" -or -name "*.mli" \))
+	find . \( -name "*.ml" -or -name "*.mli" \) | xargs -P $$(nproc 2>/dev/null || echo 1) -n 20 ocamlformat -i
 
 .PHONY: check-fmt
 check-fmt:
diff --git a/backend/amd64/emit.mlp b/backend/amd64/emit.mlp
index fd09de7040f..84f2344d6cc 100644
--- a/backend/amd64/emit.mlp
+++ b/backend/amd64/emit.mlp
@@ -2316,7 +2316,7 @@ let emit_probe_notes0 () =
         Misc.fatal_errorf "Cannot create probe: illegal argument: %a"
           Printreg.reg arg
     in
-    Printf.sprintf "%d@%s" (Reg.size_of_contents_in_bytes arg) arg_name
+    Printf.sprintf "%d@%s" (Select_utils.size_component arg.Reg.typ) arg_name
   in
   let describe_one_probe p =
     let probe_name, enabled_at_init =
diff --git a/backend/amd64/simd_selection.ml b/backend/amd64/simd_selection.ml
index 2955d27e6de..5cac65691bb 100644
--- a/backend/amd64/simd_selection.ml
+++ b/backend/amd64/simd_selection.ml
@@ -491,7 +491,7 @@ let vectorize_operation (width_type : Vectorize_utils.Width_in_bits.t)
           ~res_count operation ]
   in
   let create_const_vec consts =
-    let highs, lows = Misc.Stdlib.List.split_at (length / 2) consts in
+    let lows, highs = Misc.Stdlib.List.split_at (length / 2) consts in
     let pack_int64 nums =
       let mask =
         Int64.shift_right_logical Int64.minus_one (64 - width_in_bits)
@@ -589,13 +589,14 @@ let vectorize_operation (width_type : Vectorize_utils.Width_in_bits.t)
       let sse_op =
         match width_type with
         | W128 -> assert false
-        | W64 -> assert false
-        | W32 -> SRA_i32
-        | W16 -> SRA_i16
-        | W8 -> assert false
+        | W64 -> None
+        | W32 -> Some SRA_i32
+        | W16 -> Some SRA_i16
+        | W8 -> None
       in
-      Operation.Specific (Isimd (SSE2 sse_op))
-      |> make_default ~arg_count ~res_count
+      Option.bind sse_op (fun sse_op ->
+          Operation.Specific (Isimd (SSE2 sse_op))
+          |> make_default ~arg_count ~res_count)
     | Icomp (Isigned intcomp) -> (
       match intcomp with
       | Ceq ->
@@ -702,9 +703,9 @@ let vectorize_operation (width_type : Vectorize_utils.Width_in_bits.t)
       then (
         assert (arg_count = 1 && res_count = 1);
         const_instruction.results.(0)
-          <- Vectorize_utils.Vectorized_instruction.New 0;
+          <- Vectorize_utils.Vectorized_instruction.New_Vec128 0;
         intop_instruction.arguments.(1)
-          <- Vectorize_utils.Vectorized_instruction.New 0;
+          <- Vectorize_utils.Vectorized_instruction.New_Vec128 0;
         Some [const_instruction; intop_instruction])
       else None
     | _ -> None)
@@ -775,8 +776,8 @@ let vectorize_operation (width_type : Vectorize_utils.Width_in_bits.t)
           (* reg + displ *)
           Some
             [ make_move (Argument 0) (Result 0);
-              make_const (New 0) displs;
-              make_binary_operation (Result 0) (New 0) (Result 0) add ]
+              make_const (New_Vec128 0) displs;
+              make_binary_operation (Result 0) (New_Vec128 0) (Result 0) add ]
         | None -> None)
       | Iindexed2 _ -> (
         match add_op with
@@ -787,8 +788,8 @@ let vectorize_operation (width_type : Vectorize_utils.Width_in_bits.t)
           Some
             [ make_move (Argument 0) (Result 0);
               make_binary_operation (Result 0) (Argument 1) (Result 0) add;
-              make_const (New 0) displs;
-              make_binary_operation (Result 0) (New 0) (Result 0) add ]
+              make_const (New_Vec128 0) displs;
+              make_binary_operation (Result 0) (New_Vec128 0) (Result 0) add ]
         | None -> None)
       | Iscaled _ -> (
         match add_op, mul_op with
@@ -799,10 +800,10 @@ let vectorize_operation (width_type : Vectorize_utils.Width_in_bits.t)
           (* reg * scale + displ *)
           Some
             [ make_move (Argument 0) (Result 0);
-              make_const (New 0) scales;
-              make_binary_operation (Result 0) (New 0) (Result 0) mul;
-              make_const (New 1) displs;
-              make_binary_operation (Result 0) (New 1) (Result 0) add ]
+              make_const (New_Vec128 0) scales;
+              make_binary_operation (Result 0) (New_Vec128 0) (Result 0) mul;
+              make_const (New_Vec128 1) displs;
+              make_binary_operation (Result 0) (New_Vec128 1) (Result 0) add ]
         | _ -> None)
       | Iindexed2scaled _ -> (
         match add_op, mul_op with
@@ -813,11 +814,11 @@ let vectorize_operation (width_type : Vectorize_utils.Width_in_bits.t)
           (* reg + reg * scale + displ *)
           Some
             [ make_move (Argument 1) (Result 0);
-              make_const (New 0) scales;
-              make_binary_operation (Result 0) (New 0) (Result 0) mul;
+              make_const (New_Vec128 0) scales;
+              make_binary_operation (Result 0) (New_Vec128 0) (Result 0) mul;
               make_binary_operation (Result 0) (Argument 0) (Result 0) add;
-              make_const (New 1) displs;
-              make_binary_operation (Result 0) (New 1) (Result 0) add ]
+              make_const (New_Vec128 1) displs;
+              make_binary_operation (Result 0) (New_Vec128 1) (Result 0) add ]
         | _ -> None)
       | Ibased _ -> None)
     | Isextend32 -> (
diff --git a/backend/cfg/vectorize.ml b/backend/cfg/vectorize.ml
index a225018a57f..ad5d5362d6a 100644
--- a/backend/cfg/vectorize.ml
+++ b/backend/cfg/vectorize.ml
@@ -2725,10 +2725,32 @@ end = struct
           t1.new_positions t2.new_positions
     }
 
+  (** address registers and vectorizable registers of [t] and [t'] are compatible, i.e.,
+      register [r] used as an address argument in [t] is not replaced by a vectorizable
+      argument in [t'] and vice versa. *)
+  let register_compatible t t' deps =
+    let sub t1 t2 =
+      Instruction.Id.Map.for_all
+        (fun _key g1 ->
+          let scalar_instructions = Group.scalar_instructions g1 in
+          Group.for_all_non_vectorizable_args g1 ~f:(fun ~arg_i ->
+              List.for_all
+                (fun i ->
+                  match
+                    Dependencies.get_direct_dependency_of_arg deps
+                      (Instruction.id i) ~arg_i
+                  with
+                  | None -> true
+                  | Some dep -> not (contains_id t2 dep))
+                scalar_instructions))
+        t1.groups
+    in
+    sub t t' && sub t' t
+
   (** [compatible t t'] returns true if for every group [g] in [t],
       and [g'] in [t'],  [g] and [g'] are equal or have disjoint sets
       of scalar instructions. *)
-  let compatible t t' =
+  let instruction_compatible t t' =
     if Instruction.Id.Set.disjoint t.all_scalar_instructions
          t'.all_scalar_instructions
     then true
@@ -2747,15 +2769,15 @@ end = struct
               (* disjoint groups: if the key is not in t2, then all insts are
                  not in t2. *)
               List.for_all
-                (fun i ->
-                  not
-                    (Instruction.Id.Set.mem (Instruction.id i)
-                       t2.all_scalar_instructions))
+                (fun i -> not (contains t2 i))
                 (Group.scalar_instructions g1))
           t1.groups
       in
       sub t t' && sub t' t
 
+  let compatible t t' deps =
+    instruction_compatible t t' && register_compatible t t' deps
+
   let select_and_join trees block deps =
     match trees with
     | [] -> None
@@ -2767,7 +2789,7 @@ end = struct
         match trees with
         | [] -> acc
         | hd :: tl ->
-          if compatible hd acc
+          if compatible hd acc deps
           then
             let new_acc = join hd acc in
             if compare_cost new_acc acc < 0
@@ -2866,7 +2888,7 @@ let add_vector_instructions_for_group reg_map state group ~before:cell
     let get_register
         (simd_reg : Vectorize_utils.Vectorized_instruction.register) =
       match simd_reg with
-      | New n -> get_new_reg n
+      | New_Vec128 n -> get_new_reg n
       | Argument n ->
         let original_reg = (Instruction.arguments key_instruction).(n) in
         Substitution.get_reg_exn reg_map original_reg
diff --git a/backend/cmm_helpers.ml b/backend/cmm_helpers.ml
index 3931e0eb7c6..5d2bbf94d65 100644
--- a/backend/cmm_helpers.ml
+++ b/backend/cmm_helpers.ml
@@ -802,9 +802,10 @@ let box_float32 dbg mode exp =
 
 let unbox_float32 dbg =
   map_tail ~kind:Any (function
-    | Cop (Calloc _, [Cconst_natint (hdr, _); _ops; c], _)
-      when Nativeint.equal hdr boxedfloat32_header
-           || Nativeint.equal hdr boxedfloat32_local_header ->
+    | Cop (Calloc _, [Cconst_natint (hdr, _); Cconst_symbol (sym, _); c], _)
+      when (Nativeint.equal hdr boxedfloat32_header
+           || Nativeint.equal hdr boxedfloat32_local_header)
+           && String.equal sym.sym_name caml_float32_ops ->
       c
     | Cconst_symbol (s, _dbg) as cmm -> (
       match Cmmgen_state.structured_constant_of_sym s.sym_name with
diff --git a/backend/printreg.ml b/backend/printreg.ml
index 68f7e51d670..74967756835 100644
--- a/backend/printreg.ml
+++ b/backend/printreg.ml
@@ -63,6 +63,8 @@ let regs' ?(print_reg = reg) ppf v =
 
 let regs ppf v = regs' ppf v
 
+let reglist ppf l = Format.pp_print_list ~pp_sep:pp_print_space reg ppf l
+
 let regset ppf s =
   let first = ref true in
   Set.iter
diff --git a/backend/printreg.mli b/backend/printreg.mli
index fa1979970b8..9857dcaf8a9 100644
--- a/backend/printreg.mli
+++ b/backend/printreg.mli
@@ -37,6 +37,8 @@ val regs : Format.formatter -> Reg.t array -> unit
 
 val regset : Format.formatter -> Reg.Set.t -> unit
 
+val reglist : Format.formatter -> Reg.t list -> unit
+
 val regsetaddr' :
   ?print_reg:(Format.formatter -> Reg.t -> unit) ->
   Format.formatter ->
diff --git a/backend/reg.ml b/backend/reg.ml
index 78077b04e78..e1c9cb18efc 100644
--- a/backend/reg.ml
+++ b/backend/reg.ml
@@ -193,18 +193,6 @@ let is_reg t =
   | Reg _ -> true
   | _ -> false
 
-let size_of_contents_in_bytes t =
-  match t.typ with
-  | Vec128 -> Arch.size_vec128
-  | Float -> Arch.size_float
-  | Float32 ->
-    assert (Arch.size_float = 8);
-    Arch.size_float / 2
-  | Addr ->
-    assert (Arch.size_addr = Arch.size_int);
-    Arch.size_addr
-  | Int | Val -> Arch.size_int
-
 let reset() =
   (* When reset() is called for the first time, the current stamp reflects
      all hard pseudo-registers that have been allocated by Proc, so
diff --git a/backend/reg.mli b/backend/reg.mli
index 328f4e7e7a1..663780add11 100644
--- a/backend/reg.mli
+++ b/backend/reg.mli
@@ -102,8 +102,6 @@ val name : t -> string
 val is_reg : t -> bool
 val is_stack :  t -> bool
 
-val size_of_contents_in_bytes : t -> int
-
 module Set: Set.S with type elt = t
 module Map: Map.S with type key = t
 module Tbl: Hashtbl.S with type key = t
diff --git a/backend/regalloc/regalloc_gi.ml b/backend/regalloc/regalloc_gi.ml
index 260fcdf9169..c35b1c5a490 100644
--- a/backend/regalloc/regalloc_gi.ml
+++ b/backend/regalloc/regalloc_gi.ml
@@ -83,13 +83,15 @@ let make_hardware_registers_and_prio_queue (cfg_with_infos : Cfg_with_infos.t) :
   Reg.Tbl.iter
     (fun reg interval ->
       match reg.loc with
-      | Reg _ ->
+      | Reg _ -> (
         if gi_debug
         then (
           log ~indent:1 "pre-assigned register %a" Printreg.reg reg;
           log ~indent:2 "%a" Interval.print interval);
-        let hardware_reg = Hardware_registers.of_reg hardware_registers reg in
-        Hardware_register.add_non_evictable hardware_reg reg interval
+        match Hardware_registers.of_reg hardware_registers reg with
+        | None -> ()
+        | Some hardware_reg ->
+          Hardware_register.add_non_evictable hardware_reg reg interval)
       | Unknown ->
         let priority = priority_heuristics reg interval in
         if gi_debug
diff --git a/backend/regalloc/regalloc_gi_utils.ml b/backend/regalloc/regalloc_gi_utils.ml
index e2a146f43a0..5b5dd62d1bc 100644
--- a/backend/regalloc/regalloc_gi_utils.ml
+++ b/backend/regalloc/regalloc_gi_utils.ml
@@ -596,14 +596,16 @@ module Hardware_registers = struct
               assigned = []
             }))
 
-  let of_reg (t : t) (reg : Reg.t) : Hardware_register.t =
+  let of_reg (t : t) (reg : Reg.t) : Hardware_register.t option =
     match reg.loc with
     | Reg reg_index ->
       let reg_class : int = Proc.register_class reg in
       let reg_index_in_class : int =
         reg_index - Proc.first_available_register.(reg_class)
       in
-      t.(reg_class).(reg_index_in_class)
+      if reg_index_in_class < Array.length t.(reg_class)
+      then Some t.(reg_class).(reg_index_in_class)
+      else None
     | Unknown -> fatal "`Unknown` location (expected `Reg _`)"
     | Stack _ -> fatal "`Stack _` location (expected `Reg _`)"
 
diff --git a/backend/regalloc/regalloc_gi_utils.mli b/backend/regalloc/regalloc_gi_utils.mli
index dfa910db19d..11e8c8b6ce1 100644
--- a/backend/regalloc/regalloc_gi_utils.mli
+++ b/backend/regalloc/regalloc_gi_utils.mli
@@ -190,7 +190,7 @@ module Hardware_registers : sig
 
   val make : unit -> t
 
-  val of_reg : t -> Reg.t -> Hardware_register.t
+  val of_reg : t -> Reg.t -> Hardware_register.t option
 
   val find_available : t -> Reg.t -> Interval.t -> available
 end
diff --git a/backend/regalloc/regalloc_irc.ml b/backend/regalloc/regalloc_irc.ml
index 8f54ecc04ed..fac94b4bd7b 100644
--- a/backend/regalloc/regalloc_irc.ml
+++ b/backend/regalloc/regalloc_irc.ml
@@ -4,36 +4,32 @@ open! Regalloc_utils
 open! Regalloc_irc_utils
 module State = Regalloc_irc_state
 
-(* Remove the frame pointer from the passed array if present, returning the
-   passed array otherwise *)
-let filter_fp : Reg.t array -> Reg.t array =
+let filter_unavailable : Reg.t array -> Reg.t array =
  fun regs ->
-  let is_fp (reg : Reg.t) : bool =
+  let is_available (reg : Reg.t) : bool =
     match reg.loc with
-    | Unknown -> false
+    | Unknown -> true
     | Reg r ->
       let reg_class = Proc.register_class reg in
       r - Proc.first_available_register.(reg_class)
-      >= Proc.num_available_registers.(reg_class)
-    | Stack _ -> false
+      < Proc.num_available_registers.(reg_class)
+    | Stack _ -> true
   in
-  let len = Array.length regs in
-  let idx = ref 0 in
-  while !idx < len && not (is_fp regs.(!idx)) do
-    incr idx
-  done;
-  if !idx >= len
+  let num_available =
+    Array.fold_left regs ~init:0 ~f:(fun acc reg ->
+        if is_available reg then succ acc else acc)
+  in
+  if num_available = Array.length regs
   then regs
-  else if len = 1
-  then [||]
   else
-    let new_regs = Array.make (pred len) regs.(0) in
-    Array.blit ~src:regs ~src_pos:0 ~dst:new_regs ~dst_pos:0 ~len:!idx;
-    Array.blit ~src:regs ~src_pos:(succ !idx) ~dst:new_regs ~dst_pos:!idx
-      ~len:(len - !idx - 1);
-    new_regs
-
-let filter_fp regs = if Config.with_frame_pointers then filter_fp regs else regs
+    let res = Array.make num_available Reg.dummy in
+    let idx = ref 0 in
+    Array.iter regs ~f:(fun reg ->
+        if is_available reg
+        then (
+          res.(!idx) <- reg;
+          incr idx));
+    res
 
 let build : State.t -> Cfg_with_infos.t -> unit =
  fun state cfg_with_infos ->
@@ -41,7 +37,7 @@ let build : State.t -> Cfg_with_infos.t -> unit =
   let liveness = Cfg_with_infos.liveness cfg_with_infos in
   let add_edges_live (id : Instruction.id) ~(def : Reg.t array)
       ~(move_src : Reg.t) ~(destroyed : Reg.t array) : unit =
-    let destroyed = filter_fp destroyed in
+    let destroyed = filter_unavailable destroyed in
     let live = Cfg_dataflow.Instr.Tbl.find liveness id in
     if irc_debug && Reg.set_has_collisions live.across
     then fatal "live set has physical register collisions";
@@ -91,8 +87,8 @@ let build : State.t -> Cfg_with_infos.t -> unit =
         let live = Cfg_dataflow.Instr.Tbl.find liveness first_id in
         Reg.Set.iter
           (fun reg1 ->
-            Array.iter (filter_fp Proc.destroyed_at_raise) ~f:(fun reg2 ->
-                State.add_edge state reg1 reg2))
+            Array.iter (filter_unavailable Proc.destroyed_at_raise)
+              ~f:(fun reg2 -> State.add_edge state reg1 reg2))
           (Reg.Set.remove Proc.loc_exn_bucket live.before))
 
 let make_work_list : State.t -> unit =
diff --git a/backend/select_utils.ml b/backend/select_utils.ml
index 6b56f570f3d..3387ce669af 100644
--- a/backend/select_utils.ml
+++ b/backend/select_utils.ml
@@ -208,6 +208,8 @@ let oper_result_type = function
 (* Infer the size in bytes of the result of an expression whose evaluation may
    be deferred (cf. [emit_parts]). *)
 
+(* [size_component] is placed here and not in [Cmm] to avoid cyclic
+   dependencies, because it uses [Arch]. *)
 let size_component : machtype_component -> int = function
   | Val | Addr -> Arch.size_addr
   | Int -> Arch.size_int
diff --git a/backend/vectorize_utils.ml b/backend/vectorize_utils.ml
index f119306bbe8..83b88112ae3 100644
--- a/backend/vectorize_utils.ml
+++ b/backend/vectorize_utils.ml
@@ -76,7 +76,7 @@ end
 
 module Vectorized_instruction = struct
   type register =
-    | New of int
+    | New_Vec128 of int
     | Argument of int
     | Result of int
     | Original of int
diff --git a/backend/vectorize_utils.mli b/backend/vectorize_utils.mli
index 43e6961f35a..f3bfe8fda72 100644
--- a/backend/vectorize_utils.mli
+++ b/backend/vectorize_utils.mli
@@ -59,7 +59,7 @@ module Vectorized_instruction : sig
   (** Registers used in vectorized instructions of one scalar instruction
      group. *)
   type register =
-    | New of int
+    | New_Vec128 of int
         (** The n-th new temporary register used in the vectorized instructions *)
     | Argument of int
         (** Vector version of the n-th argument's register of the scalar
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index 73b0160071f..3691b1f0515 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -755,7 +755,30 @@ module Storer =
    cont = list of instructions to execute afterwards
    Result = list of instructions that evaluate exp, then perform cont. *)
 
-let rec comp_expr stack_info env exp sz cont =
+(* We cannot use the [float32] type in the compiler. *)
+external float32_is_stage1 : unit -> bool = "caml_float32_is_stage1"
+external float32_of_string : string -> Obj.t = "caml_float32_of_string"
+
+let rec contains_float32s = function
+  | Const_base (Const_float32 _ | Const_unboxed_float32 _) -> true
+  | Const_block (_, fields) -> List.exists contains_float32s fields
+  | Const_mixed_block _ ->  Misc.fatal_error "[Const_mixed_block] not supported in bytecode."
+  | _ -> false
+
+let rec translate_float32s stack_info env cst sz cont =
+  match cst with
+  | Const_base (Const_float32 f | Const_unboxed_float32 f) ->
+    let i = float32_of_string f in
+    Kconst (Const_base (Const_int32 (Obj.obj i))) ::
+    Kccall("caml_float32_of_bits_bytecode", 1) :: cont
+  | Const_block (tag, fields) as cst when contains_float32s cst ->
+    let fields = List.map (fun field -> Lconst field) fields in
+    let cont = Kmakeblock (List.length fields, tag) :: cont in
+    comp_args stack_info env fields sz cont
+  | Const_mixed_block _ -> Misc.fatal_error "[Const_mixed_block] not supported in bytecode."
+  | _ as cst -> Kconst cst :: cont
+
+and comp_expr stack_info env exp sz cont =
   check_stack stack_info sz;
   match exp with
     Lvar id | Lmutvar id ->
@@ -776,6 +799,8 @@ let rec comp_expr stack_info env exp sz cont =
           Koffsetclosure(pos - env_pos) :: cont
         | exception Not_found -> not_found ()
       end
+  | Lconst cst when float32_is_stage1 () ->
+      translate_float32s stack_info env cst sz cont
   | Lconst cst ->
       Kconst cst :: cont
   | Lapply{ap_func = func; ap_args = args; ap_region_close = rc} ->
diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml
index eccebf4d8b8..9e43ec781eb 100644
--- a/bytecomp/symtable.ml
+++ b/bytecomp/symtable.ml
@@ -268,8 +268,8 @@ let patch_object buff patchlist =
 
 (* Translate structured constants *)
 
-(* We cannot use the [float32] type in the compiler, so we represent it as an
-   opaque [Obj.t]. This is sufficient for interfacing with the runtime. *)
+(* We cannot use the [float32] type in the compiler. *)
+external float32_is_stage1 : unit -> bool = "caml_float32_is_stage1"
 external float32_of_string : string -> Obj.t = "caml_float32_of_string"
 
 let rec transl_const = function
@@ -277,7 +277,10 @@ let rec transl_const = function
   | Const_base(Const_char c) -> Obj.repr c
   | Const_base(Const_string (s, _, _)) -> Obj.repr s
   | Const_base(Const_float32 f)
-  | Const_base(Const_unboxed_float32 f) -> float32_of_string f
+  | Const_base(Const_unboxed_float32 f) ->
+      if float32_is_stage1 ()
+      then Misc.fatal_error "The stage one bytecode compiler should not produce float32 constants."
+      else Obj.repr (float32_of_string f)
   | Const_base(Const_float f)
   | Const_base(Const_unboxed_float f) -> Obj.repr (float_of_string f)
   | Const_base(Const_int32 i)
diff --git a/driver/flambda_backend_args.ml b/driver/flambda_backend_args.ml
index 44ade683f79..1e2458562dd 100644
--- a/driver/flambda_backend_args.ml
+++ b/driver/flambda_backend_args.ml
@@ -1365,6 +1365,7 @@ module Extra_params = struct
     | "regalloc-param" -> add_string Flambda_backend_flags.regalloc_params
     | "regalloc-validate" -> set' Flambda_backend_flags.regalloc_validate
     | "vectorize" -> set' Flambda_backend_flags.vectorize
+    | "dump-vectorize" -> set' Flambda_backend_flags.dump_vectorize
     | "vectorize-max-block-size" -> set_int' Flambda_backend_flags.vectorize_max_block_size
     | "cfg-selection" -> set' Flambda_backend_flags.cfg_selection
     | "cfg-peephole-optimize" -> set' Flambda_backend_flags.cfg_peephole_optimize
diff --git a/flambda-backend/tests/backend/vectorizer/dune.inc b/flambda-backend/tests/backend/vectorizer/dune.inc
index 64efbe74dc1..67a51f80bb5 100644
--- a/flambda-backend/tests/backend/vectorizer/dune.inc
+++ b/flambda-backend/tests/backend/vectorizer/dune.inc
@@ -46,7 +46,8 @@
  (action
   (with-outputs-to
    %{target}
-   (run %{deps}))))
+   (with-accepted-exit-codes 0
+    (run %{deps})))))
 
 (rule
  (alias runtest)
@@ -73,3 +74,79 @@
  (enabled_if (= %{context_name} "main"))
  (action
    (diff test1_vectorized.expected test1_vectorized.output)))
+
+(rule
+ (alias   runtest)
+ (enabled_if (= %{context_name} "main"))
+ (targets test_register_compatible_runner.exe test_register_compatible.cmx.dump)
+ (deps test_register_compatible.mli test_register_compatible.ml)
+ (action (run %{bin:ocamlopt.opt} %{deps} -S -O3 -g -dump-into-file -dcfg -dvectorize -dsel -dlinear -dlive -regalloc cfg -extension simd -no-vectorize -o test_register_compatible_runner.exe)))
+
+(rule
+ (alias   runtest)
+ (enabled_if (= %{context_name} "main"))
+ (action
+  (with-outputs-to
+   test_register_compatible.output
+   (run ./test_register_compatible_runner.exe))))
+
+(rule
+ (alias runtest)
+ (enabled_if (= %{context_name} "main"))
+ (action
+   (diff test_register_compatible.expected test_register_compatible.output)))
+
+(rule
+ (alias runtest)
+ (enabled_if (= %{context_name} "main"))
+ (action
+  (copy test_register_compatible.ml test_register_compatible_vectorized.ml)))
+
+(rule
+ (alias runtest)
+ (enabled_if (= %{context_name} "main"))
+ (action
+  (copy test_register_compatible.mli test_register_compatible_vectorized.mli)))
+
+(rule
+ (alias   runtest)
+ (enabled_if (= %{context_name} "main"))
+ (targets test_register_compatible_vectorized_runner.exe test_register_compatible_vectorized.cmx.dump)
+ (deps test_register_compatible_vectorized.mli test_register_compatible_vectorized.ml)
+ (action (run %{bin:ocamlopt.opt} %{deps} -S -O3 -g -dump-into-file -dcfg -dvectorize -dsel -dlinear -dlive -regalloc cfg -extension simd -vectorize -o test_register_compatible_vectorized_runner.exe)))
+
+(rule
+ (enabled_if (and (= %{context_name} "main") (= %{architecture} "amd64")) )
+ (target test_register_compatible_vectorized.cmx.dump.output)
+ (deps ./filter.sh test_register_compatible_vectorized.cmx.dump)
+ (action
+  (with-outputs-to
+   %{target}
+   (with-accepted-exit-codes 1
+    (run %{deps})))))
+
+(rule
+ (alias runtest)
+ (enabled_if (and (= %{context_name} "main") (= %{architecture} "amd64")) )
+ (action
+   (diff test_register_compatible_vectorized.cmx.dump.expected test_register_compatible_vectorized.cmx.dump.output)))
+
+(rule
+ (alias   runtest)
+ (enabled_if (= %{context_name} "main"))
+ (action
+  (with-outputs-to
+   test_register_compatible_vectorized.output
+   (run ./test_register_compatible_vectorized_runner.exe))))
+
+(rule
+ (alias runtest)
+ (enabled_if (= %{context_name} "main"))
+ (action
+  (copy test_register_compatible.expected test_register_compatible_vectorized.expected)))
+
+(rule
+ (alias runtest)
+ (enabled_if (= %{context_name} "main"))
+ (action
+   (diff test_register_compatible_vectorized.expected test_register_compatible_vectorized.output)))
diff --git a/flambda-backend/tests/backend/vectorizer/gen/gen_dune.ml b/flambda-backend/tests/backend/vectorizer/gen/gen_dune.ml
index 54784707a27..53062d52b9f 100644
--- a/flambda-backend/tests/backend/vectorizer/gen/gen_dune.ml
+++ b/flambda-backend/tests/backend/vectorizer/gen/gen_dune.ml
@@ -98,9 +98,10 @@ let copy_file ~enabled_if name new_name =
   (copy ${source} ${target})))
 |}
 
-let filter_dump ~enabled_if name =
+let filter_dump ~enabled_if ~exit_code name =
   let subst = function
     | "enabled_if" -> enabled_if
+    | "exit_code" -> string_of_int exit_code
     | "dump" -> name |> cmx_dump
     | "filtered" -> name |> cmx_dump |> output
     | _ -> assert false
@@ -114,7 +115,8 @@ let filter_dump ~enabled_if name =
  (action
   (with-outputs-to
    %{target}
-   (run %{deps}))))
+   (with-accepted-exit-codes ${exit_code}
+    (run %{deps})))))
 |}
 
 let copy_source_to_vectorize name =
@@ -130,8 +132,8 @@ let compile_with_vectorizer name =
   compile ~enabled_if:enabled_if_main ~extra_flags:"-vectorize"
     (vectorized name)
 
-let filter_vectorizer_dump ~enabled_if name =
-  filter_dump ~enabled_if (name |> vectorized)
+let filter_vectorizer_dump ~enabled_if ~exit_code name =
+  filter_dump ~enabled_if ~exit_code (name |> vectorized)
 
 let diff_vectorizer_dump ~enabled_if name =
   diff_output ~enabled_if (name |> vectorized |> cmx_dump)
@@ -150,7 +152,7 @@ let copy_expected_output name =
   copy_file ~enabled_if:enabled_if_main (name |> expected)
     (name |> vectorized |> expected)
 
-let print_test name =
+let print_test ?(filter_exit_code = 0) name =
   (* check expected test output is up to date *)
   compile_no_vectorizer name;
   run_no_vectorizer name;
@@ -158,11 +160,16 @@ let print_test name =
   (* vectorizer *)
   copy_source_to_vectorize name;
   compile_with_vectorizer name;
-  filter_vectorizer_dump name ~enabled_if:enabled_if_main_amd64;
+  filter_vectorizer_dump name ~exit_code:filter_exit_code
+    ~enabled_if:enabled_if_main_amd64;
   diff_vectorizer_dump name ~enabled_if:enabled_if_main_amd64;
   run_vectorized name;
   copy_expected_output name;
   diff_output_vectorized name;
   ()
 
-let () = print_test "test1"
+let () =
+  print_test "test1";
+  (* can't vectorize *)
+  print_test ~filter_exit_code:1 "test_register_compatible";
+  ()
diff --git a/flambda-backend/tests/backend/vectorizer/test_register_compatible.expected b/flambda-backend/tests/backend/vectorizer/test_register_compatible.expected
new file mode 100644
index 00000000000..033dec12b51
--- /dev/null
+++ b/flambda-backend/tests/backend/vectorizer/test_register_compatible.expected
@@ -0,0 +1 @@
+make 8 8
diff --git a/flambda-backend/tests/backend/vectorizer/test_register_compatible.ml b/flambda-backend/tests/backend/vectorizer/test_register_compatible.ml
new file mode 100644
index 00000000000..479f326d936
--- /dev/null
+++ b/flambda-backend/tests/backend/vectorizer/test_register_compatible.ml
@@ -0,0 +1,70 @@
+(* Cannot vectorize this example because different candidate computations use
+   the same register as both address and non-address arguments. *)
+type s =
+  | A
+  | B
+
+type fn = int -> int
+
+type r =
+  { c1 : fn;
+    c2 : fn
+  }
+
+type t =
+  { d1 : int;
+    d2 : int;
+    d3 : int;
+    d4 : r;
+    d5 : r;
+    d6 : int
+  }
+
+type r' =
+  { b0 : s;
+    b1 : r;
+    b2 : r
+  }
+
+type t' =
+  { a1 : fn;
+    a2 : fn;
+    a3 : fn;
+    a4 : fn;
+    a5 : s;
+    a6 : r;
+    a7 : r;
+    a8 : r'
+  }
+
+let b0 = Sys.opaque_identity A
+
+let[@inline never] [@local never] [@specialize never] make t =
+  let d4 = t.d4 in
+  let d5 = t.d5 in
+  let r' = { b1 = d4; b2 = d5; b0 } in
+  { a1 = d4.c1;
+    a2 = d4.c2;
+    a3 = d5.c1;
+    a4 = d5.c2;
+    a5 = Sys.opaque_identity A;
+    a6 = d4;
+    a7 = d5;
+    a8 = r'
+  }
+
+let print ppf t' = Format.fprintf ppf "%d %d"
+
+let () =
+  let t =
+    { d1 = 1;
+      d2 = 2;
+      d3 = 3;
+      d4 = { c1 = Int.add 1; c2 = Int.mul 3 };
+      d5 = { c1 = Int.add 2; c2 = Int.mul 4 };
+      d6 = 6
+    }
+  in
+  let res = make t in
+  let i = Sys.opaque_identity 7 in
+  Format.printf "make %d %d\n" (res.a1 i) (res.a6.c1 i)
diff --git a/flambda-backend/tests/backend/vectorizer/test_register_compatible.mli b/flambda-backend/tests/backend/vectorizer/test_register_compatible.mli
new file mode 100644
index 00000000000..5b909d90a8c
--- /dev/null
+++ b/flambda-backend/tests/backend/vectorizer/test_register_compatible.mli
@@ -0,0 +1 @@
+(* blank, make sure all the functions are called from top-level *)
diff --git a/flambda-backend/tests/small_numbers/float32_builtin.ml b/flambda-backend/tests/small_numbers/float32_builtin.ml
index dbaaffbb125..4697ce7a363 100644
--- a/flambda-backend/tests/small_numbers/float32_builtin.ml
+++ b/flambda-backend/tests/small_numbers/float32_builtin.ml
@@ -54,6 +54,8 @@ end
 module CFloat32 = struct
   type t = float32
 
+  external is_boxed_float32 : t -> bool = "float32_is_boxed_float32" [@@noalloc]
+
   external bits_to_int : (t [@unboxed]) -> (int32 [@unboxed]) = "float32_bits_to_int_boxed" "float32_bits_to_int" [@@noalloc]
 
   external zero : unit -> (t [@unboxed]) = "float32_zero_boxed" "float32_zero" [@@noalloc]
@@ -313,3 +315,24 @@ let () = (* Literals *)
   check 0x8p+124s 0x8p+124;
   ()
 ;;
+
+type v =
+  | A of float32 * float * int
+  | B of int * (float32 * float32)
+
+let check f32 f64 = assert (CFloat32.is_boxed_float32 f32 && f32 = Float32.of_float f64)
+
+let () = (* Static constants *)
+  let x = Sys.opaque_identity 1.0s in
+  check x 1.0;
+  let block = Sys.opaque_identity ((0.0, 123), 2.0s, "hello", (3.0s, 4.0)) in
+  let (_, x, _, (y, _)) = block in
+  check x 2.0;
+  check y 3.0;
+  let block = Sys.opaque_identity (B (0, (5.0s, 6.0s))) in
+  match block with
+  | A _ -> assert false
+  | B (_, (x, y)) ->
+    check x 5.0;
+    check y 6.0
+;;
diff --git a/flambda-backend/tests/small_numbers/float32_lib.ml b/flambda-backend/tests/small_numbers/float32_lib.ml
index fedc7e296ef..352c5986288 100644
--- a/flambda-backend/tests/small_numbers/float32_lib.ml
+++ b/flambda-backend/tests/small_numbers/float32_lib.ml
@@ -9,6 +9,8 @@ module F32 = Stdlib_stable.Float32
 module CF32 = struct
   type t = float32
 
+  external is_boxed_float32 : t -> bool = "float32_is_boxed_float32" [@@noalloc]
+
   external to_bits : (t [@unboxed]) -> (int32 [@unboxed]) = "float32_bits_to_int_boxed" "float32_bits_to_int" [@@noalloc]
 
   external of_int : (int [@untagged]) -> (t [@unboxed]) = "float32_of_int_boxed" "float32_of_int" [@@noalloc]
@@ -165,7 +167,17 @@ let () =
   bit_eq F32.pi CF32.pi;
   bit_eq F32.min_float CF32.minv;
   bit_eq F32.max_float CF32.maxv;
-  bit_eq F32.epsilon CF32.epsilon
+  bit_eq F32.epsilon CF32.epsilon;
+  assert (CF32.is_boxed_float32 F32.zero);
+  assert (CF32.is_boxed_float32 F32.one);
+  assert (CF32.is_boxed_float32 F32.minus_one);
+  assert (CF32.is_boxed_float32 F32.infinity);
+  assert (CF32.is_boxed_float32 F32.neg_infinity);
+  assert (CF32.is_boxed_float32 F32.nan);
+  assert (CF32.is_boxed_float32 F32.pi);
+  assert (CF32.is_boxed_float32 F32.min_float);
+  assert (CF32.is_boxed_float32 F32.max_float);
+  assert (CF32.is_boxed_float32 F32.epsilon);
 ;;
 
 let () =
diff --git a/flambda-backend/tests/small_numbers/stubs.c b/flambda-backend/tests/small_numbers/stubs.c
index 561d1c9559c..688442ed9e0 100644
--- a/flambda-backend/tests/small_numbers/stubs.c
+++ b/flambda-backend/tests/small_numbers/stubs.c
@@ -2,8 +2,14 @@
 #include <caml/float32.h>
 #include <caml/alloc.h>
 #include <caml/memory.h>
+#include <caml/custom.h>
 #include <float.h>
 #include <math.h>
+#include <string.h>
+
+value float32_is_boxed_float32(value f) {
+    return Val_bool(strcmp(Custom_ops_val(f)->identifier, "_f32") == 0);
+}
 
 int32_t float32_bits_to_int(float f) { return *(int32_t *)&f; }
 float float32_of_int(intnat i) { return (float)i; }
diff --git a/jane/doc/extensions/modes/reference.md b/jane/doc/extensions/modes/reference.md
new file mode 100644
index 00000000000..0df097c5056
--- /dev/null
+++ b/jane/doc/extensions/modes/reference.md
@@ -0,0 +1,42 @@
+The goal of this document is to be a reasonably complete reference to the mode system in
+OCaml.
+
+<!-- CR zqian: For a gentler introduction, see [the introduction](intro.md). -->
+
+The mode system in the compiler tracks various properties of values, so that certain
+performance-enhancing operations can be performed safely. For example:
+- Locality tracks escaping. See [the local allocations reference](../local/reference.md)
+- Uniqueness and linearity tracks aliasing. See [the uniqueness reference](../uniqueness/reference.md)
+- Portability and contention tracks inter-thread sharing.
+    <!-- CR zqian: reference for portability and contention -->
+
+# Lazy
+`lazy e` contains a thunk that evaluates `e`, as well as a mutable cell to store the
+result of `e`. Upon construction, the mode of `lazy e` cannot be stronger than `e`. For
+example, if `e` is `nonportable`, then `lazy e` cannot be `portable`. Upon destruction
+(forcing a lazy value), the result cannot be stronger than the mode of lazy value. For
+example, forcing a `nonportable` lazy value cannot give a `portable` result. Additionally,
+forcing a lazy value involves accessing the mutable cell and thus requires the lazy value
+to be `uncontended`.
+
+Currently, the above rules don't apply to the locality axis, because both the result and
+the lazy value are heap-allocated, so they are always `global`.
+
+Additionally, upon construction, the comonadic fragment of `lazy e` cannot be stronger
+than the thunk. The thunk is checked as `fun () -> e`, potentially closing over variables,
+which weakens its comonadic fragment. This rule doesn't apply to several axes:
+- The thunk is always heap-allocated so always `global`.
+- Since the thunk is only evaluated if the lazy value is `uncontended`, one can construct
+a lazy value at `portable` even if the thunk is `nonportable` (e.g., closing over
+`uncontended` or `nonportable` values). For example, the following is allowed:
+```ocaml
+let r = ref 0 in
+let l @ portable = lazy (r := 42) in
+```
+- Since the thunk runs at most once even if the lazy value is forced multiple times, one
+can construct the lazy value at `many` even if the thunk is `once` (e.g., closing over
+`unique` or `once` values). For example, the following is allowed:
+```ocaml
+let r = { x = 0 } in
+let l @ many = lazy (overwrite_ r with { x = 42 })
+```
diff --git a/jane/doc/extensions/unboxed-types/index.md b/jane/doc/extensions/unboxed-types/index.md
index 2680d92a41e..27b7c30a7ec 100644
--- a/jane/doc/extensions/unboxed-types/index.md
+++ b/jane/doc/extensions/unboxed-types/index.md
@@ -225,31 +225,52 @@ modules in the `janestreet_shims` library.)
 The unboxed product layout describes types that work like normal products (e.g.,
 tuples or records), but which are represented without a box.
 
-In OCaml, a tuple is a pointer to a block containg the elements of the tuple. If
+In OCaml, a tuple is a pointer to a block containing the elements of the tuple. If
 you pass a tuple to a function, it is passed by reference in one register. The
-function can access the tuple's elements through the pointer. By contrast, an
+function can access the tuple's elements through the pointer. Records and
+their fields are treated similarly. By contrast, an
 unboxed product does not refer to a block at all. When used as a function
 argument or return type, its elements are passed separately in their own
-registers, with no indirection (or on the call stack, if the tuple has more
+registers, with no indirection (or on the call stack, if the product has more
 elements than there are available registers).
 
-Currently the only types that have unboxed product layouts are *unboxed tuples*.
-Unboxed tuples are written `#(...)`. So, for example, you can write:
+Currently, types that have unboxed product layouts are *unboxed tuples* and
+*unboxed records*.
+
+Unboxed tuples are written `#(...)`, and may have labels just like normal tuples.
+So, for example, you can write:
 ```ocaml
 module Flipper : sig
-  val flip : #(int * float# * string) -> #(string * float# * int)
+  val flip : #(int * float# * lbl:string) -> #(lbl:string * float# * int)
 end = struct
-  let flip #(x,y,z) = #(z,y,x)
+  let flip #(x,y,~lbl:z) = #(~lbl:z,y,x)
 end
 ```
-Unboxed tuples may have labels just like normal tuples. There are no limitations
-on the layouts of the elements of unboxed tuples, and they may be nested within
-themselves.
-
-*Limitations and future plans*: Unboxed tuples may not currently placed in
-blocks. We plan to lift this restriction in the near future. We also plan to add
-other types with unboxed product layouts (e.g., unboxed records and interior
-pointers).
+
+Unboxed records are defined, constructed, and matched on like normal records, but with
+a leading hash. For example:
+```ocaml
+type t = #{ f : float# ; s : string }
+let inc #{ f ; s } = #{ f = Float_u.add f #1.0 ; s }
+```
+
+The field names of unboxed records occupy a different namespace from the
+field names of "normal" (including `[@@unboxed]`) records.
+
+Unboxed tuples and records may be nested within other unboxed tuples and records.
+There are no limitations on the layouts of the elements of unboxed tuples, but the fields
+of unboxed records must be representable.
+
+*Limitations and future plans*:
+- Unboxed products may not currently placed in blocks.
+  We plan to lift this restriction in the near future.
+- Unboxed record fields may not be mutable.
+  We plan to allow mutating unboxed records within boxed records
+  (the design will differ from boxed record mutability, as unboxed types don't have the
+  same notion of identity).
+- Unboxed record fields must be representable.
+  We plan to lift this restriction in the future.
+- We plan to add other types with unboxed product layouts (e.g., interior pointers).
 
 # The `any` layout
 
diff --git a/lambda/matching.ml b/lambda/matching.ml
index 4fec43277d4..09357f8d312 100644
--- a/lambda/matching.ml
+++ b/lambda/matching.ml
@@ -1965,6 +1965,8 @@ let get_expr_args_constr ~scopes head (arg, _mut, sort, layout) rem =
           cstr.cstr_args
         @ rem
     | Variant_unboxed -> (arg, str, sort, layout) :: rem
+    | Variant_with_null ->
+      Misc.fatal_error "[Variant_with_null] not implemented yet"
     | Variant_extensible ->
         List.mapi
           (fun i { ca_sort } ->
@@ -2379,6 +2381,7 @@ let get_expr_args_record ~scopes head (arg, _mut, sort, layout) rem =
             in
             Lprim (Pmixedfield (lbl.lbl_pos, read, shape, sem), [ arg ], loc),
             lbl.lbl_sort, lbl_layout
+        | Record_inlined (_, _, Variant_with_null) -> assert false
       in
       let str = if Types.is_mutable lbl.lbl_mut then StrictOpt else Alias in
       let str = add_barrier_to_let_kind ubr str in
@@ -3197,8 +3200,9 @@ let split_cases tag_lambda_list =
           ((runtime_tag, act) :: consts, nonconsts)
         | Ordinary {runtime_tag}, Variant_boxed _ ->
           (consts, (runtime_tag, act) :: nonconsts)
-        | _, Variant_extensible -> assert false
+        | _, (Variant_extensible | Variant_with_null) -> assert false
         | Extension _, _ -> assert false
+        | Null, _ -> Misc.fatal_error "[Null] constructors not implemented"
       )
   in
   let const, nonconst = split_rec tag_lambda_list in
@@ -3222,7 +3226,7 @@ let split_extension_cases tag_lambda_list =
        match cstr_constant, cstr_tag with
        | true, Extension path -> Left (path, act)
        | false, Extension path -> Right (path, act)
-       | _, Ordinary _ -> assert false)
+       | _, (Ordinary _ | Null) -> assert false)
     tag_lambda_list
 
 let transl_match_on_option value_kind arg loc ~if_some ~if_none =
diff --git a/lambda/translcore.ml b/lambda/translcore.ml
index c27d89d16d4..5712986a93d 100644
--- a/lambda/translcore.ml
+++ b/lambda/translcore.ml
@@ -536,6 +536,9 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
         | [x] -> x
         | _ -> assert false
       end else begin match cstr.cstr_tag, cstr.cstr_repr with
+      | Null, _ -> Misc.fatal_error "[Null] constructors not implemented yet"
+      | Ordinary _, Variant_with_null ->
+        Misc.fatal_error "[Variant_with_null] not implemented yet"
       | Ordinary {runtime_tag}, _ when cstr.cstr_constant ->
           assert (args_with_sorts = []);
           (* CR layouts v5: This could have void args, but for now we've ruled
@@ -609,7 +612,7 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
                   Pmakemixedblock(0, Immutable, shape, alloc_mode)
             in
             Lprim (makeblock, lam :: ll, of_location ~scopes e.exp_loc)
-      | Extension _, (Variant_boxed _ | Variant_unboxed)
+      | Extension _, (Variant_boxed _ | Variant_unboxed | Variant_with_null)
       | Ordinary _, Variant_extensible -> assert false
       end
   | Texp_extension_constructor (_, path) ->
@@ -697,6 +700,7 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
           in
           Lprim (Pmixedfield (lbl.lbl_pos, read, shape, sem), [targ],
                   of_location ~scopes e.exp_loc)
+        | Record_inlined (_, _, Variant_with_null) -> assert false
       end
   | Texp_unboxed_field(arg, arg_sort, _id, lbl, _) ->
     begin match lbl.lbl_repres with
@@ -752,7 +756,8 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
              { value_prefix_len; flat_suffix }
            in
            Psetmixedfield(lbl.lbl_pos, write, shape, mode)
-        end
+          end
+        | Record_inlined (_, _, Variant_with_null) -> assert false
       in
       Lprim(access, [transl_exp ~scopes Jkind.Sort.Const.for_record arg;
                      transl_exp ~scopes lbl.lbl_sort newval],
@@ -1921,6 +1926,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
                 Psetmixedfield
                   (lbl.lbl_pos, write, shape, Assignment modify_heap)
               end
+            | Record_inlined (_, _, Variant_with_null) -> assert false
           in
           Lsequence(Lprim(upd, [Lvar copy_id;
                                 transl_exp ~scopes lbl.lbl_sort expr],
@@ -1994,6 +2000,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
                      { value_prefix_len; flat_suffix }
                    in
                    Pmixedfield (i, read, shape, sem)
+                 | Record_inlined (_, _, Variant_with_null) -> assert false
                in
                Lprim(access, [Lvar init_id],
                      of_location ~scopes loc),
@@ -2036,8 +2043,8 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
                blocks containing unboxed float literals.
             *)
             raise Not_constant
-        | Record_inlined (_, _, Variant_extensible)
-        | Record_inlined (Extension _, _, _) ->
+        | Record_inlined (_, _, (Variant_extensible | Variant_with_null))
+        | Record_inlined ((Extension _ | Null), _, _) ->
             raise Not_constant
       with Not_constant ->
         let loc = of_location ~scopes loc in
@@ -2081,6 +2088,8 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
             let shape = transl_mixed_product_shape shape in
             Lprim (Pmakemixedblock (runtime_tag, mut, shape, Option.get mode),
                    ll, loc)
+        | Record_inlined (_, _, Variant_with_null) -> assert false
+        | Record_inlined (Null, _, _) -> assert false
     in
     begin match opt_init_expr with
       None -> lam
diff --git a/lambda/value_rec_compiler.ml b/lambda/value_rec_compiler.ml
index 51568107cf6..be935829918 100644
--- a/lambda/value_rec_compiler.ml
+++ b/lambda/value_rec_compiler.ml
@@ -237,7 +237,8 @@ let compute_static_size lam =
                           (Variant_boxed _ | Variant_extensible))
         | Record_mixed shape ->
             Block (Mixed_record (size, Lambda.transl_mixed_product_shape shape))
-        | Record_unboxed | Record_ufloat | Record_inlined (_, _, Variant_unboxed) ->
+        | Record_unboxed | Record_ufloat
+        | Record_inlined (_, _, (Variant_unboxed | Variant_with_null)) ->
             Misc.fatal_error "size_of_primitive"
         end
     | Pmakeblock _ ->
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 3cc3cf9d30a..a87be38e3f8 100644
--- a/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml
+++ b/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml
@@ -1496,8 +1496,12 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
           (* CR layouts v5.9: support this *)
           Misc.fatal_error "Mixed blocks extensible variants are not supported")
       | Record_inlined (Extension _, _, _)
-      | Record_inlined (Ordinary _, _, (Variant_unboxed | Variant_extensible))
-      | Record_unboxed ->
+      | Record_inlined
+          ( Ordinary _,
+            _,
+            (Variant_unboxed | Variant_extensible | Variant_with_null) )
+      | Record_unboxed
+      | Record_inlined (Null, _, _) ->
         Misc.fatal_errorf "Cannot handle record kind for Pduprecord: %a"
           Printlambda.primitive prim
     in
diff --git a/middle_end/flambda2/numbers/floats/float32_stubs.c b/middle_end/flambda2/numbers/floats/float32_stubs.c
index f99c6d848cc..dc950a20f47 100644
--- a/middle_end/flambda2/numbers/floats/float32_stubs.c
+++ b/middle_end/flambda2/numbers/floats/float32_stubs.c
@@ -335,9 +335,14 @@ CAMLprim value compiler_float32_format(value fmt, value arg)
   return res;
 }
 
-// These replace the OCaml runtime versions for use under ocaml/ in the dune build.
-// They must have the same name as in the runtime because building ocaml/ with the
-// upstream build system calls it by name.
+// These replace the OCaml runtime versions for use in the stage one compiler.
+// They must be weak symbols with the same names as in runtime/ because the stage
+// two compiler will link against runtime/.
+
+CAMLweakdef value caml_float32_is_stage1(value v) {
+  (void)v;
+  return Val_true;
+}
 
 CAMLweakdef value caml_float32_of_string(value vs) {
   return compiler_float32_of_string(vs);
diff --git a/otherlibs/stdlib_alpha/capsule.ml b/otherlibs/stdlib_alpha/capsule.ml
index 73d1bee4777..a760d466109 100644
--- a/otherlibs/stdlib_alpha/capsule.ml
+++ b/otherlibs/stdlib_alpha/capsule.ml
@@ -85,6 +85,8 @@ module Password : sig
      [void] can't be used for function argument and return types yet. *)
   type 'k t : value mod portable many unique uncontended
 
+  type packed = P : 'k t -> packed
+
   (* Can break the soundness of the API. *)
   val unsafe_mk : 'k Name.t -> 'k t @@ portable
   val name : 'k t @ local -> 'k Name.t @@ portable
@@ -103,6 +105,8 @@ module Password : sig
 end = struct
   type 'k t = 'k Name.t
 
+  type packed = P : 'k t -> packed
+
   let unsafe_mk name = name
   let name t = t
 
@@ -120,9 +124,8 @@ end
 (* Like [Stdlib.raise], but [portable], and the value
    it never returns is also [portable] *)
 external reraise : exn -> 'a @ portable @@ portable = "%reraise"
-
-external raise_with_backtrace :
-  exn -> Printexc.raw_backtrace -> 'a @ portable @@ portable = "%raise_with_backtrace"
+external raise_with_backtrace: exn -> Printexc.raw_backtrace -> 'a @ portable @@ portable = "%raise_with_backtrace"
+external get_raw_backtrace: unit -> Printexc.raw_backtrace @@ portable = "caml_get_exception_raw_backtrace"
 
 module Data = struct
   type ('a, 'k) t : value mod portable uncontended
@@ -141,11 +144,14 @@ module Data = struct
 
   let create f = unsafe_mk (f ())
 
+  (* CR-soon mslater/tdelvecchio: copying the backtrace at each reraise can cause quadratic
+     behavior when propagating the exception through nested handlers. This should use a
+     new reraise-with-current-backtrace primitive that doesn't do the copy. *)
   let reraise_encapsulated password exn =
-    reraise (Encapsulated (Password.name password, unsafe_mk exn))
+    raise_with_backtrace (Encapsulated (Password.name password, unsafe_mk exn)) (get_raw_backtrace ())
 
   let reraise_encapsulated_shared password exn =
-    reraise (Encapsulated (Password.Shared.name password, unsafe_mk exn))
+    raise_with_backtrace (Encapsulated (Password.Shared.name password, unsafe_mk exn)) (get_raw_backtrace ())
 
   let map pw f t =
     let v = unsafe_get t in
@@ -377,14 +383,35 @@ let create_with_rwlock () =
 
 exception Protected : 'k Mutex.t * (exn, 'k) Data.t -> exn
 
-(* CR-soon mslater: replace with portable stdlib *)
-let get_raw_backtrace : unit -> Printexc.raw_backtrace @@ portable =
-  O.magic O.magic Printexc.get_raw_backtrace
-
-let protect f =
-  try f () with
-  | exn ->
-    let (P mut) = create_with_mutex () in
-    raise_with_backtrace (Protected (mut, Data.unsafe_mk exn)) (get_raw_backtrace ())
-  ;;
+let protect_local f = exclave_
+  let (P name) = Name.make () in
+  let password = Password.unsafe_mk name in
+  let reraise data =
+    let backtrace = get_raw_backtrace () in
+    let exn = (Protected ({ name; mutex = M.create (); poisoned = false }, data)) in
+    raise_with_backtrace exn backtrace
+  in
+  try f (Password.P password) with
+  | Encapsulated (inner, data) as exn ->
+    (match Name.equality_witness name inner with
+     | Some Equal -> reraise data
+     | None -> reraise (Data.unsafe_mk exn))
+  | exn -> reraise (Data.unsafe_mk exn)
+
+let with_password_local f = exclave_
+  let (P name) = Name.make () in
+  let password = Password.unsafe_mk name in
+  try f (Password.P password) with
+  | Encapsulated (inner, data) as exn ->
+    (match Name.equality_witness name inner with
+     | Some Equal -> reraise (Data.unsafe_get data)
+     | None -> reraise exn)
+  | exn -> reraise exn
+
+module Global = struct
+  type 'a t = { global : 'a @@ global } [@@unboxed]
+end
 
+open Global
+let protect f = (protect_local (fun password -> { global = f password })).global
+let with_password f = (with_password_local (fun password -> { global = f password })).global
diff --git a/otherlibs/stdlib_alpha/capsule.mli b/otherlibs/stdlib_alpha/capsule.mli
index 23b61a258c9..3373b448e94 100644
--- a/otherlibs/stdlib_alpha/capsule.mli
+++ b/otherlibs/stdlib_alpha/capsule.mli
@@ -104,6 +104,11 @@ module Password : sig
      mutex. This guarantees that uncontended access to the capsule is
      only granted to a single domain at once. *)
 
+  type packed = P : 'k t -> packed
+  (** [packed] is the type of a password for some unknown capsule.
+      Unpacking one provides a ['k t] together with a fresh existential
+      type brand for ['k]. *)
+
   val name : 'k t @ local -> 'k Name.t @@ portable
   (** [name t] identifies the capsule that [t] is associated with. *)
 
@@ -416,15 +421,27 @@ exception Encapsulated : 'k Name.t * (exn, 'k) Data.t -> exn
     the data. The [Name.t] can be used to associate the [Data.t] with a
     particular [Password.t] or [Mutex.t]. *)
 
+(* CR-soon mslater: ['k Key.t] instead of ['k Mutex.t]. *)
 exception Protected : 'k Mutex.t * (exn, 'k) Data.t -> exn
 (** If a function passed to [protect] raises an exception, it is wrapped
-    in [Protected] to provide access to the capsule in which the function ran. *)
-(* CR-soon mslater: this should return a key, not a mutex. *)
-
-val protect
-  :  (unit -> 'a @ portable contended) @ local portable
-  -> 'a @ portable contended
-  @@ portable
-(** [protect f] runs [f] in a fresh capsule. If [f] returns normally, [protect]
-    merges this capsule into the caller's capsule. If [f] raises, [protect]
-    raises [Protected], giving the caller access to the encapsulated exception. *)
+    in [Protected] to avoid leaking access to the data. The [Mutex.t] can
+    be used to access the [Data.t]. *)
+
+val protect : (Password.packed @ local -> 'a) @ local portable -> 'a @@ portable
+(** [protect f] runs [f password] in a fresh capsule represented by [password].
+    If [f] returns normally, [protect] merges the capsule into the caller's capsule.
+    If [f] raises an [Encapsulated] exception in the capsule represented by [password],
+    [protect] unwraps the exception and re-raises it as [Protected].
+    If [f] raises any other exception, [protect] re-raises it as [Protected]. *)
+
+val with_password : (Password.packed @ local -> 'a) @ local portable -> 'a @@ portable
+(** [with_password f] runs [f password] in a fresh capsule represented by [password].
+    If [f] returns normally, [with_password] merges the capsule into the caller's capsule.
+    If [f] raises an [Encapsulated] exception in the capsule represented by [password],
+    [with_password] unwraps the exception and re-raises it directly. *)
+
+val protect_local : (Password.packed @ local -> 'a @ local) @ local portable -> 'a @ local @@ portable
+(** See [protect]. *)
+
+val with_password_local : (Password.packed @ local -> 'a @ local) @ local portable -> 'a @ local @@ portable
+(** See [with_password]. *)
diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c
index 84db67b7548..a01d80755ab 100644
--- a/otherlibs/systhreads/st_stubs.c
+++ b/otherlibs/systhreads/st_stubs.c
@@ -572,10 +572,9 @@ static void caml_thread_reinitialize(void)
   Active_thread->next = Active_thread;
   Active_thread->prev = Active_thread;
 
-  // CR ocaml 5 domains: systhreads doesn't maintain domain lock
   /* Within the child, the domain_lock needs to be reset and acquired. */
-  // caml_reset_domain_lock();
-  // caml_acquire_domain_lock();
+  caml_reset_domain_lock();
+  caml_acquire_domain_lock();
 
   /* The lock needs to be initialized again. This process will also be
      the effective owner of the lock. So there is no need to run
diff --git a/parsing/builtin_attributes.ml b/parsing/builtin_attributes.ml
index f5a1fb02ffb..042062ebd61 100644
--- a/parsing/builtin_attributes.ml
+++ b/parsing/builtin_attributes.ml
@@ -504,6 +504,10 @@ let has_unboxed attrs = has_attribute "unboxed" attrs
 
 let has_boxed attrs = has_attribute "boxed" attrs
 
+let has_unsafe_allow_any_kind_in_intf attrs = has_attribute "unsafe_allow_any_kind_in_intf" attrs
+
+let has_unsafe_allow_any_kind_in_impl attrs = has_attribute "unsafe_allow_any_kind_in_impl" attrs
+
 let parse_empty_payload attr =
   match attr.attr_payload with
   | PStr [] -> Some ()
@@ -602,6 +606,15 @@ let zero_alloc_attribute (attr : Parsetree.attribute)  =
         warn_payload attr.attr_loc attr.attr_name.txt
           "Only 'all', 'check', 'check_opt', 'check_all', and 'check_none' are supported")
 
+let attribute_with_ignored_payload name attr =
+  when_attribute_is [name; "ocaml." ^ name] attr ~f:(fun () -> ())
+
+let unsafe_allow_any_kind_in_impl_attribute =
+  attribute_with_ignored_payload "unsafe_allow_any_kind_in_impl"
+
+let unsafe_allow_any_kind_in_intf_attribute =
+  attribute_with_ignored_payload "unsafe_allow_any_kind_in_intf"
+
 let afl_inst_ratio_attribute attr =
   clflags_attribute_with_int_payload attr
     ~name:"afl_inst_ratio" Clflags.afl_inst_ratio
@@ -610,7 +623,8 @@ let parse_standard_interface_attributes attr =
   warning_attribute attr;
   principal_attribute attr;
   noprincipal_attribute attr;
-  nolabels_attribute attr
+  nolabels_attribute attr;
+  unsafe_allow_any_kind_in_intf_attribute attr
 
 let parse_standard_implementation_attributes attr =
   warning_attribute attr;
@@ -621,7 +635,8 @@ let parse_standard_implementation_attributes attr =
   afl_inst_ratio_attribute attr;
   flambda_o3_attribute attr;
   flambda_oclassic_attribute attr;
-  zero_alloc_attribute attr
+  zero_alloc_attribute attr;
+  unsafe_allow_any_kind_in_impl_attribute attr
 
 let has_no_mutable_implied_modalities attrs =
   has_attribute "no_mutable_implied_modalities" attrs
diff --git a/parsing/builtin_attributes.mli b/parsing/builtin_attributes.mli
index 189b6eeded6..d1f95feac31 100644
--- a/parsing/builtin_attributes.mli
+++ b/parsing/builtin_attributes.mli
@@ -35,6 +35,8 @@
     - ocaml.tailcall
     - ocaml.tail_mod_cons
     - ocaml.unboxed
+    - ocaml.unsafe_allow_any_kind_in_impl
+    - ocaml.unsafe_allow_any_kind_in_intf
     - ocaml.untagged
     - ocaml.unrolled
     - ocaml.warnerror
@@ -198,6 +200,9 @@ val explicit_arity: Parsetree.attributes -> bool
 val has_unboxed: Parsetree.attributes -> bool
 val has_boxed: Parsetree.attributes -> bool
 
+val has_unsafe_allow_any_kind_in_impl: Parsetree.attributes -> bool
+val has_unsafe_allow_any_kind_in_intf: Parsetree.attributes -> bool
+
 val parse_standard_interface_attributes : Parsetree.attribute -> unit
 val parse_standard_implementation_attributes : Parsetree.attribute -> unit
 
diff --git a/parsing/parse.ml b/parsing/parse.ml
index 1e2253b367a..1b3f6da349a 100644
--- a/parsing/parse.ml
+++ b/parsing/parse.ml
@@ -160,6 +160,8 @@ let prepare_error err =
             Format.fprintf ppf
               "only module type identifier and %a constraints are supported"
               Style.inline_code "with type"
+        | Misplaced_attribute ->
+            Format.fprintf ppf "an attribute cannot go here"
       in
       Location.errorf ~loc "invalid package type: %a" invalid ipt
   | Removed_string_set loc ->
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 4c60074d276..3d2e13a7a8e 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -808,7 +808,12 @@ let package_type_of_module_type pmty =
   in
   match pmty with
   | {pmty_desc = Pmty_ident lid} -> (lid, [], pmty.pmty_attributes)
-  | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} ->
+  | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid; pmty_attributes = inner_attributes}, cstrs)} ->
+      begin match inner_attributes with
+      | [] -> ()
+      | attr :: _ ->
+        err attr.attr_loc Syntaxerr.Misplaced_attribute
+      end;
       (lid, List.map map_cstr cstrs, pmty.pmty_attributes)
   | _ ->
       err pmty.pmty_loc Neither_identifier_nor_with_type
diff --git a/parsing/syntaxerr.ml b/parsing/syntaxerr.ml
index 76eab18b8e8..c1dbac71d7b 100644
--- a/parsing/syntaxerr.ml
+++ b/parsing/syntaxerr.ml
@@ -21,6 +21,7 @@ type invalid_package_type =
   | Private_types
   | Not_with_type
   | Neither_identifier_nor_with_type
+  | Misplaced_attribute
 
 type error =
     Unclosed of Location.t * string * Location.t * string
diff --git a/parsing/syntaxerr.mli b/parsing/syntaxerr.mli
index 54c619eb877..47f2910fd0e 100644
--- a/parsing/syntaxerr.mli
+++ b/parsing/syntaxerr.mli
@@ -26,6 +26,7 @@ type invalid_package_type =
   | Private_types
   | Not_with_type
   | Neither_identifier_nor_with_type
+  | Misplaced_attribute
 
 type error =
     Unclosed of Location.t * string * Location.t * string
diff --git a/runtime/float32.c b/runtime/float32.c
index e57e94e1e64..6c4cce4cc7a 100644
--- a/runtime/float32.c
+++ b/runtime/float32.c
@@ -900,3 +900,8 @@ CAMLprim value caml_unboxed_float32_vect_blit(value a1, value ofs1, value a2,
           Long_val(n) * sizeof(float));
   return Val_unit;
 }
+
+CAMLprim value caml_float32_is_stage1(value v) {
+  (void)v;
+  return Val_false;
+}
diff --git a/runtime4/float32.c b/runtime4/float32.c
index 3fb8654d4a5..5261e191efe 100644
--- a/runtime4/float32.c
+++ b/runtime4/float32.c
@@ -895,3 +895,8 @@ CAMLprim value caml_unboxed_float32_vect_blit(value a1, value ofs1, value a2,
           Long_val(n) * sizeof(float));
   return Val_unit;
 }
+
+CAMLprim value caml_float32_is_stage1(value v) {
+  (void)v;
+  return Val_false;
+}
diff --git a/test_register_compatible_vectorized.cmx.dump.expected b/test_register_compatible_vectorized.cmx.dump.expected
new file mode 100644
index 00000000000..e69de29bb2d
diff --git a/testsuite/tests/capsule-api/data.ml b/testsuite/tests/capsule-api/data.ml
index 9c81c44612f..9e661a4c362 100644
--- a/testsuite/tests/capsule-api/data.ml
+++ b/testsuite/tests/capsule-api/data.ml
@@ -176,24 +176,55 @@ let () =
   assert (Capsule.Data.project ptr' = 111)
 ;;
 
-
 (* [protect]. *)
 exception Exn of string
 
 let () =
-  match Capsule.protect (fun () -> "ok") with
+  match Capsule.protect (fun _password -> "ok") with
   | s -> assert (s = "ok")
   | exception _ -> assert false
 ;;
 
 let () =
-  match Capsule.protect (fun () -> Exn "ok") with
+  match Capsule.protect (fun _password -> Exn "ok") with
   | Exn s -> assert (s = "ok")
   | _ -> assert false
 ;;
 
 let () =
-  match Capsule.protect (fun () -> reraise (Exn "fail")) with
+  match Capsule.protect (fun _password -> reraise (Exn "fail")) with
+  | exception (Capsule.Protected (mut, exn)) ->
+    let s = Capsule.Mutex.with_lock mut (fun password ->
+      Capsule.Data.extract password (fun exn ->
+        match exn with
+        | Exn s -> s
+        | _ -> assert false) exn) in
+    assert (s = "fail")
+  | _ -> assert false
+;;
+
+let () =
+  match Capsule.protect (fun (Capsule.Password.P password) ->
+    let data = Capsule.Data.create (fun () -> "fail") in
+    let msg = Capsule.Data.extract password (fun s : string -> s) data in
+    reraise (Exn msg))
+  with
+  | exception (Capsule.Protected (mut, exn)) ->
+    let s = Capsule.Mutex.with_lock mut (fun password ->
+      Capsule.Data.extract password (fun exn ->
+        match exn with
+        | Exn s -> s
+        | _ -> assert false) exn) in
+    assert (s = "fail")
+  | _ -> assert false
+;;
+
+let () =
+  match Capsule.protect (fun (Capsule.Password.P password) ->
+    let data = Capsule.Data.create (fun () -> "fail") in
+    let () = Capsule.Data.extract password (fun s -> reraise (Exn s)) data in
+    ())
+  with
   | exception (Capsule.Protected (mut, exn)) ->
     let s = Capsule.Mutex.with_lock mut (fun password ->
       Capsule.Data.extract password (fun exn ->
@@ -203,3 +234,42 @@ let () =
     assert (s = "fail")
   | _ -> assert false
 ;;
+
+(* [with_password]. *)
+let () =
+  match Capsule.with_password (fun _password -> "ok") with
+  | s -> assert (s = "ok")
+  | exception _ -> assert false
+;;
+
+let () =
+  match Capsule.with_password (fun _password -> Exn "ok") with
+  | Exn s -> assert (s = "ok")
+  | _ -> assert false
+;;
+
+let () =
+  match Capsule.with_password (fun _password -> reraise (Exn "fail")) with
+  | exception (Exn s) -> assert (s = "fail")
+  | _ -> assert false
+;;
+
+let () =
+  match Capsule.with_password (fun (Capsule.Password.P password) ->
+    let data = Capsule.Data.create (fun () -> "fail") in
+    let msg = Capsule.Data.extract password (fun s : string -> s) data in
+    reraise (Exn msg))
+  with
+  | exception (Exn s) -> assert (s = "fail")
+  | _ -> assert false
+;;
+
+let () =
+  match Capsule.with_password (fun (Capsule.Password.P password) ->
+    let data = Capsule.Data.create (fun () -> "fail") in
+    let () = Capsule.Data.extract password (fun s -> reraise (Exn s)) data in
+    ())
+  with
+  | exception (Exn s) -> assert (s = "fail")
+  | _ -> assert false
+;;
diff --git a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference
index 7a75bc5e8d3..084fcdc96a5 100644
--- a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference
+++ b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference
@@ -89,13 +89,13 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
       <def_rec>
         pattern (test_locations.ml[17,534+8]..test_locations.ml[17,534+11])
           Tpat_var "fib"
-          value_mode global,many,nonportable;join(aliased,contended)(modevar#1[aliased,uncontended .. unique,uncontended])
+          value_mode global,many,nonportable,unyielding;join(aliased,contended)(modevar#1[aliased,uncontended .. unique,uncontended])
         expression (test_locations.ml[17,534+14]..test_locations.ml[19,572+34])
           Texp_function
-          alloc_mode global,many,nonportable;id(modevar#7[aliased,contended .. unique,uncontended])
+          alloc_mode global,many,nonportable,unyielding;id(modevar#7[aliased,contended .. unique,uncontended])
           []
           Tfunction_cases (test_locations.ml[17,534+14]..test_locations.ml[19,572+34])
-          alloc_mode global,many,nonportable;aliased,uncontended
+          alloc_mode global,many,nonportable,unyielding;aliased,uncontended
           value
             [
               <case>
@@ -110,7 +110,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
               <case>
                 pattern (test_locations.ml[19,572+4]..test_locations.ml[19,572+5])
                   Tpat_var "n"
-                  value_mode global,many,portable;unique,uncontended
+                  value_mode global,many,portable,unyielding;unique,uncontended
                 expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+34])
                   Texp_apply
                   apply_mode Tail
diff --git a/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference
index 93910acca50..ea4b6f36a1e 100644
--- a/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference
+++ b/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference
@@ -89,13 +89,13 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
       <def_rec>
         pattern 
           Tpat_var "fib"
-          value_mode global,many,nonportable;join(aliased,contended)(modevar#1[aliased,uncontended .. unique,uncontended])
+          value_mode global,many,nonportable,unyielding;join(aliased,contended)(modevar#1[aliased,uncontended .. unique,uncontended])
         expression 
           Texp_function
-          alloc_mode global,many,nonportable;id(modevar#7[aliased,contended .. unique,uncontended])
+          alloc_mode global,many,nonportable,unyielding;id(modevar#7[aliased,contended .. unique,uncontended])
           []
           Tfunction_cases 
-          alloc_mode global,many,nonportable;aliased,uncontended
+          alloc_mode global,many,nonportable,unyielding;aliased,uncontended
           value
             [
               <case>
@@ -110,7 +110,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
               <case>
                 pattern 
                   Tpat_var "n"
-                  value_mode global,many,portable;unique,uncontended
+                  value_mode global,many,portable,unyielding;unique,uncontended
                 expression 
                   Texp_apply
                   apply_mode Tail
diff --git a/testsuite/tests/letrec-check/unboxed.ml b/testsuite/tests/letrec-check/unboxed.ml
index 2ebc1c74e69..8e80fa719eb 100644
--- a/testsuite/tests/letrec-check/unboxed.ml
+++ b/testsuite/tests/letrec-check/unboxed.ml
@@ -23,14 +23,17 @@ Line 2, characters 12-19:
 Error: This kind of expression is not allowed as right-hand side of "let rec"
 |}];;
 
+(* This test was made to error by disallowing singleton recursive unboxed types.
+   We keep it in case these are re-allowed, in which case it should error with:
+   [This kind of expression is not allowed as right-hand side of "let rec"] *)
 type r = A of r [@@unboxed]
 let rec y = A y;;
 [%%expect{|
-type r = A of r [@@unboxed]
-Line 2, characters 12-15:
-2 | let rec y = A y;;
-                ^^^
-Error: This kind of expression is not allowed as right-hand side of "let rec"
+Line 1, characters 0-27:
+1 | type r = A of r [@@unboxed]
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "r" is recursive without boxing:
+         "r" contains "r"
 |}];;
 
 (* This test is not allowed if 'a' is unboxed, but should be accepted
diff --git a/testsuite/tests/parsing/dropped_attribute_ptyp_package.compilers.reference b/testsuite/tests/parsing/dropped_attribute_ptyp_package.compilers.reference
new file mode 100644
index 00000000000..3469a279e39
--- /dev/null
+++ b/testsuite/tests/parsing/dropped_attribute_ptyp_package.compilers.reference
@@ -0,0 +1,10 @@
+module type T = sig type t end
+Line 3, characters 22-29:
+3 |   val foo : (module T [@attr] with type t = 'a) -> unit
+                          ^^^^^^^
+Error: invalid package type: an attribute cannot go here
+Line 3, characters 33-40:
+3 |   let foo (type a) (module M : T [@attr] with type t = a) = ()
+                                     ^^^^^^^
+Error: invalid package type: an attribute cannot go here
+
diff --git a/testsuite/tests/parsing/dropped_attribute_ptyp_package.ml b/testsuite/tests/parsing/dropped_attribute_ptyp_package.ml
new file mode 100644
index 00000000000..9fea993cc05
--- /dev/null
+++ b/testsuite/tests/parsing/dropped_attribute_ptyp_package.ml
@@ -0,0 +1,18 @@
+(* TEST
+   toplevel;
+*)
+
+(* There is no place for the following attributes to attach to; the compiler should error
+   rather than silently dropping them (as it used to do). *)
+
+module type T = sig
+  type t
+end;;
+
+module type U = sig
+  val foo : (module T [@attr] with type t = 'a) -> unit
+end;;
+
+module U : U = struct
+  let foo (type a) (module M : T [@attr] with type t = a) = ()
+end;;
diff --git a/ocaml/testsuite/tests/polling/polling.compilers.reference b/testsuite/tests/polling/polling.compilers.reference
similarity index 100%
rename from ocaml/testsuite/tests/polling/polling.compilers.reference
rename to testsuite/tests/polling/polling.compilers.reference
diff --git a/ocaml/testsuite/tests/polling/polling.ml b/testsuite/tests/polling/polling.ml
similarity index 100%
rename from ocaml/testsuite/tests/polling/polling.ml
rename to testsuite/tests/polling/polling.ml
diff --git a/testsuite/tests/typing-layouts-or-null/reexport.ml b/testsuite/tests/typing-layouts-or-null/reexport.ml
index 96bd392eed7..46ceeebc37f 100644
--- a/testsuite/tests/typing-layouts-or-null/reexport.ml
+++ b/testsuite/tests/typing-layouts-or-null/reexport.ml
@@ -335,3 +335,17 @@ let[@or_null_reexport] foo = 5
 [%%expect{|
 val foo : int = 5
 |}]
+
+(* [private] re-export fails. *)
+
+module Or_null = struct
+  type ('a : value) t : value_or_null = private 'a or_null [@@or_null_reexport]
+end
+
+[%%expect{|
+Line 2, characters 2-79:
+2 |   type ('a : value) t : value_or_null = private 'a or_null [@@or_null_reexport]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Invalid reexport declaration.
+       Type t must be defined equal to the primitive type or_null.
+|}]
diff --git a/testsuite/tests/typing-layouts-products/basics.ml b/testsuite/tests/typing-layouts-products/basics.ml
index efb651516c7..f2faf86b486 100644
--- a/testsuite/tests/typing-layouts-products/basics.ml
+++ b/testsuite/tests/typing-layouts-products/basics.ml
@@ -9,14 +9,16 @@
 
 open Stdlib_upstream_compatible
 
-(**********************************************************)
-(* Test 1: Basic unboxed product layouts and tuple types. *)
+(****************************************************)
+(* Test 1: Basic unboxed product layouts and types. *)
 
 type t1 : float64 & value
 type t2 = #(string * float# * int)
+type t2 = #{ s : string; f : float#; i : int }
 [%%expect{|
 type t1 : float64 & value
 type t2 = #(string * float# * int)
+type t2 = #{ s : string; f : float#; i : int; }
 |}]
 
 (* You can put unboxed and normal products inside unboxed products *)
@@ -27,6 +29,15 @@ type t3 : value & (bits64 & (value & float32))
 type t4 = #(string * #(int * (bool * int) * char option))
 |}]
 
+type t4_inner2 = #{ b : bool; i : int }
+type t4_inner = #{ i : int; t4_inner2 : t4_inner2; co : char option }
+type t4 = #{ s : string; t4_inner : t4_inner }
+[%%expect{|
+type t4_inner2 = #{ b : bool; i : int; }
+type t4_inner = #{ i : int; t4_inner2 : t4_inner2; co : char option; }
+type t4 = #{ s : string; t4_inner : t4_inner; }
+|}]
+
 (* But you can't put unboxed products into normal tuples (yet) *)
 type t_nope = string * #(string * bool)
 [%%expect{|
@@ -40,6 +51,20 @@ Error: Tuple element types must have layout value.
          because it's the type of a tuple element.
 |}]
 
+type t_nope_inner = #{ s : string; b : bool }
+type t_nope = string * t_nope_inner
+[%%expect{|
+type t_nope_inner = #{ s : string; b : bool; }
+Line 2, characters 23-35:
+2 | type t_nope = string * t_nope_inner
+                           ^^^^^^^^^^^^
+Error: Tuple element types must have layout value.
+       The layout of "t_nope_inner" is value & value
+         because of the definition of t_nope_inner at line 1, characters 0-45.
+       But the layout of "t_nope_inner" must be a sublayout of value
+         because it's the type of a tuple element.
+|}]
+
 (********************************************)
 (* Test 2: Simple kind annotations on types *)
 
@@ -50,6 +75,13 @@ type t1 = #(float# * bool)
 type t2 = #(string option * t1)
 |}]
 
+type t1 : float64 & value = #{ f : float#; b : bool }
+type t2 : value & (float64 & value) = #{ so : string option ; t1 : t1 }
+[%%expect{|
+type t1 = #{ f : float#; b : bool; }
+type t2 = #{ so : string option; t1 : t1; }
+|}]
+
 type t2_wrong : value & float64 & value = #(string option * t1)
 [%%expect{|
 Line 1, characters 0-63:
@@ -62,6 +94,17 @@ Error: The layout of type "#(string option * t1)" is value & (float64 & value)
          because of the definition of t2_wrong at line 1, characters 0-63.
 |}]
 
+type t2_wrong : value & float64 & value = #{ so : string option; t1 : t1 }
+[%%expect{|
+Line 1, characters 0-74:
+1 | type t2_wrong : value & float64 & value = #{ so : string option; t1 : t1 }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The layout of type "t2_wrong" is value & (float64 & value)
+         because it is an unboxed record.
+       But the layout of type "t2_wrong" must be a sublayout of value & float64 & value
+         because of the annotation on the declaration of the type t2_wrong.
+|}]
+
 type ('a : value & bits64) t3 = 'a
 type t4 = #(int * int64#) t3
 type t5 = t4 t3
@@ -71,6 +114,17 @@ type t4 = #(int * int64#) t3
 type t5 = t4 t3
 |}]
 
+type ('a : value & bits64) t3 = 'a
+type t4_inner = #{ i : int; i64 : int64# }
+type t4 = t4_inner t3
+type t5 = t4 t3
+[%%expect{|
+type ('a : value & bits64) t3 = 'a
+type t4_inner = #{ i : int; i64 : int64#; }
+type t4 = t4_inner t3
+type t5 = t4 t3
+|}]
+
 type t4_wrong = #(int * int) t3
 [%%expect{|
 Line 1, characters 16-28:
@@ -86,6 +140,22 @@ Error: This type "#(int * int)" should be an instance of type
 (* CR layouts v7.1: The above error should identify the component of the product
    that is problematic. *)
 
+type t4_wrong_inner = #{ i1 : int; i2 : int }
+type t4_wrong = t4_wrong_inner t3
+[%%expect{|
+type t4_wrong_inner = #{ i1 : int; i2 : int; }
+Line 2, characters 16-30:
+2 | type t4_wrong = t4_wrong_inner t3
+                    ^^^^^^^^^^^^^^
+Error: This type "t4_wrong_inner" should be an instance of type
+         "('a : value & bits64)"
+       The layout of t4_wrong_inner is value & value
+         because of the definition of t4_wrong_inner at line 1, characters 0-45.
+       But the layout of t4_wrong_inner must be a sublayout of value & bits64
+         because of the definition of t3 at line 1, characters 0-34.
+|}]
+
+
 (* some mutually recusive types *)
 type ('a : value & bits64) t6 = 'a t7
 and 'a t7 = { x : 'a t6 }
@@ -108,6 +178,29 @@ Error: This type "bool" should be an instance of type "('a : value & bits64)"
          because of the definition of t6 at line 1, characters 0-37.
 |}]
 
+type ('a : value & bits64) t6 = 'a t7
+and 'a t7 = { x : 'a t6 }
+[%%expect{|
+type ('a : value & bits64) t6 = 'a t7
+and ('a : value & bits64) t7 = { x : 'a t6; }
+|}]
+
+type t9_record = #{ i : int; i64 : int64# }
+type t9 = t9_record t7
+type t10 = bool t6
+[%%expect{|
+type t9_record = #{ i : int; i64 : int64#; }
+type t9 = t9_record t7
+Line 3, characters 11-15:
+3 | type t10 = bool t6
+               ^^^^
+Error: This type "bool" should be an instance of type "('a : value & bits64)"
+       The layout of bool is value
+         because it is the primitive type bool.
+       But the layout of bool must be a sublayout of value & bits64
+         because of the definition of t6 at line 1, characters 0-37.
+|}]
+
 type ('a : value & bits64) t6_wrong = 'a t7_wrong
 and 'a t7_wrong = { x : #(int * int64) t6_wrong }
 [%%expect{|
@@ -125,6 +218,23 @@ Error: This type "#(int * int64)" should be an instance of type
 (* CR layouts v7.1: The above error should identify the component of the product
    that is problematic. *)
 
+type t6_wrong_inner_record = #{ i : int; i64 : int64 }
+and ('a : value & bits64) t6_wrong = 'a t7_wrong
+and 'a t7_wrong = { x : t6_wrong_inner_record t6_wrong }
+[%%expect{|
+Line 1, characters 0-54:
+1 | type t6_wrong_inner_record = #{ i : int; i64 : int64 }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error:
+       The layout of t6_wrong_inner_record is any & any
+         because it is an unboxed record.
+       But the layout of t6_wrong_inner_record must be a sublayout of
+         value & bits64
+         because of the annotation on 'a in the declaration of the type
+                                      t6_wrong.
+|}]
+(* CR layouts v7.2: The above has a very bad error message. *)
+
 (* Just like t6/t7, but with the annotation on the other (the order doesn't
    matter) *)
 type 'a t11 = 'a t12
@@ -134,6 +244,13 @@ type ('a : value & bits64) t11 = 'a t12
 and ('a : value & bits64) t12 = { x : 'a t11; }
 |}]
 
+type 'a t11 = 'a t12
+and ('a : value & bits64) t12 = { x : 'a t11 }
+[%%expect{|
+type ('a : value & bits64) t11 = 'a t12
+and ('a : value & bits64) t12 = { x : 'a t11; }
+|}]
+
 (* You can make a universal variable have a product layout, but you have to ask
    for it *)
 type ('a : float64 & value) t = 'a
@@ -209,6 +326,117 @@ val f_take_a_few_unboxed_tuples :
   <fun>
 |}]
 
+(* Unboxed records version of the same test *)
+
+type t1_left = #{ i : int; b : bool }
+type t1_right_inner = #{ i64 : int64#; so : string option }
+type t1_right = #{ i : int; f : float#; inner : t1_right_inner }
+type t1 = t1_left -> t1_right
+[%%expect{|
+type t1_left = #{ i : int; b : bool; }
+type t1_right_inner = #{ i64 : int64#; so : string option; }
+type t1_right = #{ i : int; f : float#; inner : t1_right_inner; }
+type t1 = t1_left -> t1_right
+|}]
+
+type make_record_result = #{ f : float#; s : string }
+let f_make_an_unboxed_record (x : string) (y : float#) = #{ f = y; s = x }
+
+type inner = #{ f1 : float#; f2 : float# }
+type t = #{ s : string; inner : inner }
+let f_pull_apart_an_unboxed_record (x : t) =
+  match x with
+  | #{ s; inner = #{ f1; f2 } } ->
+    if s = "mul" then
+      Float_u.mul f1 f2
+    else
+      Float_u.add f1 f2
+[%%expect{|
+type make_record_result = #{ f : float#; s : string; }
+val f_make_an_unboxed_record : string -> float# -> make_record_result = <fun>
+type inner = #{ f1 : float#; f2 : float#; }
+type t = #{ s : string; inner : inner; }
+val f_pull_apart_an_unboxed_record :
+  t -> Stdlib_upstream_compatible.Float_u.t = <fun>
+|}]
+
+
+module type S = sig
+  type a
+  type b
+  type c
+  type d
+  type e
+  type f
+  type g
+  type h
+end
+
+module F(X : S) = struct
+  include X
+  type mix_input_inner2 = #{ d : d; e : e }
+  type mix_input_inner = #{ c : c; inner2 : mix_input_inner2 }
+  type mix_input = #{ a : a; b : b; inner : mix_input_inner; f : f }
+  type mix_output_inner2 = #{ f : f; e : e }
+  type mix_output_inner = #{ c : c; inner2 : mix_output_inner2 }
+  type mix_output = #{ b : b; inner : mix_output_inner; a : a; d : d }
+  let f_mix_up_an_unboxed_record (x : mix_input) =
+    let #{ a; b; inner = #{ c; inner2 = #{ d; e } }; f } = x in
+    #{ b = b; inner = #{ c = c; inner2 = #{ f = f; e = e } }; a = a; d = d }
+
+  type take_few_input1 = #{ a : a; b : b }
+  type take_few_input3 = #{ d : d; e : e }
+  type take_few_input5 = #{ g : g; h : h }
+  type take_few_output =
+    #{ h : h; g2 : g; x4 : f; e2 : e; d : d; x2 : c; b : b; a2 : a }
+
+  let f_take_a_few_unboxed_records (x1 : take_few_input1) x2
+        (x3 : take_few_input3) x4 (x5 : take_few_input5) =
+    let #{ a; b } = x1 in
+    let #{ d; e } = x3 in
+    let #{ g; h } = x5 in
+    #{ h = h; g2 = g; x4 = x4; e2 = e; d = d; x2 = x2; b = b; a2 = a }
+end
+[%%expect{|
+module type S =
+  sig type a type b type c type d type e type f type g type h end
+module F :
+  functor (X : S) ->
+    sig
+      type a = X.a
+      type b = X.b
+      type c = X.c
+      type d = X.d
+      type e = X.e
+      type f = X.f
+      type g = X.g
+      type h = X.h
+      type mix_input_inner2 = #{ d : d; e : e; }
+      type mix_input_inner = #{ c : c; inner2 : mix_input_inner2; }
+      type mix_input = #{ a : a; b : b; inner : mix_input_inner; f : f; }
+      type mix_output_inner2 = #{ f : f; e : e; }
+      type mix_output_inner = #{ c : c; inner2 : mix_output_inner2; }
+      type mix_output = #{ b : b; inner : mix_output_inner; a : a; d : d; }
+      val f_mix_up_an_unboxed_record : mix_input -> mix_output
+      type take_few_input1 = #{ a : a; b : b; }
+      type take_few_input3 = #{ d : d; e : e; }
+      type take_few_input5 = #{ g : g; h : h; }
+      type take_few_output = #{
+        h : h;
+        g2 : g;
+        x4 : f;
+        e2 : e;
+        d : d;
+        x2 : c;
+        b : b;
+        a2 : a;
+      }
+      val f_take_a_few_unboxed_records :
+        take_few_input1 ->
+        c -> take_few_input3 -> f -> take_few_input5 -> take_few_output
+    end
+|}]
+
 (***************************************************)
 (* Test 4: Unboxed products don't go in structures *)
 
@@ -370,6 +598,194 @@ Error: This expression has type "('a : value_or_null)"
        But the layout of #('a * 'b) must be a sublayout of value
          because it's the type of a variable captured in an object.
 |}];;
+
+(* Unboxed records version of the same test *)
+
+type poly_var_inner = #{ i : int; b : bool }
+type poly_var_type = [ `Foo of poly_var_inner ]
+[%%expect{|
+type poly_var_inner = #{ i : int; b : bool; }
+Line 2, characters 31-45:
+2 | type poly_var_type = [ `Foo of poly_var_inner ]
+                                   ^^^^^^^^^^^^^^
+Error: Polymorphic variant constructor argument types must have layout value.
+       The layout of "poly_var_inner" is value & value
+         because of the definition of poly_var_inner at line 1, characters 0-44.
+       But the layout of "poly_var_inner" must be a sublayout of value
+         because it's the type of the field of a polymorphic variant.
+|}]
+
+type poly_var_term_record = #{ i : int; i2 : int }
+let poly_var_term = `Foo #{ i = 1; i2 = 2 }
+[%%expect{|
+type poly_var_term_record = #{ i : int; i2 : int; }
+Line 2, characters 25-43:
+2 | let poly_var_term = `Foo #{ i = 1; i2 = 2 }
+                             ^^^^^^^^^^^^^^^^^^
+Error: This expression has type "poly_var_term_record"
+       but an expression was expected of type "('a : value_or_null)"
+       The layout of poly_var_term_record is value & value
+         because of the definition of poly_var_term_record at line 1, characters 0-50.
+       But the layout of poly_var_term_record must be a sublayout of value
+         because it's the type of the field of a polymorphic variant.
+|}]
+
+type record_inner = #{ b : bool; f : float# }
+type tuple_type = (int * record_inner)
+[%%expect{|
+type record_inner = #{ b : bool; f : float#; }
+Line 2, characters 25-37:
+2 | type tuple_type = (int * record_inner)
+                             ^^^^^^^^^^^^
+Error: Tuple element types must have layout value.
+       The layout of "record_inner" is value & float64
+         because of the definition of record_inner at line 1, characters 0-45.
+       But the layout of "record_inner" must be a sublayout of value
+         because it's the type of a tuple element.
+|}]
+
+type record = #{ i : int; i2 : int }
+let tuple_term = ("hi", #{ i = 1; i2 = 2 })
+[%%expect{|
+type record = #{ i : int; i2 : int; }
+Line 2, characters 24-42:
+2 | let tuple_term = ("hi", #{ i = 1; i2 = 2 })
+                            ^^^^^^^^^^^^^^^^^^
+Error: This expression has type "record" but an expression was expected of type
+         "('a : value_or_null)"
+       The layout of record is value & value
+         because of the definition of record at line 1, characters 0-36.
+       But the layout of record must be a sublayout of value
+         because it's the type of a tuple element.
+|}]
+
+type record_inner = #{ i : int; b : bool }
+type record = { x : record_inner }
+[%%expect{|
+type record_inner = #{ i : int; b : bool; }
+Line 2, characters 0-34:
+2 | type record = { x : record_inner }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type "record_inner" has layout "value & value".
+       Records may not yet contain types of this layout.
+|}]
+
+type inlined_inner = #{ i : int; b : bool }
+type inlined_record = A of { x : inlined_inner }
+[%%expect{|
+type inlined_inner = #{ i : int; b : bool; }
+Line 2, characters 22-48:
+2 | type inlined_record = A of { x : inlined_inner }
+                          ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type "inlined_inner" has layout "value & value".
+       Inlined records may not yet contain types of this layout.
+|}]
+
+type variant_inner = #{ i : int; b : bool }
+type variant = A of variant_inner
+[%%expect{|
+type variant_inner = #{ i : int; b : bool; }
+Line 2, characters 15-33:
+2 | type variant = A of variant_inner
+                   ^^^^^^^^^^^^^^^^^^
+Error: Type "variant_inner" has layout "value & value".
+       Variants may not yet contain types of this layout.
+|}]
+
+type sig_inner = #{ i : int; b : bool }
+module type S = sig
+  val x : sig_inner
+end
+[%%expect{|
+type sig_inner = #{ i : int; b : bool; }
+Line 3, characters 10-19:
+3 |   val x : sig_inner
+              ^^^^^^^^^
+Error: This type signature for "x" is not a value type.
+       The layout of type sig_inner is value & value
+         because of the definition of sig_inner at line 1, characters 0-39.
+       But the layout of type sig_inner must be a sublayout of value
+         because it's the type of something stored in a module structure.
+|}]
+
+type m_record = #{ i1 : int; i2 : int }
+module M = struct
+  let x = #{ i1 = 1; i2 = 2 }
+end
+[%%expect{|
+type m_record = #{ i1 : int; i2 : int; }
+Line 3, characters 6-7:
+3 |   let x = #{ i1 = 1; i2 = 2 }
+          ^
+Error: Types of top-level module bindings must have layout "value", but
+       the type of "x" has layout "value & value".
+|}]
+
+type object_inner = #{ i : int; b : bool }
+type object_type = < x : object_inner >
+[%%expect{|
+type object_inner = #{ i : int; b : bool; }
+Line 2, characters 21-37:
+2 | type object_type = < x : object_inner >
+                         ^^^^^^^^^^^^^^^^
+Error: Object field types must have layout value.
+       The layout of "object_inner" is value & value
+         because of the definition of object_inner at line 1, characters 0-42.
+       But the layout of "object_inner" must be a sublayout of value
+         because it's the type of an object field.
+|}]
+
+type object_term_record = #{ i1 : int; i2 : int }
+let object_term = object val x = #{ i1 = 1; i2 = 2 } end
+[%%expect{|
+type object_term_record = #{ i1 : int; i2 : int; }
+Line 2, characters 29-30:
+2 | let object_term = object val x = #{ i1 = 1; i2 = 2 } end
+                                 ^
+Error: Variables bound in a class must have layout value.
+       The layout of x is value & value
+         because of the definition of object_term_record at line 1, characters 0-49.
+       But the layout of x must be a sublayout of value
+         because it's the type of a class field.
+|}]
+
+type class_record = #{ i1 : int; i2 : int }
+class class_ =
+  object
+    method x = #{ i1 = 1; i2 = 2 }
+  end
+[%%expect{|
+type class_record = #{ i1 : int; i2 : int; }
+Line 4, characters 15-34:
+4 |     method x = #{ i1 = 1; i2 = 2 }
+                   ^^^^^^^^^^^^^^^^^^^
+Error: This expression has type "class_record"
+       but an expression was expected of type "('a : value)"
+       The layout of class_record is value & value
+         because of the definition of class_record at line 1, characters 0-43.
+       But the layout of class_record must be a sublayout of value
+         because it's the type of an object field.
+|}]
+
+type capture_record = #{ x : int; y : int }
+let capture_in_object utup = object
+  val f = fun () ->
+    let #{ x; y } = utup in
+    x + y
+end;;
+[%%expect{|
+type capture_record = #{ x : int; y : int; }
+Line 4, characters 20-24:
+4 |     let #{ x; y } = utup in
+                        ^^^^
+Error: This expression has type "('a : value_or_null)"
+       but an expression was expected of type "capture_record"
+       The layout of capture_record is value & value
+         because of the definition of capture_record at line 1, characters 0-43.
+       But the layout of capture_record must be a sublayout of value
+         because it's the type of a variable captured in an object.
+|}];;
+
 (****************************************************)
 (* Test 5: Methods may take/return unboxed products *)
 
@@ -382,6 +798,23 @@ class class_with_utuple_manipulating_method :
   object method f : #(int * int) -> #(int * int) -> #(int * int) end
 |}]
 
+type method_input = #{ a : int; b : int }
+type method_output = #{ sum_a : int; sum_b : int }
+
+class class_with_urecord_manipulating_method =
+  object
+    method f (x : method_input) (y : method_input) =
+      let #{ a; b } = x in
+      let #{ a = c; b = d } = y in
+      #{ sum_a = a + c; sum_b = b + d }
+  end
+[%%expect{|
+type method_input = #{ a : int; b : int; }
+type method_output = #{ sum_a : int; sum_b : int; }
+class class_with_urecord_manipulating_method :
+  object method f : method_input -> method_input -> method_output end
+|}]
+
 (*******************************************)
 (* Test 6: Nested expansion in kind checks *)
 
@@ -501,8 +934,43 @@ module F :
     sig type r = X.t4 t_constraint end
 |}]
 
-(***********************************************)
-(* Test 7: modal kinds for unboxed tuple types *)
+(* This typechecks for unboxed tuples, but fail for [@@unboxed], unboxed, and
+   boxed records, in the same way as below.
+
+   CR layouts v7.2: These should typecheck for all record forms.
+*)
+module type S_coherence_deep = sig
+  type t1 : any
+  type t2 = #{ i : int; t1 : t1 }
+end
+[%%expect{|
+Line 3, characters 24-31:
+3 |   type t2 = #{ i : int; t1 : t1 }
+                            ^^^^^^^
+Error: Unboxed record element types must have a representable layout.
+       The layout of t1 is any
+         because of the definition of t1 at line 2, characters 2-15.
+       But the layout of t1 must be representable
+         because it is the type of record field t1.
+|}]
+
+module type S_coherence_deep = sig
+  type t1 : any
+  type t2 = { t1 : t1 } [@@unboxed]
+end
+[%%expect{|
+Line 3, characters 14-21:
+3 |   type t2 = { t1 : t1 } [@@unboxed]
+                  ^^^^^^^
+Error: [@@unboxed] record element types must have a representable layout.
+       The layout of t1/2 is any
+         because of the definition of t1 at line 2, characters 2-15.
+       But the layout of t1/2 must be representable
+         because it is the type of record field t1.
+|}]
+
+(*************************************************)
+(* Test 7: modal kinds for unboxed product types *)
 
 let f_external_utuple_mode_crosses_local_1
   : local_ #(int * int) -> #(int * int) = fun x -> x
@@ -556,6 +1024,80 @@ Line 3, characters 67-68:
 Error: This value escapes its region.
 |}]
 
+(* Unboxed records version of the same test *)
+
+type local_cross1 = #{ i1 : int; i2 : int }
+let f_external_urecord_mode_crosses_local_1
+  : local_ local_cross1 -> local_cross1 = fun x -> x
+[%%expect{|
+type local_cross1 = #{ i1 : int; i2 : int; }
+val f_external_urecord_mode_crosses_local_1 :
+  local_ local_cross1 -> local_cross1 = <fun>
+|}]
+
+type local_nocross1 = #{ i : int; s : string }
+let f_internal_urecord_does_not_mode_cross_local_1
+  : local_ local_nocross1 -> local_nocross1 = fun x -> x
+[%%expect{|
+type local_nocross1 = #{ i : int; s : string; }
+Line 3, characters 55-56:
+3 |   : local_ local_nocross1 -> local_nocross1 = fun x -> x
+                                                           ^
+Error: This value escapes its region.
+|}]
+
+type local_cross2_inner = #{ b : bool; i : int }
+type local_cross2 = #{ i : int; inner : local_cross2_inner }
+let f_external_urecord_mode_crosses_local_2
+  : local_ local_cross2 -> local_cross2 = fun x -> x
+[%%expect{|
+type local_cross2_inner = #{ b : bool; i : int; }
+type local_cross2 = #{ i : int; inner : local_cross2_inner; }
+val f_external_urecord_mode_crosses_local_2 :
+  local_ local_cross2 -> local_cross2 = <fun>
+|}]
+
+type local_nocross2_inner = #{ b : bool; s : string }
+type local_nocross2 = #{ i : int; inner : local_nocross2_inner }
+let f_internal_urecord_does_not_mode_cross_local_2
+  : local_ local_nocross2 -> local_nocross2 = fun x -> x
+[%%expect{|
+type local_nocross2_inner = #{ b : bool; s : string; }
+type local_nocross2 = #{ i : int; inner : local_nocross2_inner; }
+Line 4, characters 55-56:
+4 |   : local_ local_nocross2 -> local_nocross2 = fun x -> x
+                                                           ^
+Error: This value escapes its region.
+|}]
+
+type t = #{ i1 : int; i2 : int }
+type local_cross3_inner = #{ t : t; i : int }
+type local_cross3 = #{ i : int; inner : local_cross3_inner }
+let f_external_urecord_mode_crosses_local_3
+  : local_ local_cross3 -> local_cross3 = fun x -> x
+[%%expect{|
+type t = #{ i1 : int; i2 : int; }
+type local_cross3_inner = #{ t : t; i : int; }
+type local_cross3 = #{ i : int; inner : local_cross3_inner; }
+val f_external_urecord_mode_crosses_local_3 :
+  local_ local_cross3 -> local_cross3 = <fun>
+|}]
+
+type t = #{ s : string; i : int }
+type local_nocross3_inner = #{ t : t; b : bool }
+type local_nocross3 = #{ i : int; inner : local_nocross3_inner }
+let f_internal_urecord_does_not_mode_cross_local_3
+  : local_ local_nocross3 -> local_nocross3 = fun x -> x
+[%%expect{|
+type t = #{ s : string; i : int; }
+type local_nocross3_inner = #{ t : t; b : bool; }
+type local_nocross3 = #{ i : int; inner : local_nocross3_inner; }
+Line 5, characters 55-56:
+5 |   : local_ local_nocross3 -> local_nocross3 = fun x -> x
+                                                           ^
+Error: This value escapes its region.
+|}]
+
 (****************************************************)
 (* Test 8: modal kinds for product kind annotations *)
 
@@ -689,10 +1231,112 @@ external id : ('a : any). 'a -> 'a = "%identity" [@@layout_poly]
 val sum : int = 3
 |}]
 
+(* Unboxed records version of the same test *)
+
+type t_product : value & value
+
+type ext_record_arg_record = #{ i : int; b : bool }
+external ext_record_arg : ext_record_arg_record -> int = "foo" "bar"
+[%%expect{|
+type t_product : value & value
+type ext_record_arg_record = #{ i : int; b : bool; }
+Line 4, characters 26-54:
+4 | external ext_record_arg : ext_record_arg_record -> int = "foo" "bar"
+                              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The primitive [foo] is used in an invalid declaration.
+       The declaration contains argument/return types with the wrong layout.
+|}]
+
+type ext_record_arg_attr_record = #{ i : int; b : bool }
+external ext_record_arg_with_attr : (ext_record_arg_attr_record [@unboxed]) -> int = "foo"
+[%%expect{|
+type ext_record_arg_attr_record = #{ i : int; b : bool; }
+Line 2, characters 37-63:
+2 | external ext_record_arg_with_attr : (ext_record_arg_attr_record [@unboxed]) -> int = "foo"
+                                         ^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Don't know how to unbox this type.
+       Only "float", "int32", "int64", "nativeint", vector primitives, and
+       the corresponding unboxed types can be marked unboxed.
+|}]
+
+external ext_product_arg : t_product -> int = "foo" "bar"
+[%%expect{|
+Line 1, characters 27-43:
+1 | external ext_product_arg : t_product -> int = "foo" "bar"
+                               ^^^^^^^^^^^^^^^^
+Error: The primitive [foo] is used in an invalid declaration.
+       The declaration contains argument/return types with the wrong layout.
+|}]
+
+external ext_product_arg_with_attr : (t_product [@unboxed]) -> int = "foo"
+[%%expect{|
+Line 1, characters 38-47:
+1 | external ext_product_arg_with_attr : (t_product [@unboxed]) -> int = "foo"
+                                          ^^^^^^^^^
+Error: Don't know how to unbox this type.
+       Only "float", "int32", "int64", "nativeint", vector primitives, and
+       the corresponding unboxed types can be marked unboxed.
+|}]
+
+type t = #{ i : int; b : bool }
+external ext_record_return : int -> t = "foo" "bar"
+[%%expect{|
+type t = #{ i : int; b : bool; }
+Line 2, characters 29-37:
+2 | external ext_record_return : int -> t = "foo" "bar"
+                                 ^^^^^^^^
+Error: The primitive [foo] is used in an invalid declaration.
+       The declaration contains argument/return types with the wrong layout.
+|}]
+
+type t = #{ i : int; b : bool }
+external ext_record_return_with_attr : int -> (t [@unboxed]) = "foo"
+[%%expect{|
+type t = #{ i : int; b : bool; }
+Line 2, characters 47-48:
+2 | external ext_record_return_with_attr : int -> (t [@unboxed]) = "foo"
+                                                   ^
+Error: Don't know how to unbox this type.
+       Only "float", "int32", "int64", "nativeint", vector primitives, and
+       the corresponding unboxed types can be marked unboxed.
+|}]
+
+external ext_product_return : int -> t_product = "foo" "bar"
+[%%expect{|
+Line 1, characters 30-46:
+1 | external ext_product_return : int -> t_product = "foo" "bar"
+                                  ^^^^^^^^^^^^^^^^
+Error: The primitive [foo] is used in an invalid declaration.
+       The declaration contains argument/return types with the wrong layout.
+|}]
+
+external ext_product_return_with_attr : int -> (t_product [@unboxed]) = "foo"
+[%%expect{|
+Line 1, characters 48-57:
+1 | external ext_product_return_with_attr : int -> (t_product [@unboxed]) = "foo"
+                                                    ^^^^^^^^^
+Error: Don't know how to unbox this type.
+       Only "float", "int32", "int64", "nativeint", vector primitives, and
+       the corresponding unboxed types can be marked unboxed.
+|}]
+
+external[@layout_poly] id : ('a : any). 'a -> 'a = "%identity"
+
+type id_record = #{ x : int; y : int }
+let sum =
+  let #{ x; y } = id #{ x = 1; y = 2 } in
+  x + y
+[%%expect{|
+external id : ('a : any). 'a -> 'a = "%identity" [@@layout_poly]
+type id_record = #{ x : int; y : int; }
+val sum : int = 3
+|}]
+
+
 (***********************************)
-(* Test 9: not allowed in let recs *)
+(* Test 10: not allowed in let recs *)
 
-(* An example that is allowed on tuples but not unboxed tuples *)
+(* An example that is allowed on tuples but not unboxed products *)
 let[@warning "-26"] e1 = let rec x = (1, y) and y = 42 in ()
 let[@warning "-26"] e2 = let rec x = #(1, y) and y = 42 in ()
 [%%expect{|
@@ -708,7 +1352,36 @@ Error: This expression has type "#('a * 'b)"
          because it's the type of the recursive variable x.
 |}]
 
-(* This example motivates having a check in [type_let], because
+let[@warning "-26"] e1 = let rec x = (1, y) and y = 42 in ()
+
+type letrec_record = #{ i1 : int; i2 : int }
+let[@warning "-26"] e2 = let rec x = #{ i1 = 1; i2 = y } and y = 42 in ()
+[%%expect{|
+val e1 : unit = ()
+type letrec_record = #{ i1 : int; i2 : int; }
+Line 4, characters 37-56:
+4 | let[@warning "-26"] e2 = let rec x = #{ i1 = 1; i2 = y } and y = 42 in ()
+                                         ^^^^^^^^^^^^^^^^^^^
+Error: This expression has type "letrec_record"
+       but an expression was expected of type "('a : value_or_null)"
+       The layout of letrec_record is value & value
+         because of the definition of letrec_record at line 3, characters 0-44.
+       But the layout of letrec_record must be a sublayout of value
+         because it's the type of the recursive variable x.
+|}]
+
+(* Unboxed records of kind value are also disallowed: *)
+type letrec_record = #{ i : int }
+let e2 = let rec x = #{ i = y } and y = 42 in ()
+[%%expect{|
+type letrec_record = #{ i : int; }
+Line 2, characters 21-31:
+2 | let e2 = let rec x = #{ i = y } and y = 42 in ()
+                         ^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of "let rec"
+|}]
+
+(* These examples motivate having a check in [type_let], because
    [Value_rec_check] is not set up to reject it, but we don't support even this
    limited form of unboxed let rec (yet). *)
 let _ = let rec _x = #(3, 10) and _y = 42 in 42
@@ -724,8 +1397,23 @@ Error: This expression has type "#('a * 'b)"
          because it's the type of the recursive variable _x.
 |}]
 
+type letrec_simple = #{ i1 : int; i2 : int }
+let _ = let rec _x = #{ i1 = 3; i2 = 10 } and _y = 42 in 42
+[%%expect{|
+type letrec_simple = #{ i1 : int; i2 : int; }
+Line 2, characters 21-41:
+2 | let _ = let rec _x = #{ i1 = 3; i2 = 10 } and _y = 42 in 42
+                         ^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type "letrec_simple"
+       but an expression was expected of type "('a : value_or_null)"
+       The layout of letrec_simple is value & value
+         because of the definition of letrec_simple at line 1, characters 0-44.
+       But the layout of letrec_simple must be a sublayout of value
+         because it's the type of the recursive variable _x.
+|}]
+
 (**********************************************************)
-(* Test 10: not allowed in [@@unboxed] declarations (yet) *)
+(* Test 11: not allowed in [@@unboxed] declarations (yet) *)
 
 type ('a : value & value) t = A of 'a [@@unboxed]
 [%%expect{|
@@ -763,8 +1451,53 @@ Error: Type "#(int * int)" has layout "value & value".
        [@@unboxed] inlined records may not yet contain types of this layout.
 |}]
 
+type unboxed_record = #{ i1 : int; i2 : int }
+type t = A of unboxed_record [@@unboxed]
+[%%expect{|
+type unboxed_record = #{ i1 : int; i2 : int; }
+Line 2, characters 9-28:
+2 | type t = A of unboxed_record [@@unboxed]
+             ^^^^^^^^^^^^^^^^^^^
+Error: Type "unboxed_record" has layout "value & value".
+       Unboxed variants may not yet contain types of this layout.
+|}]
+
+type ('a : value & value) t = A of { x : 'a } [@@unboxed]
+[%%expect{|
+Line 1, characters 37-43:
+1 | type ('a : value & value) t = A of { x : 'a } [@@unboxed]
+                                         ^^^^^^
+Error: Type "'a" has layout "value & value".
+       [@@unboxed] inlined records may not yet contain types of this layout.
+|}]
+
+type unboxed_inline_record = #{ i1 : int; i2 : int }
+type t = A of { x : unboxed_inline_record } [@@unboxed]
+[%%expect{|
+type unboxed_inline_record = #{ i1 : int; i2 : int; }
+Line 2, characters 16-41:
+2 | type t = A of { x : unboxed_inline_record } [@@unboxed]
+                    ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type "unboxed_inline_record" has layout "value & value".
+       [@@unboxed] inlined records may not yet contain types of this layout.
+|}]
+
+(* Unboxed records of kind value are allowed *)
+
+type unboxed_record = #{ i : int }
+type t = A of unboxed_record [@@unboxed]
+[%%expect{|
+type unboxed_record = #{ i : int; }
+type t = A of unboxed_record [@@unboxed]
+|}]
+
+type t = A of { x : unboxed_record } [@@unboxed]
+[%%expect{|
+type t = A of { x : unboxed_record; } [@@unboxed]
+|}]
+
 (**************************************)
-(* Test 11: Unboxed tuples and arrays *)
+(* Test 12: Unboxed tuples and arrays *)
 
 (* You can write the type of an array of unboxed tuples, but not create
    one. Soon, you can do both. *)
@@ -839,9 +1572,69 @@ external array_set : ('a : any_non_null). 'a array -> int -> 'a -> unit
 val f : #(int * int) array -> unit = <fun>
 |}]
 
+(* You can write the type of an array of unboxed records, but not create
+   one. Soon, you can do both. *)
+type ('a : value & value) t1 = 'a array
+type ('a : bits64 & (value & float64)) t2 = 'a array
+
+type t3_record = #{ i : int; b : bool }
+type t3 = t3_record array
+
+type t4_inner = #{ f : float#; bo : bool option }
+type t4_record = #{ s : string; inner : t4_inner }
+type t4 = t4_record array
+[%%expect{|
+type ('a : value & value) t1 = 'a array
+type ('a : bits64 & (value & float64)) t2 = 'a array
+type t3_record = #{ i : int; b : bool; }
+type t3 = t3_record array
+type t4_inner = #{ f : float#; bo : bool option; }
+type t4_record = #{ s : string; inner : t4_inner; }
+type t4 = t4_record array
+|}]
+
+type array_record = #{ i1 : int; i2 : int }
+let _ = [| #{ i1 = 1; i2 = 2 } |]
+[%%expect{|
+type array_record = #{ i1 : int; i2 : int; }
+Line 2, characters 8-33:
+2 | let _ = [| #{ i1 = 1; i2 = 2 } |]
+            ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Non-value layout value & value detected as sort for type array_record,
+       but this requires extension layouts_alpha, which is not enabled.
+       If you intended to use this layout, please add this flag to your build file.
+       Otherwise, please report this error to the Jane Street compilers team.
+|}]
+
+type array_init_record = #{ i1 : int; i2 : int }
+let _ = Array.init 3 (fun _ -> #{ i1 = 1; i2 = 2 })
+[%%expect{|
+type array_init_record = #{ i1 : int; i2 : int; }
+Line 2, characters 31-50:
+2 | let _ = Array.init 3 (fun _ -> #{ i1 = 1; i2 = 2 })
+                                   ^^^^^^^^^^^^^^^^^^^
+Error: This expression has type "array_init_record"
+       but an expression was expected of type "('a : value)"
+       The layout of array_init_record is value & value
+         because of the definition of array_init_record at line 1, characters 0-48.
+       But the layout of array_init_record must be a sublayout of value.
+|}]
+
+(* Arrays of unboxed records of kind value *are* allowed *)
+type array_record = #{ i : int  }
+let _ = [| #{ i = 1 } |]
+[%%expect{|
+type array_record = #{ i : int; }
+- : array_record array = [|#{i = 1}|]
+|}]
+
+let _ = Array.init 3 (fun i -> #{ i })
+[%%expect{|
+- : array_record array = [|#{i = 0}; #{i = 1}; #{i = 2}|]
+|}]
 
 (***********************************************************)
-(* Test 12: Unboxed products are not allowed as class args *)
+(* Test 13: Unboxed products are not allowed as class args *)
 
 class product_instance_variable x =
   let sum = let #(a,b) = x in a + b in
@@ -860,8 +1653,40 @@ Error: This expression has type "('a : value)"
          because it's the type of a term-level argument to a class constructor.
 |}]
 
+type class_arg_record = #{ a : int; b : int }
+class product_instance_variable x =
+  let sum = let #{ a; b } = x in a + b in
+  object
+    method y = sum
+  end;;
+[%%expect{|
+type class_arg_record = #{ a : int; b : int; }
+Line 3, characters 28-29:
+3 |   let sum = let #{ a; b } = x in a + b in
+                                ^
+Error: This expression has type "('a : value)"
+       but an expression was expected of type "class_arg_record"
+       The layout of class_arg_record is value & value
+         because of the definition of class_arg_record at line 1, characters 0-45.
+       But the layout of class_arg_record must be a sublayout of value
+         because it's the type of a term-level argument to a class constructor.
+|}]
+
+(* But unboxed records of kind value are: *)
+type class_arg_record = #{ a : string }
+class product_instance_variable x =
+  let s = let #{ a } = x in a in
+  object
+    method y = s
+  end;;
+[%%expect{|
+type class_arg_record = #{ a : string; }
+class product_instance_variable :
+  class_arg_record -> object method y : string end
+|}]
+
 (*****************************************)
-(* Test 13: No lazy unboxed products yet *)
+(* Test 14: No lazy unboxed products yet *)
 
 let x = lazy #(1,2)
 
@@ -890,8 +1715,52 @@ Error: This type "#(int * int)" should be an instance of type "('a : value)"
          because the type argument of lazy_t has layout value.
 |}]
 
+type lazy_record = #{ i1 : int; i2 : int }
+let x = lazy #{ i1 = 1; i2 = 2 }
+[%%expect{|
+type lazy_record = #{ i1 : int; i2 : int; }
+Line 2, characters 13-32:
+2 | let x = lazy #{ i1 = 1; i2 = 2 }
+                 ^^^^^^^^^^^^^^^^^^^
+Error: This expression has type "lazy_record"
+       but an expression was expected of type "('a : value)"
+       The layout of lazy_record is value & value
+         because of the definition of lazy_record at line 1, characters 0-42.
+       But the layout of lazy_record must be a sublayout of value
+         because it's the type of a lazy expression.
+|}]
+
+type lazy_t_record = #{ i1 : int; i2 : int }
+type t = lazy_t_record lazy_t
+[%%expect{|
+type lazy_t_record = #{ i1 : int; i2 : int; }
+Line 2, characters 9-22:
+2 | type t = lazy_t_record lazy_t
+             ^^^^^^^^^^^^^
+Error: This type "lazy_t_record" should be an instance of type "('a : value)"
+       The layout of lazy_t_record is value & value
+         because of the definition of lazy_t_record at line 1, characters 0-44.
+       But the layout of lazy_t_record must be a sublayout of value
+         because the type argument of lazy_t has layout value.
+|}]
+
+(* Again, unboxed records of kind value can be: *)
+
+type t = #{ i : int }
+let x = lazy #{ i = 1 }
+[%%expect{|
+type t = #{ i : int; }
+val x : t lazy_t = <lazy>
+|}]
+
+type t2 = t lazy_t
+[%%expect{|
+type t2 = t lazy_t
+|}]
+
+
 (***************************************)
-(* Test 14: Coercions work covariantly *)
+(* Test 15: Coercions work covariantly *)
 
 type t = private int
 
@@ -911,8 +1780,26 @@ Error: Type "#(int * int)" is not a subtype of "#(t * t)"
        Type "int" is not a subtype of "t"
 |}]
 
+(* Unboxed records can't be coerced *)
+
+type t = private int
+
+type coerce_record = #{ t1 : t; t2 : t }
+type coerce_int_record = #{ i1 : int; i2 : int }
+let f (x : coerce_record) =
+  let #{ i1 = a; i2 = b } = (x :> coerce_int_record) in a + b
+[%%expect{|
+type t = private int
+type coerce_record = #{ t1 : t; t2 : t; }
+type coerce_int_record = #{ i1 : int; i2 : int; }
+Line 6, characters 28-52:
+6 |   let #{ i1 = a; i2 = b } = (x :> coerce_int_record) in a + b
+                                ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Type "coerce_record" is not a subtype of "coerce_int_record"
+|}]
+
 (************************************************)
-(* Test 15: Not allowed as an optional argument *)
+(* Test 16: Not allowed as an optional argument *)
 
 let f_optional_utuple ?(x = #(1,2)) () = x
 [%%expect{|
@@ -927,8 +1814,23 @@ Error: This expression has type "#('a * 'b)"
          because the type argument of option has layout value.
 |}]
 
+type optional_record = #{ i1 : int; i2 : int }
+let f_optional_urecord ?(x = #{ i1 = 1; i2 = 2 }) () = x
+[%%expect{|
+type optional_record = #{ i1 : int; i2 : int; }
+Line 2, characters 29-48:
+2 | let f_optional_urecord ?(x = #{ i1 = 1; i2 = 2 }) () = x
+                                 ^^^^^^^^^^^^^^^^^^^
+Error: This expression has type "optional_record"
+       but an expression was expected of type "('a : value)"
+       The layout of optional_record is value & value
+         because of the definition of optional_record at line 1, characters 0-46.
+       But the layout of optional_record must be a sublayout of value
+         because the type argument of option has layout value.
+|}]
+
 (******************************)
-(* Test 16: Decomposing [any] *)
+(* Test 17: Decomposing [any] *)
 
 type ('a : value) u = U of 'a [@@unboxed]
 type ('a : value) t = #('a u * 'a u)
@@ -977,8 +1879,53 @@ Error: This type "#(int * string * int)" should be an instance of type
 |}]
 (* CR layouts v7.1: The appearance of [immutable_data] above is regrettable. *)
 
+type ('a : value) u = U of 'a [@@unboxed]
+type ('a : value) t = #{ u1 : 'a u; u2 : 'a u }
+
+type ('a : any mod global) needs_any_mod_global
+
+type should_work = int t needs_any_mod_global
+[%%expect{|
+type 'a u = U of 'a [@@unboxed]
+type 'a t = #{ u1 : 'a u; u2 : 'a u; }
+type ('a : any mod global) needs_any_mod_global
+type should_work = int t needs_any_mod_global
+|}]
+
+type should_fail = string t needs_any_mod_global
+[%%expect{|
+Line 1, characters 19-27:
+1 | type should_fail = string t needs_any_mod_global
+                       ^^^^^^^^
+Error: This type "string t" should be an instance of type "('a : any mod global)"
+       The kind of string t is value & value
+         because of the definition of t at line 2, characters 0-47.
+       But the kind of string t must be a subkind of any mod global
+         because of the definition of needs_any_mod_global at line 4, characters 0-47.
+|}]
+
+type ('a : any mod external_) t
+
+type s_record = #{ i1 : int; s : string; i2 : int }
+type s = s_record t
+[%%expect{|
+type ('a : any mod external_) t
+type s_record = #{ i1 : int; s : string; i2 : int; }
+Line 4, characters 9-17:
+4 | type s = s_record t
+             ^^^^^^^^
+Error: This type "s_record" should be an instance of type
+         "('a : any mod external_)"
+       The kind of s_record is
+         immutable_data & immutable_data & immutable_data
+         because of the definition of s_record at line 3, characters 0-51.
+       But the kind of s_record must be a subkind of any mod external_
+         because of the definition of t at line 1, characters 0-31.
+|}]
+(* CR layouts v7.1: Both the above have very bad error messages. *)
+
 (********************************************)
-(* Test 17: Subkinding with sorts and [any] *)
+(* Test 18: Subkinding with sorts and [any] *)
 
 (* CR layouts: Change to use [any] instead of [any_non_null] when doing so
    won't cause trouble with the [alpha] check. *)
diff --git a/testsuite/tests/typing-layouts-unboxed-records/basics.ml b/testsuite/tests/typing-layouts-products/basics_unboxed_records.ml
similarity index 99%
rename from testsuite/tests/typing-layouts-unboxed-records/basics.ml
rename to testsuite/tests/typing-layouts-products/basics_unboxed_records.ml
index 2827e5b0d71..5f6726da4dc 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/basics.ml
+++ b/testsuite/tests/typing-layouts-products/basics_unboxed_records.ml
@@ -1,7 +1,6 @@
 (* TEST
  flambda2;
  include stdlib_upstream_compatible;
- flags = "-extension layouts_alpha";
  {
    expect;
  }
@@ -682,7 +681,7 @@ val update_t : t -> unit = <fun>
 
 type ('a : any) t = #{ x : int; y : 'a }
 [%%expect{|
-type ('a : value_or_null) t = #{ x : int; y : 'a; }
+type 'a t = #{ x : int; y : 'a; }
 |}]
 
 (* CR layouts v7.2: once we allow record declarations with unknown kind (right
diff --git a/testsuite/tests/typing-layouts-products/exhaustiveness.ml b/testsuite/tests/typing-layouts-products/exhaustiveness.ml
index 289088f5ea6..f7601c696fe 100644
--- a/testsuite/tests/typing-layouts-products/exhaustiveness.ml
+++ b/testsuite/tests/typing-layouts-products/exhaustiveness.ml
@@ -16,3 +16,34 @@ let f t t' =
 type t = A | B
 val f : t -> 'a -> bool = <fun>
 |}]
+
+type t = A | B
+type r = #{ x : t; y : t }
+
+let f t t' =
+  match #{ x = t; y = t' } with
+  | #{ x = A; y = _ } -> true
+  | #{ x = B; y = _ } -> false
+[%%expect{|
+type t = A | B
+type r = #{ x : t; y : t; }
+val f : t -> t -> bool = <fun>
+|}]
+
+(* This is a regression test. The example below used to give
+   #{y=A; _ } as a counterexample instead of #{y=A; x=B}. *)
+let g t t' =
+  match #{ x = t; y = t' } with
+  | #{ x = A; _ } -> true
+  | #{ y = B; _ } -> false
+[%%expect{|
+Lines 2-4, characters 2-26:
+2 | ..match #{ x = t; y = t' } with
+3 |   | #{ x = A; _ } -> true
+4 |   | #{ y = B; _ } -> false
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+#{y=A; x=B}
+
+val g : t -> t -> bool = <fun>
+|}]
diff --git a/testsuite/tests/typing-layouts-unboxed-records/letrec.ml b/testsuite/tests/typing-layouts-products/letrec.ml
similarity index 77%
rename from testsuite/tests/typing-layouts-unboxed-records/letrec.ml
rename to testsuite/tests/typing-layouts-products/letrec.ml
index 847b2fa41a6..81ad1611598 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/letrec.ml
+++ b/testsuite/tests/typing-layouts-products/letrec.ml
@@ -1,20 +1,22 @@
 (* TEST
  flambda2;
  include stdlib_upstream_compatible;
- flags = "-extension layouts_beta";
  {
    expect;
  }
 *)
 
+(* This test was made to error by disallowing singleton recursive unboxed types.
+   We keep it in case these are re-allowed, in which case it should error with:
+   [This kind of expression is not allowed as right-hand side of "let rec"] *)
 type t : value = #{ t : t }
 let rec t = #{ t = t }
 [%%expect{|
-type t = #{ t : t; }
-Line 2, characters 12-22:
-2 | let rec t = #{ t = t }
-                ^^^^^^^^^^
-Error: This kind of expression is not allowed as right-hand side of "let rec"
+Line 1, characters 0-27:
+1 | type t : value = #{ t : t }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "t" is recursive without boxing:
+         "t" contains "t"
 |}]
 
 type bx = { bx : ubx }
@@ -34,10 +36,7 @@ let rec t = { bx = #{ ubx = t } }
 val t : bx = {bx = <cycle>}
 |}]
 
-(* The below is adapted from [testsuite/tests/letrec-check/unboxed.ml].
-
-   CR layouts v7.2: once unboxed records are in stable, fold this test back into
-   the original or move it to [typing-layouts-products]. *)
+(* The below is adapted from [testsuite/tests/letrec-check/unboxed.ml]. *)
 
 type t = #{x: int64}
 let rec x = #{x = y} and y = 3L;;
diff --git a/testsuite/tests/typing-layouts-products/parsing_inline_unboxed_record.compilers.reference b/testsuite/tests/typing-layouts-products/parsing_inline_unboxed_record.compilers.reference
new file mode 100644
index 00000000000..174e4975100
--- /dev/null
+++ b/testsuite/tests/typing-layouts-products/parsing_inline_unboxed_record.compilers.reference
@@ -0,0 +1,4 @@
+File "parsing_inline_unboxed_record.ml", line 10, characters 22-24:
+10 | type variant = Foo of #{ x : string }
+                           ^^
+Error: Syntax error
diff --git a/testsuite/tests/typing-layouts-unboxed-records/parsing_inline_unboxed_record.ml b/testsuite/tests/typing-layouts-products/parsing_inline_unboxed_record.ml
similarity index 82%
rename from testsuite/tests/typing-layouts-unboxed-records/parsing_inline_unboxed_record.ml
rename to testsuite/tests/typing-layouts-products/parsing_inline_unboxed_record.ml
index 5540637473e..9a4052ecef1 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/parsing_inline_unboxed_record.ml
+++ b/testsuite/tests/typing-layouts-products/parsing_inline_unboxed_record.ml
@@ -1,5 +1,4 @@
 (* TEST
-   flags = "-extension-universe beta";
    setup-ocamlc.byte-build-env;
    ocamlc_byte_exit_status = "2";
    ocamlc.byte;
diff --git a/testsuite/tests/typing-layouts-products/parsing_module_dot_unboxed_record.compilers.reference b/testsuite/tests/typing-layouts-products/parsing_module_dot_unboxed_record.compilers.reference
new file mode 100644
index 00000000000..7c389fd11e2
--- /dev/null
+++ b/testsuite/tests/typing-layouts-products/parsing_module_dot_unboxed_record.compilers.reference
@@ -0,0 +1,4 @@
+File "parsing_module_dot_unboxed_record.ml", line 14, characters 11-12:
+14 | let t = M.#{ i = 1 }
+                ^
+Error: Syntax error
diff --git a/testsuite/tests/typing-layouts-unboxed-records/parsing_module_dot_unboxed_record.ml b/testsuite/tests/typing-layouts-products/parsing_module_dot_unboxed_record.ml
similarity index 87%
rename from testsuite/tests/typing-layouts-unboxed-records/parsing_module_dot_unboxed_record.ml
rename to testsuite/tests/typing-layouts-products/parsing_module_dot_unboxed_record.ml
index 0309a84c82a..fdbd7a50dcc 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/parsing_module_dot_unboxed_record.ml
+++ b/testsuite/tests/typing-layouts-products/parsing_module_dot_unboxed_record.ml
@@ -1,5 +1,4 @@
 (* TEST
-   flags = "-extension-universe beta";
    setup-ocamlc.byte-build-env;
    ocamlc_byte_exit_status = "2";
    ocamlc.byte;
diff --git a/testsuite/tests/typing-layouts-products/recursive.ml b/testsuite/tests/typing-layouts-products/recursive.ml
new file mode 100644
index 00000000000..48b586ec093
--- /dev/null
+++ b/testsuite/tests/typing-layouts-products/recursive.ml
@@ -0,0 +1,475 @@
+(* TEST
+ flambda2;
+ include stdlib_upstream_compatible;
+ {
+   expect;
+ }
+*)
+
+(* We only allow recursion of unboxed product types through boxing, otherwise
+   the type is uninhabitable and usually also infinite-size. *)
+
+(***********************************************)
+(* Allowed (guarded) recursive unboxed records *)
+
+(* Guarded by `list` *)
+type t = #{ tl: t list }
+[%%expect{|
+type t = #{ tl : t list; }
+|}]
+
+module AbstractList : sig
+  type 'a t
+end = struct
+  type 'a t = Cons of 'a * 'a list | Nil
+end
+[%%expect{|
+module AbstractList : sig type 'a t end
+|}]
+
+type t = #{ tl: t AbstractList.t }
+[%%expect{|
+type t = #{ tl : t AbstractList.t; }
+|}]
+
+type 'a mylist = Cons of 'a * 'a list | Nil
+and t = { t : t mylist } [@@unboxed]
+[%%expect{|
+type 'a mylist = Cons of 'a * 'a list | Nil
+and t = { t : t mylist; } [@@unboxed]
+|}]
+
+(* This passes the unboxed recursion check (as [pair] always has jkind
+   [value & value], [(int, bad) pair] is indeed finite-size, but it fails the
+   jkind check *)
+type ('a, 'b) pair = #{ a : 'a ; b : 'b }
+type bad = #{ bad : (int, bad) pair }
+[%%expect{|
+type ('a, 'b) pair = #{ a : 'a; b : 'b; }
+Line 2, characters 0-37:
+2 | type bad = #{ bad : (int, bad) pair }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error:
+       The layout of bad is value & value
+         because of the definition of pair at line 1, characters 0-41.
+       But the layout of bad must be a sublayout of value
+         because of the definition of pair at line 1, characters 0-41.
+|}]
+
+(* This fails the unboxed recursion check; we must look into [pair] since it's
+   part of the same mutually recursive type decl. *)
+type ('a, 'b) pair = #{ a : 'a ; b : 'b }
+and bad = #{ bad : (int, bad) pair }
+[%%expect{|
+Line 2, characters 0-36:
+2 | and bad = #{ bad : (int, bad) pair }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "(int, bad) pair",
+         "(int, bad) pair" contains "bad"
+|}]
+
+(* Guarded by a function *)
+type t = #{ f1 : t -> t ; f2 : t -> t }
+[%%expect{|
+type t = #{ f1 : t -> t; f2 : t -> t; }
+|}]
+
+(* Guarded by a tuple *)
+type a = #{ b : b }
+and b = a * a
+[%%expect{|
+type a = #{ b : b; }
+and b = a * a
+|}]
+
+(* Guarded by a function *)
+type a = #{ b : b }
+and b = #{ c1 : c ; c2 : c }
+and c = unit -> a
+[%%expect{|
+type a = #{ b : b; }
+and b = #{ c1 : c; c2 : c; }
+and c = unit -> a
+|}]
+
+(* Recursion through modules guarded by a function *)
+module rec A : sig
+  type t = #{ b1 : B.t ; b2 : B.t }
+end = struct
+  type t = #{ b1 : B.t ; b2 : B.t }
+end
+and B : sig
+  type t = unit -> A.t
+end = struct
+  type t = unit -> A.t
+end
+[%%expect{|
+module rec A : sig type t = #{ b1 : B.t; b2 : B.t; } end
+and B : sig type t = unit -> A.t end
+|}]
+
+(**********************************)
+(* Infinite-sized unboxed records *)
+
+type bad = #{ bad : bad ; i : int}
+[%%expect{|
+Line 1, characters 0-34:
+1 | type bad = #{ bad : bad ; i : int}
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "bad"
+|}]
+
+type a_bad = #{ b_bad : b_bad }
+and b_bad = #{ a_bad : a_bad }
+[%%expect{|
+Line 1, characters 0-31:
+1 | type a_bad = #{ b_bad : b_bad }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "a_bad" is recursive without boxing:
+         "a_bad" contains "b_bad",
+         "b_bad" contains "a_bad"
+|}]
+
+type bad : any = #{ bad : bad }
+[%%expect{|
+Line 1, characters 0-31:
+1 | type bad : any = #{ bad : bad }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "bad"
+|}]
+
+type bad = #{ x : #(int * u) }
+and u = T of bad [@@unboxed]
+[%%expect{|
+Line 1, characters 0-30:
+1 | type bad = #{ x : #(int * u) }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "u",
+         "u" contains "bad"
+|}]
+
+type 'a record_id = #{ a : 'a }
+type 'a alias_id = 'a
+[%%expect{|
+type 'a record_id = #{ a : 'a; }
+type 'a alias_id = 'a
+|}]
+
+type bad = bad record_id
+[%%expect{|
+Line 1, characters 0-24:
+1 | type bad = bad record_id
+    ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation "bad" is cyclic:
+         "bad" = "bad record_id",
+         "bad record_id" contains "bad"
+|}]
+
+type bad = bad alias_id
+[%%expect{|
+Line 1, characters 0-23:
+1 | type bad = bad alias_id
+    ^^^^^^^^^^^^^^^^^^^^^^^
+Error: The type abbreviation "bad" is cyclic:
+         "bad" = "bad alias_id",
+         "bad alias_id" = "bad"
+|}]
+
+
+type 'a bad = #{ bad : 'a bad ; u : 'a}
+[%%expect{|
+Line 1, characters 0-39:
+1 | type 'a bad = #{ bad : 'a bad ; u : 'a}
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "'a bad" contains "'a bad"
+|}]
+
+type 'a bad = { bad : 'a bad ; u : 'a}
+[%%expect{|
+type 'a bad = { bad : 'a bad; u : 'a; }
+|}]
+
+type bad : float64 = #{ bad : bad ; i : int}
+[%%expect{|
+Line 1, characters 0-44:
+1 | type bad : float64 = #{ bad : bad ; i : int}
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "bad"
+|}]
+
+type bad = #{ a : t ; b : t }
+[%%expect{|
+type bad = #{ a : t; b : t; }
+|}]
+
+type 'a bad = #{ a : 'a bad }
+[%%expect{|
+Line 1, characters 0-29:
+1 | type 'a bad = #{ a : 'a bad }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "'a bad" contains "'a bad"
+|}]
+
+type bad = #( s * s )
+and ('a : any) record_id2 = #{ a : 'a }
+and s = #{ u : u }
+and u = #(int * bad record_id2)
+[%%expect{|
+Line 1, characters 0-21:
+1 | type bad = #( s * s )
+    ^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" = "#(s * s)",
+         "#(s * s)" contains "s",
+         "s" contains "u",
+         "u" = "#(int * bad record_id2)",
+         "#(int * bad record_id2)" contains "bad record_id2",
+         "bad record_id2" contains "bad"
+|}]
+
+type bad = #( s * s )
+and ('a : any) record_id2 = #{ a : 'a }
+and s = #{ u : u }
+and u = #(int * bad record_id2)
+[%%expect{|
+Line 1, characters 0-21:
+1 | type bad = #( s * s )
+    ^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" = "#(s * s)",
+         "#(s * s)" contains "s",
+         "s" contains "u",
+         "u" = "#(int * bad record_id2)",
+         "#(int * bad record_id2)" contains "bad record_id2",
+         "bad record_id2" contains "bad"
+|}]
+
+(* We also check recursive types via modules *)
+module rec Bad_rec1 : sig
+  type t = #( s * s )
+  and s = #{ u : Bad_rec2.u }
+end = struct
+  type t = #( s * s )
+  and s = #{ u : Bad_rec2.u }
+end
+and Bad_rec2 : sig
+  type u = Bad_rec1.t id
+  and 'a id = 'a
+end = struct
+  type u = Bad_rec1.t id
+  and 'a id = 'a
+end
+[%%expect{|
+Lines 1-7, characters 0-3:
+1 | module rec Bad_rec1 : sig
+2 |   type t = #( s * s )
+3 |   and s = #{ u : Bad_rec2.u }
+4 | end = struct
+5 |   type t = #( s * s )
+6 |   and s = #{ u : Bad_rec2.u }
+7 | end
+Error: The definition of "Bad_rec1.t" is recursive without boxing:
+         "Bad_rec1.t" = "#(Bad_rec1.s * Bad_rec1.s)",
+         "#(Bad_rec1.s * Bad_rec1.s)" contains "Bad_rec1.s",
+         "Bad_rec1.s" contains "Bad_rec2.u",
+         "Bad_rec2.u" = "Bad_rec1.t Bad_rec2.id",
+         "Bad_rec1.t Bad_rec2.id" = "Bad_rec1.t"
+|}]
+
+(* When we allow records with elements of unrepresentable layout, this should
+   still be disallowed. *)
+module M : sig
+  type ('a : any) opaque_id : any
+end = struct
+  type ('a : any) opaque_id = 'a
+end
+[%%expect{|
+module M : sig type ('a : any) opaque_id : any end
+|}]
+type a = #{ b : b M.opaque_id }
+and b = #{ a : a M.opaque_id }
+[%%expect{|
+Line 1, characters 12-29:
+1 | type a = #{ b : b M.opaque_id }
+                ^^^^^^^^^^^^^^^^^
+Error: Unboxed record element types must have a representable layout.
+       The layout of b M.opaque_id is any
+         because of the definition of opaque_id at line 2, characters 2-33.
+       But the layout of b M.opaque_id must be representable
+         because it is the type of record field b.
+|}]
+
+(* Make sure we look through [as] types *)
+
+type 'a t = #{ x: ('a s as 'm) list ; m : 'm }
+and 'b s = #{ x : 'b t }
+[%%expect{|
+Line 1, characters 0-46:
+1 | type 'a t = #{ x: ('a s as 'm) list ; m : 'm }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "t" is recursive without boxing:
+         "'a t" contains "'a s",
+         "'a s" contains "'a t"
+|}]
+
+type 'a t = #{ x: ('a s as 'm) }
+and 'b s = #{ x : 'b t }
+[%%expect{|
+Line 1, characters 0-32:
+1 | type 'a t = #{ x: ('a s as 'm) }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "t" is recursive without boxing:
+         "'a t" contains "'a s",
+         "'a s" contains "'a t"
+|}]
+
+(***************************************)
+(* Singleton recursive unboxed records *)
+
+type 'a safe = #{ a : 'a }
+type x = int safe safe
+[%%expect{|
+type 'a safe = #{ a : 'a; }
+type x = int safe safe
+|}]
+
+type 'a id = 'a
+type x = #{ x : x id }
+[%%expect{|
+type 'a id = 'a
+type x = #{ x : x id; }
+|}]
+
+(* CR layouts v7.2: allow bounded repetition of the same type constructor of
+   unboxed records. *)
+type 'a safe = #{ a : 'a }
+and x = int safe safe
+[%%expect{|
+Line 2, characters 0-21:
+2 | and x = int safe safe
+    ^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "x" is recursive without boxing:
+         "x" = "int safe safe",
+         "int safe safe" contains "int safe"
+|}]
+
+(* We could allow these, as although they have unguarded recursion,
+   they are finite size (thanks to the fact that we represent single-field
+   records as the layout of the field rather than as a singleton product).
+   However, allowing them makes checking for recursive types more difficult,
+   and they are uninhabitable anyway. *)
+
+type bad : value = #{ bad : bad }
+[%%expect{|
+Line 1, characters 0-33:
+1 | type bad : value = #{ bad : bad }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "bad"
+|}]
+
+type bad : float64 = #{ bad : bad }
+[%%expect{|
+Line 1, characters 0-35:
+1 | type bad : float64 = #{ bad : bad }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "bad"
+|}]
+
+
+type bad : value = #{ bad : bad }
+[%%expect{|
+Line 1, characters 0-33:
+1 | type bad : value = #{ bad : bad }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "bad"
+|}]
+
+type bad = #{ bad : bad }
+[%%expect{|
+Line 1, characters 0-25:
+1 | type bad = #{ bad : bad }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "bad"
+|}]
+
+(* We actually can create singleton recursive unboxed record types,
+   through recursive modules *)
+
+module F (X : sig type t end) = struct
+  type u = #{ u : X.t }
+end
+
+module rec M : sig
+  type u
+  type t = u
+end = struct
+  include F(M)
+  type t = u
+end
+[%%expect{|
+module F : functor (X : sig type t end) -> sig type u = #{ u : X.t; } end
+module rec M : sig type u type t = u end
+|}]
+
+module F (X : sig
+    type u
+    type t = #{ u : u }
+  end) = struct
+  type u = X.t = #{ u : X.u }
+end
+
+module rec M : sig
+  type u
+  type t = #{ u : u }
+end = struct
+  include F(M)
+  type t = #{ u : u }
+  let rec u = #{ u }
+end
+[%%expect{|
+module F :
+  functor (X : sig type u type t = #{ u : u; } end) ->
+    sig type u = X.t = #{ u : X.u; } end
+Line 14, characters 14-20:
+14 |   let rec u = #{ u }
+                   ^^^^^^
+Error: This kind of expression is not allowed as right-hand side of "let rec"
+|}]
+
+
+(* This should still error once unboxed records elements need not have a
+   representable layout *)
+module type S = sig
+  type u : any
+  type t = #{ a : u ; b : u }
+end
+module F (X : S) = struct
+  type u = X.t = #{ a : X.u ; b : X.u}
+end
+
+module rec M : S = struct
+  include F(M)
+  type t = #{ a : u ; b : u }
+  let rec u = #{ u ; u }
+end
+[%%expect{|
+Line 3, characters 14-21:
+3 |   type t = #{ a : u ; b : u }
+                  ^^^^^^^
+Error: Unboxed record element types must have a representable layout.
+       The layout of u is any
+         because of the definition of u at line 2, characters 2-14.
+       But the layout of u must be representable
+         because it is the type of record field a.
+|}]
diff --git a/testsuite/tests/typing-layouts-unboxed-records/separability.ml b/testsuite/tests/typing-layouts-products/separability.ml
similarity index 100%
rename from testsuite/tests/typing-layouts-unboxed-records/separability.ml
rename to testsuite/tests/typing-layouts-products/separability.ml
diff --git a/testsuite/tests/typing-layouts-unboxed-records/typing_misc_unboxed_records.ml b/testsuite/tests/typing-layouts-products/typing_misc_unboxed_records.ml
similarity index 99%
rename from testsuite/tests/typing-layouts-unboxed-records/typing_misc_unboxed_records.ml
rename to testsuite/tests/typing-layouts-products/typing_misc_unboxed_records.ml
index a15c7fddaa4..01bfbc96624 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/typing_misc_unboxed_records.ml
+++ b/testsuite/tests/typing-layouts-products/typing_misc_unboxed_records.ml
@@ -1,5 +1,4 @@
 (* TEST
-   flags = "-extension layouts_beta";
    {
      expect;
    }
diff --git a/testsuite/tests/typing-layouts-unboxed-records/typing-warnings.ml b/testsuite/tests/typing-layouts-products/typing_warnings_unboxed_records.ml
similarity index 98%
rename from testsuite/tests/typing-layouts-unboxed-records/typing-warnings.ml
rename to testsuite/tests/typing-layouts-products/typing_warnings_unboxed_records.ml
index b56729eeaed..c6f3d3d2340 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/typing-warnings.ml
+++ b/testsuite/tests/typing-layouts-products/typing_warnings_unboxed_records.ml
@@ -1,5 +1,5 @@
 (* TEST
- flags = " -w +A -strict-sequence -extension layouts_beta";
+ flags = " -w +A -strict-sequence";
  expect;
 *)
 
@@ -32,10 +32,7 @@ external ignore_product : ('a : value & value). 'a -> unit = "%ignore"
 |}]
 
 (* This below tests are adapted from
-   [testsuite/tests/typing-warnings/records.ml].
-
-   CR layouts v7.2: once unboxed records are in stable, fold this test back into
-   the original or move it to [typing-layouts-products]. *)
+   [testsuite/tests/typing-warnings/records.ml]. *)
 
 (* Use type information *)
 module M1 = struct
diff --git a/testsuite/tests/typing-layouts-unboxed-records/unboxed_records.ml b/testsuite/tests/typing-layouts-products/unboxed_records.ml
similarity index 97%
rename from testsuite/tests/typing-layouts-unboxed-records/unboxed_records.ml
rename to testsuite/tests/typing-layouts-products/unboxed_records.ml
index 882c107a389..927e1b74603 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/unboxed_records.ml
+++ b/testsuite/tests/typing-layouts-products/unboxed_records.ml
@@ -3,19 +3,6 @@
  include stdlib_upstream_compatible;
  flambda2;
  {
-   ocamlc_byte_exit_status = "2";
-   setup-ocamlc.byte-build-env;
-   compiler_reference = "${test_source_directory}/unboxed_records_stable.compilers.reference";
-   ocamlc.byte;
-   check-ocamlc.byte-output;
- }{
-   ocamlc_byte_exit_status = "2";
-   setup-ocamlc.byte-build-env;
-   flags = "-extension-universe upstream_compatible";
-   compiler_reference = "${test_source_directory}/unboxed_records_stable.compilers.reference";
-   ocamlc.byte;
-   check-ocamlc.byte-output;
- }{
    ocamlc_byte_exit_status = "2";
    setup-ocamlc.byte-build-env;
    flags = "-extension-universe no_extensions";
@@ -46,7 +33,13 @@
  }{
    flags = "-extension layouts_beta";
    bytecode;
-   }
+ }{
+   flags = "";
+   bytecode;
+ }{
+   flags = "";
+   native;
+ }
 *)
 
 open Stdlib_upstream_compatible
diff --git a/testsuite/tests/typing-layouts-unboxed-records/unboxed_records.reference b/testsuite/tests/typing-layouts-products/unboxed_records.reference
similarity index 100%
rename from testsuite/tests/typing-layouts-unboxed-records/unboxed_records.reference
rename to testsuite/tests/typing-layouts-products/unboxed_records.reference
diff --git a/testsuite/tests/typing-layouts-unboxed-records/basics_alpha.ml b/testsuite/tests/typing-layouts-products/unboxed_records_alpha.ml
similarity index 92%
rename from testsuite/tests/typing-layouts-unboxed-records/basics_alpha.ml
rename to testsuite/tests/typing-layouts-products/unboxed_records_alpha.ml
index af39bb18f64..0c1d36b2e9e 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/basics_alpha.ml
+++ b/testsuite/tests/typing-layouts-products/unboxed_records_alpha.ml
@@ -25,7 +25,11 @@ type t = { x : t_void; } [@@unboxed]
 
 type bad : void = #{ bad : bad }
 [%%expect{|
-type bad = #{ bad : bad; }
+Line 1, characters 0-32:
+1 | type bad : void = #{ bad : bad }
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "bad" is recursive without boxing:
+         "bad" contains "bad"
 |}]
 
 type ('a : void) bad  = #{ bad : 'a bad ; u : 'a}
@@ -33,19 +37,13 @@ type ('a : void) bad  = #{ bad : 'a bad ; u : 'a}
 Line 1, characters 0-49:
 1 | type ('a : void) bad  = #{ bad : 'a bad ; u : 'a}
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error:
-       The layout of 'a bad is any & any
-         because it is an unboxed record.
-       But the layout of 'a bad must be representable
-         because it is the type of record field bad.
+Error: The definition of "bad" is recursive without boxing:
+         "'a bad" contains "'a bad"
 |}]
 
 (******************************************************************************)
 (* The below is adapted from
-   [testsuite/tests/typing-layouts-products/basics_alpha.ml].
-
-   CR layouts v7.2: once unboxed records are in stable, fold this test back into
-   the original or move it to [typing-layouts-products]. *)
+   [testsuite/tests/typing-layouts-products/basics_alpha.ml]. *)
 
 (* [t3] is allowed for unboxed tuples, and disallowed for (un)boxed records *)
 type t1 : any mod non_null
diff --git a/testsuite/tests/typing-layouts-products/unboxed_records_disabled.compilers.reference b/testsuite/tests/typing-layouts-products/unboxed_records_disabled.compilers.reference
new file mode 100644
index 00000000000..41eb03e2334
--- /dev/null
+++ b/testsuite/tests/typing-layouts-products/unboxed_records_disabled.compilers.reference
@@ -0,0 +1,4 @@
+File "unboxed_records.ml", line 47, characters 0-34:
+47 | type ints = #{ x : int ; y : int }
+     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This construct requires the stable version of the extension "layouts", which is disabled and cannot be used
diff --git a/testsuite/tests/typing-layouts-unboxed-records/unboxed_records_stable.compilers.reference b/testsuite/tests/typing-layouts-products/unboxed_records_stable.compilers.reference
similarity index 100%
rename from testsuite/tests/typing-layouts-unboxed-records/unboxed_records_stable.compilers.reference
rename to testsuite/tests/typing-layouts-products/unboxed_records_stable.compilers.reference
diff --git a/testsuite/tests/typing-layouts-unboxed-records/unique.ml b/testsuite/tests/typing-layouts-products/unique.ml
similarity index 96%
rename from testsuite/tests/typing-layouts-unboxed-records/unique.ml
rename to testsuite/tests/typing-layouts-products/unique.ml
index e9d1845bcb4..c7ce98a42bd 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/unique.ml
+++ b/testsuite/tests/typing-layouts-products/unique.ml
@@ -1,7 +1,7 @@
 (* TEST
  flambda2;
  include stdlib_upstream_compatible;
- flags = "-extension layouts_alpha -extension unique";
+ flags = "-extension unique";
  {
    expect;
  }
@@ -15,7 +15,7 @@ let unique_use2 : ('a : value & value) @ unique -> unit = fun _ -> ()
 type t = #{ x : string ; y : string }
 let mk : unit -> t @ unique = fun () -> #{ x = "hi"; y = "hi" }
 [%%expect{|
-val unique_use : ('a : value_or_null). 'a @ unique -> unit = <fun>
+val unique_use : 'a @ unique -> unit = <fun>
 val unique_use2 : ('a : value & value). 'a @ unique -> unit = <fun>
 type t = #{ x : string; y : string; }
 val mk : unit -> t @ unique = <fun>
diff --git a/testsuite/tests/typing-layouts-unboxed-records/unused.ml b/testsuite/tests/typing-layouts-products/unused_unboxed_records.ml
similarity index 93%
rename from testsuite/tests/typing-layouts-unboxed-records/unused.ml
rename to testsuite/tests/typing-layouts-products/unused_unboxed_records.ml
index c9f53e69ea9..2f7ef566385 100644
--- a/testsuite/tests/typing-layouts-unboxed-records/unused.ml
+++ b/testsuite/tests/typing-layouts-products/unused_unboxed_records.ml
@@ -1,12 +1,9 @@
 (* TEST
- flags = " -w +A -strict-sequence -extension layouts_beta";
+ flags = " -w +A -strict-sequence";
  expect;
 *)
 
-(* Adapted from [testsuite/tests/typing-warnings/unused_types.ml].
-
-   CR layouts v7.2: Once unboxed records are in stable, fold this test back into
-   the original or move it to [typing-layouts-products]. *)
+(* Adapted from [testsuite/tests/typing-warnings/unused_types.ml]. *)
 
 module Unused_record : sig end = struct
   type t = #{ a : int; b : int }
diff --git a/testsuite/tests/typing-layouts-unboxed-records/basics_from_typing_atat_unboxed.ml b/testsuite/tests/typing-layouts-unboxed-records/basics_from_typing_atat_unboxed.ml
deleted file mode 100644
index 34c7c5731d3..00000000000
--- a/testsuite/tests/typing-layouts-unboxed-records/basics_from_typing_atat_unboxed.ml
+++ /dev/null
@@ -1,153 +0,0 @@
-(* TEST
- flags = "-extension layouts_beta";
- expect;
-*)
-(* This test is adapted from
-   [testsuite/tests/typing-unboxed-types/test.ml].
-
-   CR layouts v7.2: once unboxed records are in stable, fold this test back into
-   the original or move it to [typing-layouts-products]. *)
-
-(* Check the unboxing *)
-
-(* For records *)
-type t2 = #{ f : string } ;;
-[%%expect{|
-type t2 = #{ f : string; }
-|}];;
-
-let x = #{ f = "foo" } in
-Obj.repr x == Obj.repr x.#f
-;;
-[%%expect{|
-- : bool = true
-|}];;
-
-(* Representation mismatch between module and signature must be rejected *)
-module M : sig
-  type t = { a : string }
-end = struct
-  type t = #{ a : string }
-end;;
-[%%expect{|
-Lines 3-5, characters 6-3:
-3 | ......struct
-4 |   type t = #{ a : string }
-5 | end..
-Error: Signature mismatch:
-       Modules do not match:
-         sig type t = #{ a : string; } end
-       is not included in
-         sig type t = { a : string; } end
-       Type declarations do not match:
-         type t = #{ a : string; }
-       is not included in
-         type t = { a : string; }
-       The first is an unboxed record, but the second is a record.
-|}];;
-
-module M : sig
-  type t = #{ a : string }
-end = struct
-  type t = { a : string }
-end;;
-[%%expect{|
-Lines 3-5, characters 6-3:
-3 | ......struct
-4 |   type t = { a : string }
-5 | end..
-Error: Signature mismatch:
-       Modules do not match:
-         sig type t = { a : string; } end
-       is not included in
-         sig type t = #{ a : string; } end
-       Type declarations do not match:
-         type t = { a : string; }
-       is not included in
-         type t = #{ a : string; }
-       The first is a record, but the second is an unboxed record.
-|}]
-
-(* Check interference with representation of float arrays. *)
-type t11 = #{ f : float };;
-[%%expect{|
-type t11 = #{ f : float; }
-|}];;
-let x = Array.make 10 #{ f = 3.14 }   (* represented as a flat array *)
-and f (a : t11 array) = a.(0)    (* might wrongly assume an array of pointers *)
-in assert (f x = #{ f = 3.14});;
-[%%expect{|
-- : unit = ()
-|}];;
-
-(* Check for a potential infinite loop in the typing algorithm. *)
-type 'a t12 : value = #{ a : 'a t12 };;
-[%%expect{|
-type 'a t12 = #{ a : 'a t12; }
-|}];;
-let f (a : int t12 array) = a.(0);;
-[%%expect{|
-val f : int t12 array -> int t12 = <fun>
-|}];;
-
-(* should work *)
-type t14;;
-type t15 = #{ a : t14 };;
-[%%expect{|
-type t14
-type t15 = #{ a : t14; }
-|}];;
-
-(* should fail because the compiler knows that t is actually float and
-   optimizes the record's representation *)
-module S : sig
-  type t
-  type u = { f1 : t; f2 : t }
-end = struct
-  type t = #{ a : float }
-  type u = { f1 : t; f2 : t }
-end;;
-[%%expect{|
-Lines 4-7, characters 6-3:
-4 | ......struct
-5 |   type t = #{ a : float }
-6 |   type u = { f1 : t; f2 : t }
-7 | end..
-Error: Signature mismatch:
-       Modules do not match:
-         sig type t = #{ a : float; } type u = { f1 : t; f2 : t; } end
-       is not included in
-         sig type t type u = { f1 : t; f2 : t; } end
-       Type declarations do not match:
-         type u = { f1 : t; f2 : t; }
-       is not included in
-         type u = { f1 : t; f2 : t; }
-       Their internal representations differ:
-       the first declaration uses unboxed float representation.
-|}];;
-
-(* implementing [@@immediate] with unboxed records: this works because the
-   representation of [t] is [int]
- *)
-module T : sig
-  type t [@@immediate]
-end = struct
-  type t = #{ i : int }
-end;;
-[%%expect{|
-module T : sig type t : immediate end
-|}];;
-
-
-(* MPR#7682 *)
-type f = #{field: 'a. 'a list} ;;
-let g = Array.make 10 #{ field=[] };;
-let h = g.(5);;
-[%%expect{|
-type f = #{ field : 'a. 'a list; }
-val g : f array =
-  [|#{field = []}; #{field = []}; #{field = []}; #{field = []};
-    #{field = []}; #{field = []}; #{field = []}; #{field = []};
-    #{field = []}; #{field = []}|]
-val h : f = #{field = []}
-|}];;
diff --git a/testsuite/tests/typing-layouts-unboxed-records/basics_from_unboxed_tuples_tests.ml b/testsuite/tests/typing-layouts-unboxed-records/basics_from_unboxed_tuples_tests.ml
deleted file mode 100644
index 1152e2d3528..00000000000
--- a/testsuite/tests/typing-layouts-unboxed-records/basics_from_unboxed_tuples_tests.ml
+++ /dev/null
@@ -1,1011 +0,0 @@
-(* TEST
- flambda2;
- include stdlib_upstream_compatible;
- flags = "-extension layouts_beta";
- {
-   expect;
- }
-*)
-
-(* These tests are adapted from the tuple tests in
-   [testsuite/tests/typing-layouts-products/basics.ml].
-
-   CR layouts v7.2: once unboxed records are in stable, fold this test back into
-   the original or move it to [typing-layouts-products]. *)
-
-open Stdlib_upstream_compatible
-
-(**********************************************************)
-(* Test 1: Basic unboxed product layouts and record types. *)
-
-type t2 = #{ s : string; f : float#; i : int }
-[%%expect{|
-type t2 = #{ s : string; f : float#; i : int; }
-|}]
-
-(* You can put unboxed and normal products inside unboxed products *)
-type t4_inner2 = #{ b : bool; i : int }
-type t4_inner = #{ i : int; t4_inner2 : t4_inner2; co : char option }
-type t4 = #{ s : string; t4_inner : t4_inner }
-[%%expect{|
-type t4_inner2 = #{ b : bool; i : int; }
-type t4_inner = #{ i : int; t4_inner2 : t4_inner2; co : char option; }
-type t4 = #{ s : string; t4_inner : t4_inner; }
-|}]
-
-(* But you can't put unboxed products into tuples (yet) *)
-type t_nope_inner = #{ s : string; b : bool }
-type t_nope = string * t_nope_inner
-[%%expect{|
-type t_nope_inner = #{ s : string; b : bool; }
-Line 2, characters 23-35:
-2 | type t_nope = string * t_nope_inner
-                           ^^^^^^^^^^^^
-Error: Tuple element types must have layout value.
-       The layout of "t_nope_inner" is value & value
-         because of the definition of t_nope_inner at line 1, characters 0-45.
-       But the layout of "t_nope_inner" must be a sublayout of value
-         because it's the type of a tuple element.
-|}]
-
-(********************************************)
-(* Test 2: Simple kind annotations on types *)
-
-type t1 : float64 & value = #{ f : float#; b : bool }
-type t2 : value & (float64 & value) = #{ so : string option ; t1 : t1 }
-[%%expect{|
-type t1 = #{ f : float#; b : bool; }
-type t2 = #{ so : string option; t1 : t1; }
-|}]
-
-type t2_wrong : value & float64 & value = #{ so : string option; t1 : t1 }
-[%%expect{|
-Line 1, characters 0-74:
-1 | type t2_wrong : value & float64 & value = #{ so : string option; t1 : t1 }
-    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: The layout of type "t2_wrong" is value & (float64 & value)
-         because it is an unboxed record.
-       But the layout of type "t2_wrong" must be a sublayout of value & float64 & value
-         because of the annotation on the declaration of the type t2_wrong.
-|}]
-
-type ('a : value & bits64) t3 = 'a
-type t4_inner = #{ i : int; i64 : int64# }
-type t4 = t4_inner t3
-type t5 = t4 t3
-[%%expect{|
-type ('a : value & bits64) t3 = 'a
-type t4_inner = #{ i : int; i64 : int64#; }
-type t4 = t4_inner t3
-type t5 = t4 t3
-|}]
-
-type t4_wrong_inner = #{ i1 : int; i2 : int }
-type t4_wrong = t4_wrong_inner t3
-[%%expect{|
-type t4_wrong_inner = #{ i1 : int; i2 : int; }
-Line 2, characters 16-30:
-2 | type t4_wrong = t4_wrong_inner t3
-                    ^^^^^^^^^^^^^^
-Error: This type "t4_wrong_inner" should be an instance of type
-         "('a : value & bits64)"
-       The layout of t4_wrong_inner is value & value
-         because of the definition of t4_wrong_inner at line 1, characters 0-45.
-       But the layout of t4_wrong_inner must be a sublayout of value & bits64
-         because of the definition of t3 at line 1, characters 0-34.
-|}]
-
-(* some mutually recusive types *)
-type ('a : value & bits64) t6 = 'a t7
-and 'a t7 = { x : 'a t6 }
-[%%expect{|
-type ('a : value & bits64) t6 = 'a t7
-and ('a : value & bits64) t7 = { x : 'a t6; }
-|}]
-
-type t9_record = #{ i : int; i64 : int64# }
-type t9 = t9_record t7
-type t10 = bool t6
-[%%expect{|
-type t9_record = #{ i : int; i64 : int64#; }
-type t9 = t9_record t7
-Line 3, characters 11-15:
-3 | type t10 = bool t6
-               ^^^^
-Error: This type "bool" should be an instance of type "('a : value & bits64)"
-       The layout of bool is value
-         because it is the primitive type bool.
-       But the layout of bool must be a sublayout of value & bits64
-         because of the definition of t6 at line 1, characters 0-37.
-|}]
-
-(* CR layouts v7.2: The below has a very bad error message. *)
-type t6_wrong_inner_record = #{ i : int; i64 : int64 }
-and ('a : value & bits64) t6_wrong = 'a t7_wrong
-and 'a t7_wrong = { x : t6_wrong_inner_record t6_wrong }
-[%%expect{|
-Line 1, characters 0-54:
-1 | type t6_wrong_inner_record = #{ i : int; i64 : int64 }
-    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error:
-       The layout of t6_wrong_inner_record is any & any
-         because it is an unboxed record.
-       But the layout of t6_wrong_inner_record must be a sublayout of
-         value & bits64
-         because of the annotation on 'a in the declaration of the type
-                                      t6_wrong.
-|}]
-
-(* Just like t6/t7, but with the annotation on the other (the order doesn't
-   matter) *)
-type 'a t11 = 'a t12
-and ('a : value & bits64) t12 = { x : 'a t11 }
-[%%expect{|
-type ('a : value & bits64) t11 = 'a t12
-and ('a : value & bits64) t12 = { x : 'a t11; }
-|}]
-
-(*********************************************************************)
-(* Test 3: Unboxed records are allowed in function args and returns *)
-
-type t1_left = #{ i : int; b : bool }
-type t1_right_inner = #{ i64 : int64#; so : string option }
-type t1_right = #{ i : int; f : float#; inner : t1_right_inner }
-type t1 = t1_left -> t1_right
-[%%expect{|
-type t1_left = #{ i : int; b : bool; }
-type t1_right_inner = #{ i64 : int64#; so : string option; }
-type t1_right = #{ i : int; f : float#; inner : t1_right_inner; }
-type t1 = t1_left -> t1_right
-|}]
-
-type make_record_result = #{ f : float#; s : string }
-let f_make_an_unboxed_record (x : string) (y : float#) = #{ f = y; s = x }
-
-type inner = #{ f1 : float#; f2 : float# }
-type t = #{ s : string; inner : inner }
-let f_pull_apart_an_unboxed_record (x : t) =
-  match x with
-  | #{ s; inner = #{ f1; f2 } } ->
-    if s = "mul" then
-      Float_u.mul f1 f2
-    else
-      Float_u.add f1 f2
-[%%expect{|
-type make_record_result = #{ f : float#; s : string; }
-val f_make_an_unboxed_record : string -> float# -> make_record_result = <fun>
-type inner = #{ f1 : float#; f2 : float#; }
-type t = #{ s : string; inner : inner; }
-val f_pull_apart_an_unboxed_record :
-  t -> Stdlib_upstream_compatible.Float_u.t = <fun>
-|}]
-
-
-module type S = sig
-  type a
-  type b
-  type c
-  type d
-  type e
-  type f
-  type g
-  type h
-end
-
-module F(X : S) = struct
-  include X
-  type mix_input_inner2 = #{ d : d; e : e }
-  type mix_input_inner = #{ c : c; inner2 : mix_input_inner2 }
-  type mix_input = #{ a : a; b : b; inner : mix_input_inner; f : f }
-  type mix_output_inner2 = #{ f : f; e : e }
-  type mix_output_inner = #{ c : c; inner2 : mix_output_inner2 }
-  type mix_output = #{ b : b; inner : mix_output_inner; a : a; d : d }
-  let f_mix_up_an_unboxed_record (x : mix_input) =
-    let #{ a; b; inner = #{ c; inner2 = #{ d; e } }; f } = x in
-    #{ b = b; inner = #{ c = c; inner2 = #{ f = f; e = e } }; a = a; d = d }
-
-  type take_few_input1 = #{ a : a; b : b }
-  type take_few_input3 = #{ d : d; e : e }
-  type take_few_input5 = #{ g : g; h : h }
-  type take_few_output =
-    #{ h : h; g2 : g; x4 : f; e2 : e; d : d; x2 : c; b : b; a2 : a }
-
-  let f_take_a_few_unboxed_records (x1 : take_few_input1) x2
-        (x3 : take_few_input3) x4 (x5 : take_few_input5) =
-    let #{ a; b } = x1 in
-    let #{ d; e } = x3 in
-    let #{ g; h } = x5 in
-    #{ h = h; g2 = g; x4 = x4; e2 = e; d = d; x2 = x2; b = b; a2 = a }
-end
-[%%expect{|
-module type S =
-  sig type a type b type c type d type e type f type g type h end
-module F :
-  functor (X : S) ->
-    sig
-      type a = X.a
-      type b = X.b
-      type c = X.c
-      type d = X.d
-      type e = X.e
-      type f = X.f
-      type g = X.g
-      type h = X.h
-      type mix_input_inner2 = #{ d : d; e : e; }
-      type mix_input_inner = #{ c : c; inner2 : mix_input_inner2; }
-      type mix_input = #{ a : a; b : b; inner : mix_input_inner; f : f; }
-      type mix_output_inner2 = #{ f : f; e : e; }
-      type mix_output_inner = #{ c : c; inner2 : mix_output_inner2; }
-      type mix_output = #{ b : b; inner : mix_output_inner; a : a; d : d; }
-      val f_mix_up_an_unboxed_record : mix_input -> mix_output
-      type take_few_input1 = #{ a : a; b : b; }
-      type take_few_input3 = #{ d : d; e : e; }
-      type take_few_input5 = #{ g : g; h : h; }
-      type take_few_output = #{
-        h : h;
-        g2 : g;
-        x4 : f;
-        e2 : e;
-        d : d;
-        x2 : c;
-        b : b;
-        a2 : a;
-      }
-      val f_take_a_few_unboxed_records :
-        take_few_input1 ->
-        c -> take_few_input3 -> f -> take_few_input5 -> take_few_output
-    end
-|}]
-
-(***************************************************)
-(* Test 4: Unboxed products don't go in structures *)
-
-type poly_var_inner = #{ i : int; b : bool }
-type poly_var_type = [ `Foo of poly_var_inner ]
-[%%expect{|
-type poly_var_inner = #{ i : int; b : bool; }
-Line 2, characters 31-45:
-2 | type poly_var_type = [ `Foo of poly_var_inner ]
-                                   ^^^^^^^^^^^^^^
-Error: Polymorphic variant constructor argument types must have layout value.
-       The layout of "poly_var_inner" is value & value
-         because of the definition of poly_var_inner at line 1, characters 0-44.
-       But the layout of "poly_var_inner" must be a sublayout of value
-         because it's the type of the field of a polymorphic variant.
-|}]
-
-type poly_var_term_record = #{ i : int; i2 : int }
-let poly_var_term = `Foo #{ i = 1; i2 = 2 }
-[%%expect{|
-type poly_var_term_record = #{ i : int; i2 : int; }
-Line 2, characters 25-43:
-2 | let poly_var_term = `Foo #{ i = 1; i2 = 2 }
-                             ^^^^^^^^^^^^^^^^^^
-Error: This expression has type "poly_var_term_record"
-       but an expression was expected of type "('a : value_or_null)"
-       The layout of poly_var_term_record is value & value
-         because of the definition of poly_var_term_record at line 1, characters 0-50.
-       But the layout of poly_var_term_record must be a sublayout of value
-         because it's the type of the field of a polymorphic variant.
-|}]
-
-type record_inner = #{ b : bool; f : float# }
-type tuple_type = (int * record_inner)
-[%%expect{|
-type record_inner = #{ b : bool; f : float#; }
-Line 2, characters 25-37:
-2 | type tuple_type = (int * record_inner)
-                             ^^^^^^^^^^^^
-Error: Tuple element types must have layout value.
-       The layout of "record_inner" is value & float64
-         because of the definition of record_inner at line 1, characters 0-45.
-       But the layout of "record_inner" must be a sublayout of value
-         because it's the type of a tuple element.
-|}]
-
-type record = #{ i : int; i2 : int }
-let tuple_term = ("hi", #{ i = 1; i2 = 2 })
-[%%expect{|
-type record = #{ i : int; i2 : int; }
-Line 2, characters 24-42:
-2 | let tuple_term = ("hi", #{ i = 1; i2 = 2 })
-                            ^^^^^^^^^^^^^^^^^^
-Error: This expression has type "record" but an expression was expected of type
-         "('a : value_or_null)"
-       The layout of record is value & value
-         because of the definition of record at line 1, characters 0-36.
-       But the layout of record must be a sublayout of value
-         because it's the type of a tuple element.
-|}]
-
-type record_inner = #{ i : int; b : bool }
-type record = { x : record_inner }
-[%%expect{|
-type record_inner = #{ i : int; b : bool; }
-Line 2, characters 0-34:
-2 | type record = { x : record_inner }
-    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Type "record_inner" has layout "value & value".
-       Records may not yet contain types of this layout.
-|}]
-
-type inlined_inner = #{ i : int; b : bool }
-type inlined_record = A of { x : inlined_inner }
-[%%expect{|
-type inlined_inner = #{ i : int; b : bool; }
-Line 2, characters 22-48:
-2 | type inlined_record = A of { x : inlined_inner }
-                          ^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Type "inlined_inner" has layout "value & value".
-       Inlined records may not yet contain types of this layout.
-|}]
-
-type variant_inner = #{ i : int; b : bool }
-type variant = A of variant_inner
-[%%expect{|
-type variant_inner = #{ i : int; b : bool; }
-Line 2, characters 15-33:
-2 | type variant = A of variant_inner
-                   ^^^^^^^^^^^^^^^^^^
-Error: Type "variant_inner" has layout "value & value".
-       Variants may not yet contain types of this layout.
-|}]
-
-type sig_inner = #{ i : int; b : bool }
-module type S = sig
-  val x : sig_inner
-end
-[%%expect{|
-type sig_inner = #{ i : int; b : bool; }
-Line 3, characters 10-19:
-3 |   val x : sig_inner
-              ^^^^^^^^^
-Error: This type signature for "x" is not a value type.
-       The layout of type sig_inner is value & value
-         because of the definition of sig_inner at line 1, characters 0-39.
-       But the layout of type sig_inner must be a sublayout of value
-         because it's the type of something stored in a module structure.
-|}]
-
-type m_record = #{ i1 : int; i2 : int }
-module M = struct
-  let x = #{ i1 = 1; i2 = 2 }
-end
-[%%expect{|
-type m_record = #{ i1 : int; i2 : int; }
-Line 3, characters 6-7:
-3 |   let x = #{ i1 = 1; i2 = 2 }
-          ^
-Error: Types of top-level module bindings must have layout "value", but
-       the type of "x" has layout "value & value".
-|}]
-
-type object_inner = #{ i : int; b : bool }
-type object_type = < x : object_inner >
-[%%expect{|
-type object_inner = #{ i : int; b : bool; }
-Line 2, characters 21-37:
-2 | type object_type = < x : object_inner >
-                         ^^^^^^^^^^^^^^^^
-Error: Object field types must have layout value.
-       The layout of "object_inner" is value & value
-         because of the definition of object_inner at line 1, characters 0-42.
-       But the layout of "object_inner" must be a sublayout of value
-         because it's the type of an object field.
-|}]
-
-type object_term_record = #{ i1 : int; i2 : int }
-let object_term = object val x = #{ i1 = 1; i2 = 2 } end
-[%%expect{|
-type object_term_record = #{ i1 : int; i2 : int; }
-Line 2, characters 29-30:
-2 | let object_term = object val x = #{ i1 = 1; i2 = 2 } end
-                                 ^
-Error: Variables bound in a class must have layout value.
-       The layout of x is value & value
-         because of the definition of object_term_record at line 1, characters 0-49.
-       But the layout of x must be a sublayout of value
-         because it's the type of a class field.
-|}]
-
-type class_record = #{ i1 : int; i2 : int }
-class class_ =
-  object
-    method x = #{ i1 = 1; i2 = 2 }
-  end
-[%%expect{|
-type class_record = #{ i1 : int; i2 : int; }
-Line 4, characters 15-34:
-4 |     method x = #{ i1 = 1; i2 = 2 }
-                   ^^^^^^^^^^^^^^^^^^^
-Error: This expression has type "class_record"
-       but an expression was expected of type "('a : value)"
-       The layout of class_record is value & value
-         because of the definition of class_record at line 1, characters 0-43.
-       But the layout of class_record must be a sublayout of value
-         because it's the type of an object field.
-|}]
-
-type capture_record = #{ x : int; y : int }
-let capture_in_object utup = object
-  val f = fun () ->
-    let #{ x; y } = utup in
-    x + y
-end;;
-[%%expect{|
-type capture_record = #{ x : int; y : int; }
-Line 4, characters 20-24:
-4 |     let #{ x; y } = utup in
-                        ^^^^
-Error: This expression has type "('a : value_or_null)"
-       but an expression was expected of type "capture_record"
-       The layout of capture_record is value & value
-         because of the definition of capture_record at line 1, characters 0-43.
-       But the layout of capture_record must be a sublayout of value
-         because it's the type of a variable captured in an object.
-|}];;
-
-(****************************************************)
-(* Test 5: Methods may take/return unboxed products *)
-
-type method_input = #{ a : int; b : int }
-type method_output = #{ sum_a : int; sum_b : int }
-
-class class_with_urecord_manipulating_method =
-  object
-    method f (x : method_input) (y : method_input) =
-      let #{ a; b } = x in
-      let #{ a = c; b = d } = y in
-      #{ sum_a = a + c; sum_b = b + d }
-  end
-[%%expect{|
-type method_input = #{ a : int; b : int; }
-type method_output = #{ sum_a : int; sum_b : int; }
-class class_with_urecord_manipulating_method :
-  object method f : method_input -> method_input -> method_output end
-|}]
-
-(*******************************************)
-(* Test 6: Nested expansion in kind checks *)
-
-(* This typechecks for unboxed tuples, but fail for [@@unboxed], unboxed, and
-   boxed records, in the same way as below.
-
-   CR layouts v7.2: These should typecheck for all record forms.
-*)
-module type S_coherence_deep = sig
-  type t1 : any
-  type t2 = #{ i : int; t1 : t1 }
-end
-[%%expect{|
-Line 3, characters 24-31:
-3 |   type t2 = #{ i : int; t1 : t1 }
-                            ^^^^^^^
-Error: Unboxed record element types must have a representable layout.
-       The layout of t1 is any
-         because of the definition of t1 at line 2, characters 2-15.
-       But the layout of t1 must be representable
-         because it is the type of record field t1.
-|}]
-
-module type S_coherence_deep = sig
-  type t1 : any
-  type t2 = { t1 : t1 } [@@unboxed]
-end
-[%%expect{|
-Line 3, characters 14-21:
-3 |   type t2 = { t1 : t1 } [@@unboxed]
-                  ^^^^^^^
-Error: [@@unboxed] record element types must have a representable layout.
-       The layout of t1/2 is any
-         because of the definition of t1 at line 2, characters 2-15.
-       But the layout of t1/2 must be representable
-         because it is the type of record field t1.
-|}]
-
-(***********************************************)
-(* Test 7: modal kinds for unboxed record types *)
-
-type local_cross1 = #{ i1 : int; i2 : int }
-let f_external_urecord_mode_crosses_local_1
-  : local_ local_cross1 -> local_cross1 = fun x -> x
-[%%expect{|
-type local_cross1 = #{ i1 : int; i2 : int; }
-val f_external_urecord_mode_crosses_local_1 :
-  local_ local_cross1 -> local_cross1 = <fun>
-|}]
-
-type local_nocross1 = #{ i : int; s : string }
-let f_internal_urecord_does_not_mode_cross_local_1
-  : local_ local_nocross1 -> local_nocross1 = fun x -> x
-[%%expect{|
-type local_nocross1 = #{ i : int; s : string; }
-Line 3, characters 55-56:
-3 |   : local_ local_nocross1 -> local_nocross1 = fun x -> x
-                                                           ^
-Error: This value escapes its region.
-|}]
-
-type local_cross2_inner = #{ b : bool; i : int }
-type local_cross2 = #{ i : int; inner : local_cross2_inner }
-let f_external_urecord_mode_crosses_local_2
-  : local_ local_cross2 -> local_cross2 = fun x -> x
-[%%expect{|
-type local_cross2_inner = #{ b : bool; i : int; }
-type local_cross2 = #{ i : int; inner : local_cross2_inner; }
-val f_external_urecord_mode_crosses_local_2 :
-  local_ local_cross2 -> local_cross2 = <fun>
-|}]
-
-type local_nocross2_inner = #{ b : bool; s : string }
-type local_nocross2 = #{ i : int; inner : local_nocross2_inner }
-let f_internal_urecord_does_not_mode_cross_local_2
-  : local_ local_nocross2 -> local_nocross2 = fun x -> x
-[%%expect{|
-type local_nocross2_inner = #{ b : bool; s : string; }
-type local_nocross2 = #{ i : int; inner : local_nocross2_inner; }
-Line 4, characters 55-56:
-4 |   : local_ local_nocross2 -> local_nocross2 = fun x -> x
-                                                           ^
-Error: This value escapes its region.
-|}]
-
-type t = #{ i1 : int; i2 : int }
-type local_cross3_inner = #{ t : t; i : int }
-type local_cross3 = #{ i : int; inner : local_cross3_inner }
-let f_external_urecord_mode_crosses_local_3
-  : local_ local_cross3 -> local_cross3 = fun x -> x
-[%%expect{|
-type t = #{ i1 : int; i2 : int; }
-type local_cross3_inner = #{ t : t; i : int; }
-type local_cross3 = #{ i : int; inner : local_cross3_inner; }
-val f_external_urecord_mode_crosses_local_3 :
-  local_ local_cross3 -> local_cross3 = <fun>
-|}]
-
-type t = #{ s : string; i : int }
-type local_nocross3_inner = #{ t : t; b : bool }
-type local_nocross3 = #{ i : int; inner : local_nocross3_inner }
-let f_internal_urecord_does_not_mode_cross_local_3
-  : local_ local_nocross3 -> local_nocross3 = fun x -> x
-[%%expect{|
-type t = #{ s : string; i : int; }
-type local_nocross3_inner = #{ t : t; b : bool; }
-type local_nocross3 = #{ i : int; inner : local_nocross3_inner; }
-Line 5, characters 55-56:
-5 |   : local_ local_nocross3 -> local_nocross3 = fun x -> x
-                                                           ^
-Error: This value escapes its region.
-|}]
-
-(****************************************************)
-(* Test 8: modal kinds for product kind annotations *)
-
-(* Nothing unique to unboxed records here *)
-
-(*********************)
-(* Test 9: externals *)
-
-type t_product : value & value
-
-type ext_record_arg_record = #{ i : int; b : bool }
-external ext_record_arg : ext_record_arg_record -> int = "foo" "bar"
-[%%expect{|
-type t_product : value & value
-type ext_record_arg_record = #{ i : int; b : bool; }
-Line 4, characters 26-54:
-4 | external ext_record_arg : ext_record_arg_record -> int = "foo" "bar"
-                              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: The primitive [foo] is used in an invalid declaration.
-       The declaration contains argument/return types with the wrong layout.
-|}]
-
-type ext_record_arg_attr_record = #{ i : int; b : bool }
-external ext_record_arg_with_attr : (ext_record_arg_attr_record [@unboxed]) -> int = "foo"
-[%%expect{|
-type ext_record_arg_attr_record = #{ i : int; b : bool; }
-Line 2, characters 37-63:
-2 | external ext_record_arg_with_attr : (ext_record_arg_attr_record [@unboxed]) -> int = "foo"
-                                         ^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Don't know how to unbox this type.
-       Only "float", "int32", "int64", "nativeint", vector primitives, and
-       the corresponding unboxed types can be marked unboxed.
-|}]
-
-external ext_product_arg : t_product -> int = "foo" "bar"
-[%%expect{|
-Line 1, characters 27-43:
-1 | external ext_product_arg : t_product -> int = "foo" "bar"
-                               ^^^^^^^^^^^^^^^^
-Error: The primitive [foo] is used in an invalid declaration.
-       The declaration contains argument/return types with the wrong layout.
-|}]
-
-external ext_product_arg_with_attr : (t_product [@unboxed]) -> int = "foo"
-[%%expect{|
-Line 1, characters 38-47:
-1 | external ext_product_arg_with_attr : (t_product [@unboxed]) -> int = "foo"
-                                          ^^^^^^^^^
-Error: Don't know how to unbox this type.
-       Only "float", "int32", "int64", "nativeint", vector primitives, and
-       the corresponding unboxed types can be marked unboxed.
-|}]
-
-type t = #{ i : int; b : bool }
-external ext_record_return : int -> t = "foo" "bar"
-[%%expect{|
-type t = #{ i : int; b : bool; }
-Line 2, characters 29-37:
-2 | external ext_record_return : int -> t = "foo" "bar"
-                                 ^^^^^^^^
-Error: The primitive [foo] is used in an invalid declaration.
-       The declaration contains argument/return types with the wrong layout.
-|}]
-
-type t = #{ i : int; b : bool }
-external ext_record_return_with_attr : int -> (t [@unboxed]) = "foo"
-[%%expect{|
-type t = #{ i : int; b : bool; }
-Line 2, characters 47-48:
-2 | external ext_record_return_with_attr : int -> (t [@unboxed]) = "foo"
-                                                   ^
-Error: Don't know how to unbox this type.
-       Only "float", "int32", "int64", "nativeint", vector primitives, and
-       the corresponding unboxed types can be marked unboxed.
-|}]
-
-external ext_product_return : int -> t_product = "foo" "bar"
-[%%expect{|
-Line 1, characters 30-46:
-1 | external ext_product_return : int -> t_product = "foo" "bar"
-                                  ^^^^^^^^^^^^^^^^
-Error: The primitive [foo] is used in an invalid declaration.
-       The declaration contains argument/return types with the wrong layout.
-|}]
-
-external ext_product_return_with_attr : int -> (t_product [@unboxed]) = "foo"
-[%%expect{|
-Line 1, characters 48-57:
-1 | external ext_product_return_with_attr : int -> (t_product [@unboxed]) = "foo"
-                                                    ^^^^^^^^^
-Error: Don't know how to unbox this type.
-       Only "float", "int32", "int64", "nativeint", vector primitives, and
-       the corresponding unboxed types can be marked unboxed.
-|}]
-
-external[@layout_poly] id : ('a : any). 'a -> 'a = "%identity"
-
-type id_record = #{ x : int; y : int }
-let sum =
-  let #{ x; y } = id #{ x = 1; y = 2 } in
-  x + y
-[%%expect{|
-external id : ('a : any). 'a -> 'a = "%identity" [@@layout_poly]
-type id_record = #{ x : int; y : int; }
-val sum : int = 3
-|}]
-
-(***********************************)
-(* Test 9: not allowed in let recs *)
-
-(* An example that is allowed on tuples but not unboxed products *)
-let[@warning "-26"] e1 = let rec x = (1, y) and y = 42 in ()
-
-type letrec_record = #{ i1 : int; i2 : int }
-let[@warning "-26"] e2 = let rec x = #{ i1 = 1; i2 = y } and y = 42 in ()
-[%%expect{|
-val e1 : unit = ()
-type letrec_record = #{ i1 : int; i2 : int; }
-Line 4, characters 37-56:
-4 | let[@warning "-26"] e2 = let rec x = #{ i1 = 1; i2 = y } and y = 42 in ()
-                                         ^^^^^^^^^^^^^^^^^^^
-Error: This expression has type "letrec_record"
-       but an expression was expected of type "('a : value_or_null)"
-       The layout of letrec_record is value & value
-         because of the definition of letrec_record at line 3, characters 0-44.
-       But the layout of letrec_record must be a sublayout of value
-         because it's the type of the recursive variable x.
-|}]
-
-(* Unboxed records of kind value are also disallowed: *)
-type letrec_record = #{ i : int }
-let e2 = let rec x = #{ i = y } and y = 42 in ()
-[%%expect{|
-type letrec_record = #{ i : int; }
-Line 2, characters 21-31:
-2 | let e2 = let rec x = #{ i = y } and y = 42 in ()
-                         ^^^^^^^^^^
-Error: This kind of expression is not allowed as right-hand side of "let rec"
-|}]
-
-(* This example motivates having a check in [type_let], because
-   [Value_rec_check] is not set up to reject it, but we don't support even this
-   limited form of unboxed let rec (yet). *)
-type letrec_simple = #{ i1 : int; i2 : int }
-let _ = let rec _x = #{ i1 = 3; i2 = 10 } and _y = 42 in 42
-[%%expect{|
-type letrec_simple = #{ i1 : int; i2 : int; }
-Line 2, characters 21-41:
-2 | let _ = let rec _x = #{ i1 = 3; i2 = 10 } and _y = 42 in 42
-                         ^^^^^^^^^^^^^^^^^^^^
-Error: This expression has type "letrec_simple"
-       but an expression was expected of type "('a : value_or_null)"
-       The layout of letrec_simple is value & value
-         because of the definition of letrec_simple at line 1, characters 0-44.
-       But the layout of letrec_simple must be a sublayout of value
-         because it's the type of the recursive variable _x.
-|}]
-
-(**********************************************************)
-(* Test 10: unboxed products not allowed in [@@unboxed] declarations (yet) *)
-
-type unboxed_record = #{ i1 : int; i2 : int }
-type t = A of unboxed_record [@@unboxed]
-[%%expect{|
-type unboxed_record = #{ i1 : int; i2 : int; }
-Line 2, characters 9-28:
-2 | type t = A of unboxed_record [@@unboxed]
-             ^^^^^^^^^^^^^^^^^^^
-Error: Type "unboxed_record" has layout "value & value".
-       Unboxed variants may not yet contain types of this layout.
-|}]
-
-type ('a : value & value) t = A of { x : 'a } [@@unboxed]
-[%%expect{|
-Line 1, characters 37-43:
-1 | type ('a : value & value) t = A of { x : 'a } [@@unboxed]
-                                         ^^^^^^
-Error: Type "'a" has layout "value & value".
-       [@@unboxed] inlined records may not yet contain types of this layout.
-|}]
-
-type unboxed_inline_record = #{ i1 : int; i2 : int }
-type t = A of { x : unboxed_inline_record } [@@unboxed]
-[%%expect{|
-type unboxed_inline_record = #{ i1 : int; i2 : int; }
-Line 2, characters 16-41:
-2 | type t = A of { x : unboxed_inline_record } [@@unboxed]
-                    ^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Type "unboxed_inline_record" has layout "value & value".
-       [@@unboxed] inlined records may not yet contain types of this layout.
-|}]
-
-(* Unboxed records of kind value are allowed *)
-
-type unboxed_record = #{ i : int }
-type t = A of unboxed_record [@@unboxed]
-[%%expect{|
-type unboxed_record = #{ i : int; }
-type t = A of unboxed_record [@@unboxed]
-|}]
-
-type t = A of { x : unboxed_record } [@@unboxed]
-[%%expect{|
-type t = A of { x : unboxed_record; } [@@unboxed]
-|}]
-
-
-(**************************************)
-(* Test 11: Unboxed records and arrays *)
-
-(* You can write the type of an array of unboxed records, but not create
-   one. Soon, you can do both. *)
-type ('a : value & value) t1 = 'a array
-type ('a : bits64 & (value & float64)) t2 = 'a array
-
-type t3_record = #{ i : int; b : bool }
-type t3 = t3_record array
-
-type t4_inner = #{ f : float#; bo : bool option }
-type t4_record = #{ s : string; inner : t4_inner }
-type t4 = t4_record array
-[%%expect{|
-type ('a : value & value) t1 = 'a array
-type ('a : bits64 & (value & float64)) t2 = 'a array
-type t3_record = #{ i : int; b : bool; }
-type t3 = t3_record array
-type t4_inner = #{ f : float#; bo : bool option; }
-type t4_record = #{ s : string; inner : t4_inner; }
-type t4 = t4_record array
-|}]
-
-type array_record = #{ i1 : int; i2 : int }
-let _ = [| #{ i1 = 1; i2 = 2 } |]
-[%%expect{|
-type array_record = #{ i1 : int; i2 : int; }
-- : array_record array = [|#{i1 = 1; i2 = 2}|]
-|}]
-
-type array_init_record = #{ i1 : int; i2 : int }
-let _ = Array.init 3 (fun _ -> #{ i1 = 1; i2 = 2 })
-[%%expect{|
-type array_init_record = #{ i1 : int; i2 : int; }
-Line 2, characters 31-50:
-2 | let _ = Array.init 3 (fun _ -> #{ i1 = 1; i2 = 2 })
-                                   ^^^^^^^^^^^^^^^^^^^
-Error: This expression has type "array_init_record"
-       but an expression was expected of type "('a : value)"
-       The layout of array_init_record is value & value
-         because of the definition of array_init_record at line 1, characters 0-48.
-       But the layout of array_init_record must be a sublayout of value.
-|}]
-
-(* Arrays of unboxed records of kind value *are* allowed *)
-type array_record = #{ i : int  }
-let _ = [| #{ i = 1 } |]
-[%%expect{|
-type array_record = #{ i : int; }
-- : array_record array = [|#{i = 1}|]
-|}]
-
-let _ = Array.init 3 (fun i -> #{ i })
-[%%expect{|
-- : array_record array = [|#{i = 0}; #{i = 1}; #{i = 2}|]
-|}]
-
-(***********************************************************)
-(* Test 12: Unboxed products are not allowed as class args *)
-
-type class_arg_record = #{ a : int; b : int }
-class product_instance_variable x =
-  let sum = let #{ a; b } = x in a + b in
-  object
-    method y = sum
-  end;;
-[%%expect{|
-type class_arg_record = #{ a : int; b : int; }
-Line 3, characters 28-29:
-3 |   let sum = let #{ a; b } = x in a + b in
-                                ^
-Error: This expression has type "('a : value)"
-       but an expression was expected of type "class_arg_record"
-       The layout of class_arg_record is value & value
-         because of the definition of class_arg_record at line 1, characters 0-45.
-       But the layout of class_arg_record must be a sublayout of value
-         because it's the type of a term-level argument to a class constructor.
-|}]
-
-(* But unboxed records of kind value are: *)
-type class_arg_record = #{ a : string }
-class product_instance_variable x =
-  let s = let #{ a } = x in a in
-  object
-    method y = s
-  end;;
-[%%expect{|
-type class_arg_record = #{ a : string; }
-class product_instance_variable :
-  class_arg_record -> object method y : string end
-|}]
-
-
-(*****************************************)
-(* Test 13: No lazy unboxed products yet *)
-
-type lazy_record = #{ i1 : int; i2 : int }
-let x = lazy #{ i1 = 1; i2 = 2 }
-[%%expect{|
-type lazy_record = #{ i1 : int; i2 : int; }
-Line 2, characters 13-32:
-2 | let x = lazy #{ i1 = 1; i2 = 2 }
-                 ^^^^^^^^^^^^^^^^^^^
-Error: This expression has type "lazy_record"
-       but an expression was expected of type "('a : value)"
-       The layout of lazy_record is value & value
-         because of the definition of lazy_record at line 1, characters 0-42.
-       But the layout of lazy_record must be a sublayout of value
-         because it's the type of a lazy expression.
-|}]
-
-type lazy_t_record = #{ i1 : int; i2 : int }
-type t = lazy_t_record lazy_t
-[%%expect{|
-type lazy_t_record = #{ i1 : int; i2 : int; }
-Line 2, characters 9-22:
-2 | type t = lazy_t_record lazy_t
-             ^^^^^^^^^^^^^
-Error: This type "lazy_t_record" should be an instance of type "('a : value)"
-       The layout of lazy_t_record is value & value
-         because of the definition of lazy_t_record at line 1, characters 0-44.
-       But the layout of lazy_t_record must be a sublayout of value
-         because the type argument of lazy_t has layout value.
-|}]
-
-(* Again, unboxed records of kind value can be: *)
-
-type t = #{ i : int }
-let x = lazy #{ i = 1 }
-[%%expect{|
-type t = #{ i : int; }
-val x : t lazy_t = <lazy>
-|}]
-
-type t2 = t lazy_t
-[%%expect{|
-type t2 = t lazy_t
-|}]
-
-(*********************************************)
-(* Test 14: Unboxed records can't be coerced *)
-
-type t = private int
-
-type coerce_record = #{ t1 : t; t2 : t }
-type coerce_int_record = #{ i1 : int; i2 : int }
-let f (x : coerce_record) =
-  let #{ i1 = a; i2 = b } = (x :> coerce_int_record) in a + b
-[%%expect{|
-type t = private int
-type coerce_record = #{ t1 : t; t2 : t; }
-type coerce_int_record = #{ i1 : int; i2 : int; }
-Line 6, characters 28-52:
-6 |   let #{ i1 = a; i2 = b } = (x :> coerce_int_record) in a + b
-                                ^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Type "coerce_record" is not a subtype of "coerce_int_record"
-|}]
-
-(************************************************)
-(* Test 15: Not allowed as an optional argument *)
-
-type optional_record = #{ i1 : int; i2 : int }
-let f_optional_urecord ?(x = #{ i1 = 1; i2 = 2 }) () = x
-[%%expect{|
-type optional_record = #{ i1 : int; i2 : int; }
-Line 2, characters 29-48:
-2 | let f_optional_urecord ?(x = #{ i1 = 1; i2 = 2 }) () = x
-                                 ^^^^^^^^^^^^^^^^^^^
-Error: This expression has type "optional_record"
-       but an expression was expected of type "('a : value)"
-       The layout of optional_record is value & value
-         because of the definition of optional_record at line 1, characters 0-46.
-       But the layout of optional_record must be a sublayout of value
-         because the type argument of option has layout value.
-|}]
-
-(******************************)
-(* Test 16: Decomposing [any] *)
-
-type ('a : value) u = U of 'a [@@unboxed]
-type ('a : value) t = #{ u1 : 'a u; u2 : 'a u }
-
-type ('a : any mod global) needs_any_mod_global
-
-type should_work = int t needs_any_mod_global
-[%%expect{|
-type 'a u = U of 'a [@@unboxed]
-type 'a t = #{ u1 : 'a u; u2 : 'a u; }
-type ('a : any mod global) needs_any_mod_global
-type should_work = int t needs_any_mod_global
-|}]
-
-type should_fail = string t needs_any_mod_global
-[%%expect{|
-Line 1, characters 19-27:
-1 | type should_fail = string t needs_any_mod_global
-                       ^^^^^^^^
-Error: This type "string t" should be an instance of type "('a : any mod global)"
-       The kind of string t is value & value
-         because of the definition of t at line 2, characters 0-47.
-       But the kind of string t must be a subkind of any mod global
-         because of the definition of needs_any_mod_global at line 4, characters 0-47.
-|}]
-
-type ('a : any mod external_) t
-
-type s_record = #{ i1 : int; s : string; i2 : int }
-type s = s_record t
-[%%expect{|
-type ('a : any mod external_) t
-type s_record = #{ i1 : int; s : string; i2 : int; }
-Line 4, characters 9-17:
-4 | type s = s_record t
-             ^^^^^^^^
-Error: This type "s_record" should be an instance of type
-         "('a : any mod external_)"
-       The kind of s_record is
-         immutable_data & immutable_data & immutable_data
-         because of the definition of s_record at line 3, characters 0-51.
-       But the kind of s_record must be a subkind of any mod external_
-         because of the definition of t at line 1, characters 0-31.
-|}]
-(* CR layouts v7.1: Both the above have very bad error messages. *)
diff --git a/testsuite/tests/typing-layouts-unboxed-records/disabled.ml b/testsuite/tests/typing-layouts-unboxed-records/disabled.ml
deleted file mode 100644
index 61ba712ee89..00000000000
--- a/testsuite/tests/typing-layouts-unboxed-records/disabled.ml
+++ /dev/null
@@ -1,39 +0,0 @@
-(* TEST
- expect;
-*)
-
-(* Types *)
-type t = #{ a : int }
-[%%expect{|
-Line 1, characters 0-21:
-1 | type t = #{ a : int }
-    ^^^^^^^^^^^^^^^^^^^^^
-Error: This construct requires the beta version of the extension "layouts", which is disabled and cannot be used
-|}]
-
-(* Construction *)
-let _ = #{ u = () }
-[%%expect{|
-Line 1, characters 8-19:
-1 | let _ = #{ u = () }
-            ^^^^^^^^^^^
-Error: This construct requires the beta version of the extension "layouts", which is disabled and cannot be used
-|}]
-
-(* Field *)
-let get r = r.#x
-[%%expect{|
-Line 1, characters 12-16:
-1 | let get r = r.#x
-                ^^^^
-Error: This construct requires the beta version of the extension "layouts", which is disabled and cannot be used
-|}]
-
-(* Patterns *)
-let #{ u = () } = ()
-[%%expect{|
-Line 1, characters 4-15:
-1 | let #{ u = () } = ()
-        ^^^^^^^^^^^
-Error: This construct requires the beta version of the extension "layouts", which is disabled and cannot be used
-|}]
diff --git a/testsuite/tests/typing-layouts-unboxed-records/exhaustiveness.ml b/testsuite/tests/typing-layouts-unboxed-records/exhaustiveness.ml
deleted file mode 100644
index 55307a90abf..00000000000
--- a/testsuite/tests/typing-layouts-unboxed-records/exhaustiveness.ml
+++ /dev/null
@@ -1,38 +0,0 @@
-(* TEST
-   flags = "-w +8 -extension layouts_beta";
-   expect;
-*)
-
-(* This is a regression test. The example below used to give an exhaustiveness
-   warning because we forgot a case in [Parmatch.simple_match]. *)
-
-type t = A | B
-type r = #{ x : t; y : t }
-
-let f t t' =
-  match #{ x = t; y = t' } with
-  | #{ x = A; y = _ } -> true
-  | #{ x = B; y = _ } -> false
-[%%expect{|
-type t = A | B
-type r = #{ x : t; y : t; }
-val f : t -> t -> bool = <fun>
-|}]
-
-(* This is a regression test. The example below used to give
-   #{y=A; _ } as a counterexample instead of #{y=A; x=B}. *)
-let g t t' =
-  match #{ x = t; y = t' } with
-  | #{ x = A; _ } -> true
-  | #{ y = B; _ } -> false
-[%%expect{|
-Lines 2-4, characters 2-26:
-2 | ..match #{ x = t; y = t' } with
-3 |   | #{ x = A; _ } -> true
-4 |   | #{ y = B; _ } -> false
-Warning 8 [partial-match]: this pattern-matching is not exhaustive.
-Here is an example of a case that is not matched:
-#{y=A; x=B}
-
-val g : t -> t -> bool = <fun>
-|}]
diff --git a/testsuite/tests/typing-layouts-unboxed-records/modality.ml b/testsuite/tests/typing-layouts-unboxed-records/modality.ml
deleted file mode 100644
index c4d6e3bf8ca..00000000000
--- a/testsuite/tests/typing-layouts-unboxed-records/modality.ml
+++ /dev/null
@@ -1,107 +0,0 @@
-(* TEST
- flags = "-extension layouts_beta";
- expect;
-*)
-
-(* This test is adapted from
-   [testsuite/tests/typing-local/local.ml].
-
-   CR layouts v7.2: once unboxed records are in stable, fold this test back into
-   the original or move it to [typing-layouts-products]. *)
-type 'a gbl = #{ global_ gbl : 'a }
-[%%expect{|
-type 'a gbl = #{ global_ gbl : 'a; }
-|}]
-
-let foo (local_ x) = x.#gbl
-[%%expect{|
-val foo : local_ 'a gbl -> 'a = <fun>
-|}]
-let foo y =
-  let x = local_ #{ gbl = y } in
-  x.#gbl
-[%%expect{|
-val foo : 'a -> 'a = <fun>
-|}]
-let foo (local_ #{ gbl }) = gbl
-[%%expect{|
-val foo : local_ 'a gbl -> 'a = <fun>
-|}]
-let foo y =
-  let #{ gbl } = local_ #{ gbl = y } in
-  gbl
-[%%expect{|
-val foo : 'a -> 'a = <fun>
-|}]
-let foo (local_ gbl) =
-  let _ = #{ gbl } in
-  ()
-[%%expect{|
-Line 2, characters 13-16:
-2 |   let _ = #{ gbl } in
-                 ^^^
-Error: This value escapes its region.
-|}]
-let foo () =
-  let gbl = local_ ref 5 in
-  let _ = #{ gbl } in
-  ()
-[%%expect{|
-Line 3, characters 13-16:
-3 |   let _ = #{ gbl } in
-                 ^^^
-Error: This value escapes its region.
-|}]
-
-(* Global fields are preserved in module inclusion *)
-module M : sig
-  type t = #{ global_ foo : string }
-end = struct
-  type t = #{ foo : string }
-end
-[%%expect{|
-Lines 3-5, characters 6-3:
-3 | ......struct
-4 |   type t = #{ foo : string }
-5 | end
-Error: Signature mismatch:
-       Modules do not match:
-         sig type t = #{ foo : string; } end
-       is not included in
-         sig type t = #{ global_ foo : string; } end
-       Type declarations do not match:
-         type t = #{ foo : string; }
-       is not included in
-         type t = #{ global_ foo : string; }
-       Fields do not match:
-         "foo : string;"
-       is not the same as:
-         "global_ foo : string;"
-       The second is global_ and the first is not.
-|}]
-
-module M : sig
-  type t = #{ foo : string }
-end = struct
-  type t = #{ global_ foo : string }
-end
-[%%expect{|
-Lines 3-5, characters 6-3:
-3 | ......struct
-4 |   type t = #{ global_ foo : string }
-5 | end
-Error: Signature mismatch:
-       Modules do not match:
-         sig type t = #{ global_ foo : string; } end
-       is not included in
-         sig type t = #{ foo : string; } end
-       Type declarations do not match:
-         type t = #{ global_ foo : string; }
-       is not included in
-         type t = #{ foo : string; }
-       Fields do not match:
-         "global_ foo : string;"
-       is not the same as:
-         "foo : string;"
-       The first is global_ and the second is not.
-|}]
diff --git a/testsuite/tests/typing-layouts-unboxed-records/parsing_inline_unboxed_record.compilers.reference b/testsuite/tests/typing-layouts-unboxed-records/parsing_inline_unboxed_record.compilers.reference
deleted file mode 100644
index 9c0cd4c1811..00000000000
--- a/testsuite/tests/typing-layouts-unboxed-records/parsing_inline_unboxed_record.compilers.reference
+++ /dev/null
@@ -1,4 +0,0 @@
-File "parsing_inline_unboxed_record.ml", line 11, characters 22-24:
-11 | type variant = Foo of #{ x : string }
-                           ^^
-Error: Syntax error
diff --git a/testsuite/tests/typing-layouts-unboxed-records/parsing_module_dot_unboxed_record.compilers.reference b/testsuite/tests/typing-layouts-unboxed-records/parsing_module_dot_unboxed_record.compilers.reference
deleted file mode 100644
index 11f6958ebe9..00000000000
--- a/testsuite/tests/typing-layouts-unboxed-records/parsing_module_dot_unboxed_record.compilers.reference
+++ /dev/null
@@ -1,4 +0,0 @@
-File "parsing_module_dot_unboxed_record.ml", line 15, characters 11-12:
-15 | let t = M.#{ i = 1 }
-                ^
-Error: Syntax error
diff --git a/testsuite/tests/typing-layouts-unboxed-records/recursive.ml b/testsuite/tests/typing-layouts-unboxed-records/recursive.ml
deleted file mode 100644
index a9e00527391..00000000000
--- a/testsuite/tests/typing-layouts-unboxed-records/recursive.ml
+++ /dev/null
@@ -1,197 +0,0 @@
-(* TEST
- flambda2;
- include stdlib_upstream_compatible;
- flags = "-extension layouts_beta";
- {
-   expect;
- }
-*)
-
-(* CR layouts v7.2: figure out the story for recursive unboxed products.
-   Consider that the following is allowed upstream:
-      type t = { t : t } [@@unboxed]
-   We should also give good errors for infinite-size unboxed records (see the
-   test at the bottom of this file with a depth-100 kind).
-*)
-
-(************************************)
-(* Basic recursive unboxed products *)
-
-type t : value = #{ t : t }
-[%%expect{|
-type t = #{ t : t; }
-|}]
-
-type t : float64 = #{ t : t }
-[%%expect{|
-type t = #{ t : t; }
-|}]
-
-
-type t : value = #{ t : t }
-[%%expect{|
-type t = #{ t : t; }
-|}]
-
-(* CR layouts v7.2: Once we support unboxed records with elements of kind [any],
-   and detect bad recursive unboxed records with an occurs check, this error
-   should improve.
-*)
-type bad = #{ bad : bad ; i : int}
-[%%expect{|
-Line 1, characters 0-34:
-1 | type bad = #{ bad : bad ; i : int}
-    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error:
-       The layout of bad is any & any
-         because it is an unboxed record.
-       But the layout of bad must be representable
-         because it is the type of record field bad.
-|}]
-
-type bad = #{ bad : bad }
-[%%expect{|
-Line 1, characters 0-25:
-1 | type bad = #{ bad : bad }
-    ^^^^^^^^^^^^^^^^^^^^^^^^^
-Error:
-       The layout of bad is any
-         because a dummy kind of any is used to check mutually recursive datatypes.
-                 Please notify the Jane Street compilers group if you see this output.
-       But the layout of bad must be representable
-         because it is the type of record field bad.
-|}]
-
-type a_bad = #{ b_bad : b_bad }
-and b_bad = #{ a_bad : a_bad }
-[%%expect{|
-Line 1, characters 0-31:
-1 | type a_bad = #{ b_bad : b_bad }
-    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error:
-       The layout of a_bad is any
-         because a dummy kind of any is used to check mutually recursive datatypes.
-                 Please notify the Jane Street compilers group if you see this output.
-       But the layout of a_bad must be representable
-         because it is the type of record field a_bad.
-|}]
-
-type bad : any = #{ bad : bad }
-[%%expect{|
-Line 1, characters 0-31:
-1 | type bad : any = #{ bad : bad }
-    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error:
-       The layout of bad is any
-         because of the annotation on the declaration of the type bad.
-       But the layout of bad must be representable
-         because it is the type of record field bad.
-|}]
-
-type 'a id = #{ a : 'a }
-type bad = bad id
-[%%expect{|
-type 'a id = #{ a : 'a; }
-Line 2, characters 0-17:
-2 | type bad = bad id
-    ^^^^^^^^^^^^^^^^^
-Error: The type abbreviation "bad" is cyclic:
-         "bad" = "bad id",
-         "bad id" contains "bad"
-|}]
-
-
-type 'a bad = #{ bad : 'a bad ; u : 'a}
-[%%expect{|
-Line 1, characters 0-39:
-1 | type 'a bad = #{ bad : 'a bad ; u : 'a}
-    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error:
-       The layout of 'a bad is any & any
-         because it is an unboxed record.
-       But the layout of 'a bad must be representable
-         because it is the type of record field bad.
-|}]
-
-type 'a bad = { bad : 'a bad ; u : 'a}
-[%%expect{|
-type 'a bad = { bad : 'a bad; u : 'a; }
-|}]
-
-(****************************)
-(* A particularly bad error *)
-
-type bad : float64 = #{ bad : bad ; i : int}
-[%%expect{|
-Line 1, characters 0-44:
-1 | type bad : float64 = #{ bad : bad ; i : int}
-    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: The layout of type "bad" is ((((((((((((((((((((((((((((((((((((
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (
-                                                                    (float64 & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value) & value
-         because it is an unboxed record.
-       But the layout of type "bad" must be a sublayout of float64
-         because of the annotation on the declaration of the type bad.
-|}]
diff --git a/testsuite/tests/typing-layouts-unboxed-records/unboxed_records_disabled.compilers.reference b/testsuite/tests/typing-layouts-unboxed-records/unboxed_records_disabled.compilers.reference
deleted file mode 100644
index 75e6f993887..00000000000
--- a/testsuite/tests/typing-layouts-unboxed-records/unboxed_records_disabled.compilers.reference
+++ /dev/null
@@ -1,4 +0,0 @@
-File "unboxed_records.ml", line 54, characters 0-34:
-54 | type ints = #{ x : int ; y : int }
-     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This construct requires the beta version of the extension "layouts", which is disabled and cannot be used
diff --git a/testsuite/tests/typing-layouts/allow_any.ml b/testsuite/tests/typing-layouts/allow_any.ml
new file mode 100644
index 00000000000..3e8eb85199b
--- /dev/null
+++ b/testsuite/tests/typing-layouts/allow_any.ml
@@ -0,0 +1,190 @@
+(* TEST
+ flags = "-extension layouts_beta";
+ expect;
+*)
+
+(* Baseline: if the jkind doesn't match, we should get an error. *)
+module Mismatched_no_attrs : sig
+  type t : float64
+end = struct
+  type t = string
+end
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = string
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = string end
+       is not included in
+         sig type t : float64 end
+       Type declarations do not match:
+         type t = string
+       is not included in
+         type t : float64
+       The layout of the first is value
+         because it is the primitive type string.
+       But the layout of the first must be a sublayout of float64
+         because of the definition of t at line 2, characters 2-18.
+|}]
+
+(* On the other hand, if we set the correct attributes on both the impl and the intf, we
+   shouldn't get an error (though, obviously, this is completely unsound!) *)
+module Mismatched_with_both_attrs : sig
+  type t : float64
+  [@@unsafe_allow_any_kind_in_impl "I love segfaults"]
+end = struct
+  type t = string
+  [@@unsafe_allow_any_kind_in_intf "I love segfaults"]
+end
+[%%expect{|
+module Mismatched_with_both_attrs : sig type t : float64 end
+|}]
+
+(* If we set the attributes but *don't* get a kind mismatch, we ought to be fine *)
+module Matching : sig
+  type t : value
+  [@@unsafe_allow_any_kind_in_impl "I love segfaults"]
+end = struct
+  type t = string
+  [@@unsafe_allow_any_kind_in_intf "I love segfaults"]
+end
+[%%expect{|
+Lines 2-3, characters 2-54:
+2 | ..type t : value
+3 |   [@@unsafe_allow_any_kind_in_impl "I love segfaults"]
+Warning 212 [unnecessary-allow-any-kind]: [@@allow_any_kind_in_intf] and [@@allow_any_kind_in_impl] set on a
+type, but the kind matches. The attributes can be removed.
+
+module Matching : sig type t end
+|}]
+
+(* If the attr is only on the signature we should get an error *)
+module Mismatched_with_attr_on_intf : sig
+  type t : float64
+  [@@unsafe_allow_any_kind_in_impl "I love segfaults"]
+end = struct
+  type t = string
+end
+[%%expect{|
+Lines 4-6, characters 6-3:
+4 | ......struct
+5 |   type t = string
+6 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = string end
+       is not included in
+         sig type t : float64 end
+       Type declarations do not match:
+         type t = string
+       is not included in
+         type t : float64
+       The layout of the first is value
+         because it is the primitive type string.
+       But the layout of the first must be a sublayout of float64
+         because of the definition of t at lines 2-3, characters 2-54.
+|}]
+
+(* If the attr is only on the struct we should get an error *)
+module Mismatched_with_attr_on_impl : sig
+  type t : float64
+end = struct
+  type t = string
+  [@@unsafe_allow_any_kind_in_intf "I love segfaults"]
+end
+[%%expect{|
+Lines 3-6, characters 6-3:
+3 | ......struct
+4 |   type t = string
+5 |   [@@unsafe_allow_any_kind_in_intf "I love segfaults"]
+6 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = string end
+       is not included in
+         sig type t : float64 end
+       Type declarations do not match:
+         type t = string
+       is not included in
+         type t : float64
+       The layout of the first is value
+         because it is the primitive type string.
+       But the layout of the first must be a sublayout of float64
+         because of the definition of t at line 2, characters 2-18.
+|}]
+
+(* Some more complex stuff with functors *)
+
+module type S1 = sig
+  type t : value
+end
+
+module type S2 = sig
+  type t : float64
+  [@@unsafe_allow_any_kind_in_impl]
+end
+
+module type S1 = sig
+  type t : value
+  [@@unsafe_allow_any_kind_in_intf]
+end
+
+module F1 (X : S1) : S2 = X
+
+[%%expect{|
+module type S1 = sig type t end
+module type S2 = sig type t : float64 end
+module type S1 = sig type t end
+module F1 : functor (X : S1) -> S2
+|}]
+
+module F2 (X : S2) : S1 = X
+[%%expect{|
+Line 1, characters 26-27:
+1 | module F2 (X : S2) : S1 = X
+                              ^
+Error: Signature mismatch:
+       Modules do not match: sig type t = X.t end is not included in S1
+       Type declarations do not match: type t = X.t is not included in type t
+       The layout of the first is float64
+         because of the definition of t at lines 6-7, characters 2-35.
+       But the layout of the first must be a sublayout of value
+         because of the definition of t at lines 11-12, characters 2-35.
+|}]
+
+(* Non-abstract types can be annotated with [@@unsafe_allow_any_kind_in_intf] too, and get
+   checked against signatures during inclusion. *)
+
+module M1 : sig
+  type t : value = string [@@unsafe_allow_any_kind_in_intf]
+end = struct
+  type t = string
+end
+
+module M2 : S2 = M1
+
+[%%expect{|
+module M1 : sig type t = string end
+module M2 : S2
+|}]
+
+module type S3 = sig
+  type t : value
+  [@@unsafe_allow_any_kind_in_impl]
+end
+
+module M3 : S3 = M1
+(* CR aspsmith: This is somewhat unfortunate, if S3 and M1 are defined far away, but it's
+   unclear how to squash the warning *)
+[%%expect{|
+module type S3 = sig type t end
+Lines 2-3, characters 2-35:
+2 | ..type t : value
+3 |   [@@unsafe_allow_any_kind_in_impl]
+Warning 212 [unnecessary-allow-any-kind]: [@@allow_any_kind_in_intf] and [@@allow_any_kind_in_impl] set on a
+type, but the kind matches. The attributes can be removed.
+
+module M3 : S3
+|}]
diff --git a/testsuite/tests/typing-layouts/jkinds.ml b/testsuite/tests/typing-layouts/jkinds.ml
index eec92625b42..119aab32b9b 100644
--- a/testsuite/tests/typing-layouts/jkinds.ml
+++ b/testsuite/tests/typing-layouts/jkinds.ml
@@ -279,8 +279,8 @@ Error: Layout void is more experimental than allowed by the enabled layouts exte
 |}]
 
 type a : immediate
-type b : value mod global unique many uncontended portable external_ = a
-type c : value mod global unique many uncontended portable external_
+type b : value mod global unique many uncontended portable unyielding external_ = a
+type c : value mod global unique many uncontended portable unyielding external_
 type d : immediate = c
 [%%expect{|
 type a : immediate
@@ -290,8 +290,8 @@ type d = c
 |}]
 
 type a : immediate64
-type b : value mod global unique many uncontended portable external64 = a
-type c : value mod global unique many uncontended portable external64
+type b : value mod global unique many uncontended portable unyielding external64 = a
+type c : value mod global unique many uncontended portable unyielding external64
 type d : immediate64 = c
 [%%expect{|
 type a : immediate64
diff --git a/testsuite/tests/typing-local/local.ml b/testsuite/tests/typing-local/local.ml
index f9957b277e8..bdbc9f5978f 100644
--- a/testsuite/tests/typing-local/local.ml
+++ b/testsuite/tests/typing-local/local.ml
@@ -1202,6 +1202,53 @@ Line 3, characters 12-15:
 Error: This value escapes its region.
 |}]
 
+(* Unboxed records version of the same test *)
+
+type 'a gbl = #{ global_ gbl : 'a }
+[%%expect{|
+type 'a gbl = #{ global_ gbl : 'a; }
+|}]
+
+let foo (local_ x) = x.#gbl
+[%%expect{|
+val foo : local_ 'a gbl -> 'a = <fun>
+|}]
+let foo y =
+  let x = local_ #{ gbl = y } in
+  x.#gbl
+[%%expect{|
+val foo : 'a -> 'a = <fun>
+|}]
+let foo (local_ #{ gbl }) = gbl
+[%%expect{|
+val foo : local_ 'a gbl -> 'a = <fun>
+|}]
+let foo y =
+  let #{ gbl } = local_ #{ gbl = y } in
+  gbl
+[%%expect{|
+val foo : 'a -> 'a = <fun>
+|}]
+let foo (local_ gbl) =
+  let _ = #{ gbl } in
+  ()
+[%%expect{|
+Line 2, characters 13-16:
+2 |   let _ = #{ gbl } in
+                 ^^^
+Error: This value escapes its region.
+|}]
+let foo () =
+  let gbl = local_ ref 5 in
+  let _ = #{ gbl } in
+  ()
+[%%expect{|
+Line 3, characters 13-16:
+3 |   let _ = #{ gbl } in
+                 ^^^
+Error: This value escapes its region.
+|}]
+
 (* Global fields are preserved in module inclusion *)
 module M : sig
   type t = { global_ foo : string }
@@ -1255,6 +1302,60 @@ Error: Signature mismatch:
        The first is global_ and the second is not.
 |}]
 
+(* Unboxed records version of the same test *)
+
+module M : sig
+  type t = #{ global_ foo : string }
+end = struct
+  type t = #{ foo : string }
+end
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = #{ foo : string }
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = #{ foo : string; } end
+       is not included in
+         sig type t = #{ global_ foo : string; } end
+       Type declarations do not match:
+         type t = #{ foo : string; }
+       is not included in
+         type t = #{ global_ foo : string; }
+       Fields do not match:
+         "foo : string;"
+       is not the same as:
+         "global_ foo : string;"
+       The second is global_ and the first is not.
+|}]
+
+module M : sig
+  type t = #{ foo : string }
+end = struct
+  type t = #{ global_ foo : string }
+end
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = #{ global_ foo : string }
+5 | end
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = #{ global_ foo : string; } end
+       is not included in
+         sig type t = #{ foo : string; } end
+       Type declarations do not match:
+         type t = #{ global_ foo : string; }
+       is not included in
+         type t = #{ foo : string; }
+       Fields do not match:
+         "global_ foo : string;"
+       is not the same as:
+         "foo : string;"
+       The first is global_ and the second is not.
+|}]
+
 (* Special handling of tuples in matches and let bindings *)
 let escape : 'a -> unit = fun x -> ()
 
diff --git a/testsuite/tests/typing-modes/lazy.ml b/testsuite/tests/typing-modes/lazy.ml
index 1802de84380..fd834b214e5 100644
--- a/testsuite/tests/typing-modes/lazy.ml
+++ b/testsuite/tests/typing-modes/lazy.ml
@@ -43,8 +43,7 @@ let foo (x @ local) =
 val foo : local_ 'a lazy_t -> 'a = <fun>
 |}]
 
-(* one can construct portable lazy, if both the thunk and the result are
-   portable *)
+(* one can construct [portable] lazy only if the result is [portable] *)
 let foo () =
     let l = lazy (let x @ nonportable = fun x -> x in x) in
     use_portable l
@@ -55,32 +54,21 @@ Line 3, characters 17-18:
 Error: This value is "nonportable" but expected to be "portable".
 |}]
 
+(* thunk is evaluated only when [uncontended] lazy is forced, so the thunk can be
+    [nonportable] even if the lazy is [portable]. *)
 let foo (x @ nonportable) =
     let l = lazy (let _ = x in ()) in
     use_portable l
 [%%expect{|
-Line 3, characters 17-18:
-3 |     use_portable l
-                     ^
-Error: This value is "nonportable" but expected to be "portable".
-|}]
-
-let foo (x @ portable) =
-    let l = lazy (let _ = x in let y = fun () -> () in y) in
-    use_portable l
-[%%expect{|
-val foo : 'a @ portable -> unit = <fun>
+val foo : 'a -> unit = <fun>
 |}]
 
-(* inside a portable lazy, things are available as contended *)
+(* For the same reason, [portable] lazy can close over things at [uncontended]. *)
 let foo (x @ uncontended) =
-    let l @ portable = lazy ( let x' @ uncontended = x in ()) in
+    let l @ portable = lazy ( let _x @ uncontended = x in ()) in
     use_portable l
 [%%expect{|
-Line 2, characters 53-54:
-2 |     let l @ portable = lazy ( let x' @ uncontended = x in ()) in
-                                                         ^
-Error: This value is "contended" but expected to be "uncontended".
+val foo : 'a -> unit = <fun>
 |}]
 
 (* Portable lazy gives portable result *)
@@ -91,6 +79,7 @@ let foo (x @ portable) =
 val foo : 'a lazy_t @ portable -> unit = <fun>
 |}]
 
+(* Nonportable lazy gives nonportable result *)
 let foo (x @ nonportable) =
     match x with
     | lazy r -> use_portable x
diff --git a/testsuite/tests/typing-modes/yielding.ml b/testsuite/tests/typing-modes/yielding.ml
new file mode 100644
index 00000000000..e472f807124
--- /dev/null
+++ b/testsuite/tests/typing-modes/yielding.ml
@@ -0,0 +1,80 @@
+(* TEST
+ expect;
+*)
+
+(* CR dkalinichenko: allow [yielding] at toplevel? *)
+let my_effect : unit -> unit @@ yielding = print_endline "Hello, world!"
+[%%expect{|
+Line 1, characters 4-72:
+1 | let my_effect : unit -> unit @@ yielding = print_endline "Hello, world!"
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This value is "yielding" but expected to be "unyielding".
+|}]
+
+let storage = ref ""
+
+let with_effect : ((string -> unit) @ local yielding -> 'a) -> 'a =
+  fun f -> f ((:=) storage)
+
+[%%expect{|
+val storage : string ref = {contents = ""}
+val with_effect : (local_ (string -> unit) @ yielding -> 'a) -> 'a = <fun>
+|}]
+
+let () = with_effect (fun k -> k "Hello, world!")
+
+let _ = !storage
+
+[%%expect{|
+- : string = "Hello, world!"
+|}]
+
+let run_yielding : (string -> unit) @ local yielding -> unit = fun f -> f "my string"
+
+let () = with_effect (fun k -> run_yielding k)
+
+let _ = !storage
+
+[%%expect{|
+val run_yielding : local_ (string -> unit) @ yielding -> unit = <fun>
+- : string = "my string"
+|}]
+
+let run_unyielding : (string -> unit) @ local unyielding -> unit = fun f -> f "another string"
+
+let () = with_effect (fun k -> run_unyielding k)
+
+[%%expect{|
+val run_unyielding : local_ (string -> unit) -> unit = <fun>
+Line 3, characters 46-47:
+3 | let () = with_effect (fun k -> run_unyielding k)
+                                                  ^
+Error: This value is "yielding" but expected to be "unyielding".
+|}]
+
+(* CR dkalinichenko: default [local] arguments to [yielding]. *)
+
+let run_default : (string -> unit) @ local -> unit = fun f -> f "some string"
+
+let () = with_effect (fun k -> run_default k)
+
+[%%expect{|
+val run_default : local_ (string -> unit) -> unit = <fun>
+Line 3, characters 43-44:
+3 | let () = with_effect (fun k -> run_default k)
+                                               ^
+Error: This value is "yielding" but expected to be "unyielding".
+|}]
+
+(* A closure over a [yielding] value must be [yielding]. *)
+
+let () = with_effect (fun k ->
+  let closure @ local unyielding = fun () -> k () in
+  run_unyielding k)
+
+[%%expect{|
+Line 2, characters 45-46:
+2 |   let closure @ local unyielding = fun () -> k () in
+                                                 ^
+Error: The value "k" is yielding, so cannot be used inside a function that may not yield.
+|}]
diff --git a/testsuite/tests/typing-unboxed-types/test.ml b/testsuite/tests/typing-unboxed-types/test.ml
index 9825f4fdfc3..eaa02e604e6 100644
--- a/testsuite/tests/typing-unboxed-types/test.ml
+++ b/testsuite/tests/typing-unboxed-types/test.ml
@@ -34,6 +34,19 @@ Obj.repr x == Obj.repr x.f
 - : bool = true
 |}];;
 
+(* For unboxed records *)
+type t2 = #{ f : string } ;;
+[%%expect{|
+type t2 = #{ f : string; }
+|}];;
+
+let x = #{ f = "foo" } in
+Obj.repr x == Obj.repr x.#f
+;;
+[%%expect{|
+- : bool = true
+|}];;
+
 (* For inline records *)
 type t3 = B of { g : string } [@@ocaml.unboxed];;
 [%%expect{|
@@ -95,17 +108,24 @@ Error: This type cannot be unboxed because
        its constructor has more than one field.
 |}];;
 
-(* let rec must be rejected *)
+(* This test was made to error by disallowing singleton recursive unboxed types.
+   We keep it in case these are re-allowed, in which case it should error with:
+   [This kind of expression is not allowed as right-hand side of "let rec"] *)
 type t10 : value = A of t10 [@@ocaml.unboxed];;
 [%%expect{|
-type t10 = A of t10 [@@unboxed]
+Line 1, characters 0-45:
+1 | type t10 : value = A of t10 [@@ocaml.unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "t10" is recursive without boxing:
+         "t10" contains "t10"
 |}];;
 let rec x = A x;;
 [%%expect{|
-Line 1, characters 12-15:
+Line 1, characters 14-15:
 1 | let rec x = A x;;
-                ^^^
-Error: This kind of expression is not allowed as right-hand side of "let rec"
+                  ^
+Error: This expression has type "t1" but an expression was expected of type
+         "string"
 |}];;
 
 (* Representation mismatch between module and signature must be rejected *)
@@ -271,6 +291,50 @@ Error: Signature mismatch:
        the second declaration uses unboxed representation.
 |}];;
 
+module M : sig
+  type t = { a : string }
+end = struct
+  type t = #{ a : string }
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = #{ a : string }
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = #{ a : string; } end
+       is not included in
+         sig type t = { a : string; } end
+       Type declarations do not match:
+         type t = #{ a : string; }
+       is not included in
+         type t = { a : string; }
+       The first is an unboxed record, but the second is a record.
+|}];;
+
+module M : sig
+  type t = #{ a : string }
+end = struct
+  type t = { a : string }
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 |   type t = { a : string }
+5 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = { a : string; } end
+       is not included in
+         sig type t = #{ a : string; } end
+       Type declarations do not match:
+         type t = { a : string; }
+       is not included in
+         type t = #{ a : string; }
+       The first is a record, but the second is an unboxed record.
+|}]
+
 
 (* Check interference with representation of float arrays. *)
 type t11 = L of float [@@ocaml.unboxed];;
@@ -284,20 +348,62 @@ in assert (f x = L 3.14);;
 - : unit = ()
 |}];;
 
-(* Check for a potential infinite loop in the typing algorithm. *)
+type t11 = #{ f : float };;
+[%%expect{|
+type t11 = #{ f : float; }
+|}];;
+let x = Array.make 10 #{ f = 3.14 }   (* represented as a flat array *)
+and f (a : t11 array) = a.(0)    (* might wrongly assume an array of pointers *)
+in assert (f x = #{ f = 3.14});;
+[%%expect{|
+- : unit = ()
+|}];;
+
+(* Check for a potential infinite loop in the typing algorithm.
+   (This test was made to error upon disallowing singleton recursive [@@unboxed]
+   types. We keep it around in case these are re-allowed.) *)
 type 'a t12 = M of 'a t12 [@@ocaml.unboxed];;
 [%%expect{|
-type 'a t12 = M of 'a t12 [@@unboxed]
+Line 1, characters 0-43:
+1 | type 'a t12 = M of 'a t12 [@@ocaml.unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "t12" is recursive without boxing:
+         "'a t12" contains "'a t12"
+|}];;
+let f (a : int t12 array) = a.(0);;
+[%%expect{|
+Line 1, characters 15-18:
+1 | let f (a : int t12 array) = a.(0);;
+                   ^^^
+Error: Unbound type constructor "t12"
+Hint: Did you mean "t1", "t11" or "t2"?
+|}];;
+
+type 'a t12 : value = #{ a : 'a t12 };;
+[%%expect{|
+Line 1, characters 0-37:
+1 | type 'a t12 : value = #{ a : 'a t12 };;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "t12" is recursive without boxing:
+         "'a t12" contains "'a t12"
 |}];;
 let f (a : int t12 array) = a.(0);;
 [%%expect{|
-val f : int t12 array -> int t12 = <fun>
+Line 1, characters 15-18:
+1 | let f (a : int t12 array) = a.(0);;
+                   ^^^
+Error: Unbound type constructor "t12"
+Hint: Did you mean "t1", "t11" or "t2"?
 |}];;
 
 (* Check for another possible loop *)
 type t13 = A : _ t12 -> t13 [@@ocaml.unboxed];;
 [%%expect{|
-type t13 = A : 'a t12 -> t13 [@@unboxed]
+Line 1, characters 17-20:
+1 | type t13 = A : _ t12 -> t13 [@@ocaml.unboxed];;
+                     ^^^
+Error: Unbound type constructor "t12"
+Hint: Did you mean "t1", "t11", "t13" or "t2"?
 |}];;
 
 
@@ -308,6 +414,12 @@ type t15 = A of t14 [@@ocaml.unboxed];;
 type t14
 type t15 = A of t14 [@@unboxed]
 |}];;
+type t14;;
+type t15 = #{ a : t14 };;
+[%%expect{|
+type t14
+type t15 = #{ a : t14; }
+|}];;
 
 (* should fail because the compiler knows that t is actually float and
    optimizes the record's representation *)
@@ -337,6 +449,32 @@ Error: Signature mismatch:
        the first declaration uses unboxed float representation.
 |}];;
 
+module S : sig
+  type t
+  type u = { f1 : t; f2 : t }
+end = struct
+  type t = #{ a : float }
+  type u = { f1 : t; f2 : t }
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 |   type t = #{ a : float }
+6 |   type u = { f1 : t; f2 : t }
+7 | end..
+Error: Signature mismatch:
+       Modules do not match:
+         sig type t = #{ a : float; } type u = { f1 : t; f2 : t; } end
+       is not included in
+         sig type t type u = { f1 : t; f2 : t; } end
+       Type declarations do not match:
+         type u = { f1 : t; f2 : t; }
+       is not included in
+         type u = { f1 : t; f2 : t; }
+       Their internal representations differ:
+       the first declaration uses unboxed float representation.
+|}];;
+
 (* implementing [@@immediate] with [@@ocaml.unboxed]: this works because the
    representation of [t] is [int]
  *)
@@ -349,6 +487,15 @@ end;;
 module T : sig type t : immediate end
 |}];;
 
+module T : sig
+  type t [@@immediate]
+end = struct
+  type t = #{ i : int }
+end;;
+[%%expect{|
+module T : sig type t : immediate end
+|}];;
+
 (* Another corner case *)
 type 'a s
 type ('a, 'p) t = private 'a s
@@ -372,6 +519,18 @@ val g : f array =
 val h : f = {field = []}
 |}];;
 
+type f = #{field: 'a. 'a list} ;;
+let g = Array.make 10 #{ field=[] };;
+let h = g.(5);;
+[%%expect{|
+type f = #{ field : 'a. 'a list; }
+val g : f array =
+  [|#{field = []}; #{field = []}; #{field = []}; #{field = []};
+    #{field = []}; #{field = []}; #{field = []}; #{field = []};
+    #{field = []}; #{field = []}|]
+val h : f = #{field = []}
+|}];;
+
 (* Using [@@immediate] information (GPR#1469) *)
 type 'a t [@@immediate];;
 type u = U : 'a t -> u [@@unboxed];;
diff --git a/testsuite/tests/typing-unboxed/test.ml b/testsuite/tests/typing-unboxed/test.ml
index 4c5287e1ab0..ee4da937b43 100644
--- a/testsuite/tests/typing-unboxed/test.ml
+++ b/testsuite/tests/typing-unboxed/test.ml
@@ -756,7 +756,11 @@ Error: The native code version of the primitive is mandatory
 (* PR#7424 *)
 type 'a b = B of 'a b b [@@unboxed];;
 [%%expect{|
-type 'a b = B of 'a b b [@@unboxed]
+Line 1, characters 0-35:
+1 | type 'a b = B of 'a b b [@@unboxed];;
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of "b" is recursive without boxing:
+         "'a b" contains "'a b b"
 |}]
 
 
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index ae5e9146084..d0227ef029b 100644
--- a/toplevel/genprintval.ml
+++ b/toplevel/genprintval.ml
@@ -448,6 +448,10 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
                       match rep with
                       | Variant_unboxed -> true
                       | Variant_boxed _ | Variant_extensible -> false
+                      | Variant_with_null ->
+                        (* CR layouts v3.0: fix this. *)
+                        Misc.fatal_error "[Variant_with_null] not implemented\
+                          in bytecode"
                     in
                     begin
                       match cd_args with
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index 4a305f36bf6..5f7b48b98b0 100644
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -482,7 +482,7 @@ let is_exception_constructor env type_expr =
 
 let is_extension_constructor = function
   | Extension _ -> true
-  | Ordinary _ -> false
+  | Ordinary _ | Null -> false
 
 let () =
   (* This show_prim function will only show constructor types
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 8ac146ae94d..547b8f2d62c 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -2116,6 +2116,20 @@ let unbox_once env ty =
   | Tpoly (ty, _) -> Stepped ty
   | _ -> Final_result
 
+let contained_without_boxing env ty =
+  match get_desc ty with
+  | Tconstr _ ->
+    begin match unbox_once env ty with
+    | Stepped ty -> [ty]
+    | Stepped_record_unboxed_product tys -> tys
+    | Final_result | Missing _ -> []
+    end
+  | Tunboxed_tuple labeled_tys ->
+    List.map snd labeled_tys
+  | Tpoly (ty, _) -> [ty]
+  | Tvar _ | Tarrow _ | Ttuple _ | Tobject _ | Tfield _ | Tnil | Tlink _
+  | Tsubst _ | Tvariant _ | Tunivar _ | Tpackage _ -> []
+
 (* We use ty_prev to track the last type for which we found a definition,
    allowing us to return a type for which a definition was found even if
    we eventually bottom out at a missing cmi file, or otherwise. *)
diff --git a/typing/ctype.mli b/typing/ctype.mli
index 6caadd85790..a5d3460cdd8 100644
--- a/typing/ctype.mli
+++ b/typing/ctype.mli
@@ -581,6 +581,10 @@ val get_unboxed_type_approximation : Env.t -> type_expr -> type_expr
        [get_unboxed_type_representation], but doesn't indicate whether the type
        was fully expanded or not. *)
 
+val contained_without_boxing : Env.t -> type_expr -> type_expr list
+    (* Return all types that are directly contained without boxing
+      (or "without indirection" or "flatly") *)
+
 (* Given the row from a variant type, determine if it is immediate.  Currently
    just checks that all constructors have no arguments, doesn't consider
    void. *)
diff --git a/typing/datarepr.ml b/typing/datarepr.ml
index 4d4ccb6ad01..c83d8aea3d9 100644
--- a/typing/datarepr.ml
+++ b/typing/datarepr.ml
@@ -129,6 +129,12 @@ let constructor_descrs ~current_unit ty_path decl cstrs rep =
       end
     | Variant_unboxed, ([] | _ :: _) ->
       Misc.fatal_error "Multiple or 0 constructors in [@@unboxed] variant"
+    | Variant_with_null, _ ->
+      (* CR layouts v3.5: this hardcodes ['a or_null]. Fix when we allow
+         users to write their own null constructors. *)
+      (* CR layouts v3.3: generalize to [any]. *)
+      [| Constructor_uniform_value, [| |]
+       ; Constructor_uniform_value, [| Jkind.Sort.Const.value |] |]
   in
   let all_void sorts = Array.for_all Jkind.Sort.Const.(equal void) sorts in
   let num_consts = ref 0 and num_nonconsts = ref 0 in
@@ -155,7 +161,11 @@ let constructor_descrs ~current_unit ty_path decl cstrs rep =
       then const_tag, 1 + const_tag, nonconst_tag
       else nonconst_tag, const_tag, 1 + nonconst_tag
     in
-    let cstr_tag = Ordinary {src_index; runtime_tag} in
+    let cstr_tag =
+      match rep, cstr_constant with
+      | Variant_with_null, true -> Null
+      | _, _ ->  Ordinary {src_index; runtime_tag}
+    in
     let cstr_existentials, cstr_args, cstr_inlined =
       (* This is the representation of the inner record, IF there is one *)
       let record_repr = Record_inlined (cstr_tag, cstr_shape, rep) in
@@ -273,7 +283,7 @@ let find_constr ~constant tag cstrs =
       (function
         | ({cstr_tag=Ordinary {runtime_tag=tag'}; cstr_constant},_) ->
           tag' = tag && cstr_constant = constant
-        | ({cstr_tag=Extension _},_) -> false)
+        | ({cstr_tag=(Extension _ | Null)},_) -> false)
       cstrs
   with
   | Not_found -> raise Constr_not_found
diff --git a/typing/env.ml b/typing/env.ml
index ac7dba4540f..b89c70c4885 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -4419,6 +4419,7 @@ let report_lookup_error _loc env ppf = function
         | Error (Areality, _) -> "local", "might escape"
         | Error (Linearity, _) -> "once", "is many"
         | Error (Portability, _) -> "nonportable", "is portable"
+        | Error (Yielding, _) -> "yielding", "may not yield"
       in
       let s, hint =
         match context with
diff --git a/typing/includecore.ml b/typing/includecore.ml
index ba2b434ebae..a6a6a9576c4 100644
--- a/typing/includecore.ml
+++ b/typing/includecore.ml
@@ -306,6 +306,7 @@ type type_mismatch =
   | Variant_mismatch of variant_change list
   | Unboxed_representation of position * attributes
   | Extensible_representation of position
+  | With_null_representation of position
   | Jkind of Jkind.Violation.t
 
 let report_modality_sub_error first second ppf e =
@@ -634,6 +635,10 @@ let report_type_mismatch first second decl env ppf err =
       pr "Their internal representations differ:@ %s %s %s."
          (choose ord first second) decl
          "is extensible"
+  | With_null_representation ord ->
+      pr "Their internal representations differ:@ %s %s %s."
+         (choose ord first second) decl
+         "has a null constructor"
   | Jkind v ->
       Jkind.Violation.report_with_name ~name:first ppf v
 
@@ -989,7 +994,8 @@ module Variant_diffing = struct
     match err, rep1, rep2 with
     | None, Variant_unboxed, Variant_unboxed
     | None, Variant_boxed _, Variant_boxed _
-    | None, Variant_extensible, Variant_extensible -> None
+    | None, Variant_extensible, Variant_extensible
+    | None, Variant_with_null, Variant_with_null -> None
     | Some err, _, _ ->
         Some (Variant_mismatch err)
     | None, Variant_unboxed, Variant_boxed _ ->
@@ -1000,6 +1006,10 @@ module Variant_diffing = struct
       Some (Extensible_representation First)
     | None, _, Variant_extensible ->
       Some (Extensible_representation Second)
+    | None, Variant_with_null, _ ->
+      Some (With_null_representation First)
+    | None, _, Variant_with_null ->
+      Some (With_null_representation Second)
 end
 
 (* Inclusion between "private" annotations *)
@@ -1338,15 +1348,25 @@ let type_declarations ?(equality = false) ~loc env ~mark name
       rep1 rep2
   in
   let err = match (decl1.type_kind, decl2.type_kind) with
-      (_, Type_abstract _) ->
-       (* Note that [decl2.type_jkind] is an upper bound.
-          If it isn't tight, [decl2] must
-          have a manifest, which we're already checking for equality
-          above. Similarly, [decl1]'s kind may conservatively approximate its
-          jkind, but [check_decl_jkind] will expand its manifest.  *)
-        (match Ctype.check_decl_jkind env decl1 decl2.type_jkind with
-         | Ok _ -> None
-         | Error v -> Some (Jkind v))
+      (_, Type_abstract _) -> begin
+        (* If both the intf has "allow any kind in impl" *and* the impl has "allow any
+           kind in intf", don't check the jkind at all. *)
+        let allow_any =
+          Builtin_attributes.has_unsafe_allow_any_kind_in_impl decl2.type_attributes
+          && Builtin_attributes.has_unsafe_allow_any_kind_in_intf decl1.type_attributes
+        in
+        (* Note that [decl2.type_jkind] is an upper bound. If it isn't tight, [decl2] must
+           have a manifest, which we're already checking for equality above. Similarly,
+           [decl1]'s kind may conservatively approximate its jkind, but [check_decl_jkind]
+           will expand its manifest. *)
+        match Ctype.check_decl_jkind env decl1 decl2.type_jkind  with
+        | Ok _ ->
+          (if allow_any
+           then Location.prerr_warning decl2.type_loc (Warnings.Unnecessary_allow_any_kind));
+          None
+        | Error _ when allow_any -> None
+        | Error v -> Some (Jkind v)
+      end
     | (Type_variant (cstrs1, rep1), Type_variant (cstrs2, rep2)) ->
         if mark then begin
           let mark usage cstrs =
diff --git a/typing/includecore.mli b/typing/includecore.mli
index dea4a38b4cd..505d5e7cf57 100644
--- a/typing/includecore.mli
+++ b/typing/includecore.mli
@@ -119,6 +119,7 @@ type type_mismatch =
   | Variant_mismatch of variant_change list
   | Unboxed_representation of position * attributes
   | Extensible_representation of position
+  | With_null_representation of position
   | Jkind of Jkind.Violation.t
 
 type mmodes =
diff --git a/typing/jkind.ml b/typing/jkind.ml
index 27df68f136c..c0bb1512f4f 100644
--- a/typing/jkind.ml
+++ b/typing/jkind.ml
@@ -436,7 +436,8 @@ module Const = struct
                 contention = Contention.Const.min;
                 portability = Portability.Const.min;
                 uniqueness = Uniqueness.Const.max;
-                areality = Locality.Const.max
+                areality = Locality.Const.max;
+                yielding = Yielding.Const.min
               };
             externality_upper_bound = Externality.max;
             nullability_upper_bound = Nullability.Non_null
@@ -452,7 +453,8 @@ module Const = struct
                 contention = Contention.Const.max;
                 portability = Portability.Const.min;
                 uniqueness = Uniqueness.Const.max;
-                areality = Locality.Const.max
+                areality = Locality.Const.max;
+                yielding = Yielding.Const.min
               };
             externality_upper_bound = Externality.max;
             nullability_upper_bound = Nullability.Non_null
@@ -774,7 +776,8 @@ module Const = struct
           linearity = parsed_modifiers.linearity;
           uniqueness = parsed_modifiers.uniqueness;
           portability = parsed_modifiers.portability;
-          contention = parsed_modifiers.contention
+          contention = parsed_modifiers.contention;
+          yielding = parsed_modifiers.yielding
         }
       in
       { layout = base.layout;
@@ -1165,7 +1168,8 @@ let for_arrow =
           areality = Locality.Const.max;
           uniqueness = Uniqueness.Const.min;
           portability = Portability.Const.max;
-          contention = Contention.Const.min
+          contention = Contention.Const.min;
+          yielding = Yielding.Const.max
         };
       externality_upper_bound = Externality.max;
       nullability_upper_bound = Non_null
diff --git a/typing/jkind_axis.ml b/typing/jkind_axis.ml
index b81e66ad8ba..383cc942db8 100644
--- a/typing/jkind_axis.ml
+++ b/typing/jkind_axis.ml
@@ -142,6 +142,7 @@ module Axis = struct
       | Uniqueness : Mode.Uniqueness.Const.t t
       | Portability : Mode.Portability.Const.t t
       | Contention : Mode.Contention.Const.t t
+      | Yielding : Mode.Yielding.Const.t t
   end
 
   module Nonmodal = struct
@@ -180,6 +181,8 @@ module Axis = struct
       (module Accent_lattice (Mode.Portability.Const) : Axis_s with type t = a)
     | Modal Contention ->
       (module Accent_lattice (Mode.Contention.Const) : Axis_s with type t = a)
+    | Modal Yielding ->
+      (module Accent_lattice (Mode.Yielding.Const) : Axis_s with type t = a)
     | Nonmodal Externality -> (module Externality : Axis_s with type t = a)
     | Nonmodal Nullability -> (module Nullability : Axis_s with type t = a)
 
@@ -189,6 +192,7 @@ module Axis = struct
       Pack (Modal Uniqueness);
       Pack (Modal Portability);
       Pack (Modal Contention);
+      Pack (Modal Yielding);
       Pack (Nonmodal Externality);
       Pack (Nonmodal Nullability) ]
 
@@ -198,6 +202,7 @@ module Axis = struct
     | Modal Uniqueness -> "uniqueness"
     | Modal Portability -> "portability"
     | Modal Contention -> "contention"
+    | Modal Yielding -> "yielding"
     | Nonmodal Externality -> "externality"
     | Nonmodal Nullability -> "nullability"
 end
@@ -210,6 +215,7 @@ module Axis_collection (T : Misc.T1) = struct
       uniqueness : Mode.Uniqueness.Const.t T.t;
       portability : Mode.Portability.Const.t T.t;
       contention : Mode.Contention.Const.t T.t;
+      yielding : Mode.Yielding.Const.t T.t;
       externality : Externality.t T.t;
       nullability : Nullability.t T.t
     }
@@ -221,6 +227,7 @@ module Axis_collection (T : Misc.T1) = struct
     | Modal Uniqueness -> values.uniqueness
     | Modal Portability -> values.portability
     | Modal Contention -> values.contention
+    | Modal Yielding -> values.yielding
     | Nonmodal Externality -> values.externality
     | Nonmodal Nullability -> values.nullability
 
@@ -231,6 +238,7 @@ module Axis_collection (T : Misc.T1) = struct
     | Modal Uniqueness -> { values with uniqueness = value }
     | Modal Portability -> { values with portability = value }
     | Modal Contention -> { values with contention = value }
+    | Modal Yielding -> { values with yielding = value }
     | Nonmodal Externality -> { values with externality = value }
     | Nonmodal Nullability -> { values with nullability = value }
 
@@ -246,6 +254,7 @@ module Axis_collection (T : Misc.T1) = struct
       uniqueness = f ~axis:Axis.(Modal Uniqueness);
       portability = f ~axis:Axis.(Modal Portability);
       contention = f ~axis:Axis.(Modal Contention);
+      yielding = f ~axis:Axis.(Modal Yielding);
       externality = f ~axis:Axis.(Nonmodal Externality);
       nullability = f ~axis:Axis.(Nonmodal Nullability)
     }
diff --git a/typing/jkind_axis.mli b/typing/jkind_axis.mli
index c3cf2aa42af..6ee32d23316 100644
--- a/typing/jkind_axis.mli
+++ b/typing/jkind_axis.mli
@@ -64,6 +64,7 @@ module Axis : sig
       | Uniqueness : Mode.Uniqueness.Const.t t
       | Portability : Mode.Portability.Const.t t
       | Contention : Mode.Contention.Const.t t
+      | Yielding : Mode.Yielding.Const.t t
   end
 
   module Nonmodal : sig
@@ -98,6 +99,7 @@ module Axis_collection (T : Misc.T1) : sig
       uniqueness : Mode.Uniqueness.Const.t T.t;
       portability : Mode.Portability.Const.t T.t;
       contention : Mode.Contention.Const.t T.t;
+      yielding : Mode.Yielding.Const.t T.t;
       externality : Externality.t T.t;
       nullability : Nullability.t T.t
     }
diff --git a/typing/mode.ml b/typing/mode.ml
index b72beee20f2..103631f5b4a 100644
--- a/typing/mode.ml
+++ b/typing/mode.ml
@@ -317,6 +317,41 @@ module Lattices = struct
 
   module Contention_op = Opposite (Contention)
 
+  module Yielding = struct
+    type t =
+      | Yielding
+      | Unyielding
+
+    include Total (struct
+      type nonrec t = t
+
+      let min = Unyielding
+
+      let max = Yielding
+
+      let legacy = Unyielding
+
+      let le a b =
+        match a, b with
+        | Unyielding, _ | _, Yielding -> true
+        | Yielding, Unyielding -> false
+
+      let join a b =
+        match a, b with
+        | Yielding, _ | _, Yielding -> Yielding
+        | Unyielding, Unyielding -> Unyielding
+
+      let meet a b =
+        match a, b with
+        | Unyielding, _ | _, Unyielding -> Unyielding
+        | Yielding, Yielding -> Yielding
+
+      let print ppf = function
+        | Yielding -> Format.fprintf ppf "yielding"
+        | Unyielding -> Format.fprintf ppf "unyielding"
+    end)
+  end
+
   type monadic = Uniqueness.t * Contention.t
 
   module Monadic = struct
@@ -343,37 +378,50 @@ module Lattices = struct
       Format.fprintf ppf "%a,%a" Uniqueness.print a0 Contention.print a1
   end
 
-  type 'areality comonadic_with = 'areality * Linearity.t * Portability.t
+  type 'areality comonadic_with =
+    'areality * Linearity.t * Portability.t * Yielding.t
 
   module Comonadic_with (Areality : Areality) = struct
     type t = Areality.t comonadic_with
 
-    let min = Areality.min, Linearity.min, Portability.min
+    let min = Areality.min, Linearity.min, Portability.min, Yielding.min
 
-    let max = Areality.max, Linearity.max, Portability.max
+    let max = Areality.max, Linearity.max, Portability.max, Yielding.max
 
-    let legacy = Areality.legacy, Linearity.legacy, Portability.legacy
+    let legacy =
+      Areality.legacy, Linearity.legacy, Portability.legacy, Yielding.legacy
 
-    let le (a0, a1, a2) (b0, b1, b2) =
+    let le (a0, a1, a2, a3) (b0, b1, b2, b3) =
       Areality.le a0 b0 && Linearity.le a1 b1 && Portability.le a2 b2
-
-    let join (a0, a1, a2) (b0, b1, b2) =
-      Areality.join a0 b0, Linearity.join a1 b1, Portability.join a2 b2
-
-    let meet (a0, a1, a2) (b0, b1, b2) =
-      Areality.meet a0 b0, Linearity.meet a1 b1, Portability.meet a2 b2
-
-    let imply (a0, a1, a2) (b0, b1, b2) =
-      Areality.imply a0 b0, Linearity.imply a1 b1, Portability.imply a2 b2
-
-    let subtract (a0, a1, a2) (b0, b1, b2) =
+      && Yielding.le a3 b3
+
+    let join (a0, a1, a2, a3) (b0, b1, b2, b3) =
+      ( Areality.join a0 b0,
+        Linearity.join a1 b1,
+        Portability.join a2 b2,
+        Yielding.join a3 b3 )
+
+    let meet (a0, a1, a2, a3) (b0, b1, b2, b3) =
+      ( Areality.meet a0 b0,
+        Linearity.meet a1 b1,
+        Portability.meet a2 b2,
+        Yielding.meet a3 b3 )
+
+    let imply (a0, a1, a2, a3) (b0, b1, b2, b3) =
+      ( Areality.imply a0 b0,
+        Linearity.imply a1 b1,
+        Portability.imply a2 b2,
+        Yielding.imply a3 b3 )
+
+    let subtract (a0, a1, a2, a3) (b0, b1, b2, b3) =
       ( Areality.subtract a0 b0,
         Linearity.subtract a1 b1,
-        Portability.subtract a2 b2 )
+        Portability.subtract a2 b2,
+        Yielding.subtract a3 b3 )
 
-    let print ppf (a0, a1, a2) =
-      Format.fprintf ppf "%a,%a,%a" Areality.print a0 Linearity.print a1
-        Portability.print a2
+    let print ppf (a0, a1, a2, a3) =
+      Format.fprintf ppf "%a,%a,%a,%a" Areality.print a0 Linearity.print a1
+        Portability.print a2 Yielding.print a3
   end
   [@@inline]
 
@@ -392,6 +440,7 @@ module Lattices = struct
     | Uniqueness_op : Uniqueness_op.t obj
     | Linearity : Linearity.t obj
     | Portability : Portability.t obj
+    | Yielding : Yielding.t obj
     | Contention_op : Contention_op.t obj
     | Monadic_op : Monadic_op.t obj
     | Comonadic_with_regionality : Comonadic_with_regionality.t obj
@@ -404,6 +453,7 @@ module Lattices = struct
     | Uniqueness_op -> Format.fprintf ppf "Uniqueness_op"
     | Linearity -> Format.fprintf ppf "Linearity"
     | Portability -> Format.fprintf ppf "Portability"
+    | Yielding -> Format.fprintf ppf "Yielding"
     | Contention_op -> Format.fprintf ppf "Contention_op"
     | Monadic_op -> Format.fprintf ppf "Monadic_op"
     | Comonadic_with_locality -> Format.fprintf ppf "Comonadic_with_locality"
@@ -415,6 +465,7 @@ module Lattices = struct
     | Regionality -> Regionality.min
     | Uniqueness_op -> Uniqueness_op.min
     | Contention_op -> Contention_op.min
+    | Yielding -> Yielding.min
     | Linearity -> Linearity.min
     | Portability -> Portability.min
     | Monadic_op -> Monadic_op.min
@@ -428,6 +479,7 @@ module Lattices = struct
     | Contention_op -> Contention_op.max
     | Linearity -> Linearity.max
     | Portability -> Portability.max
+    | Yielding -> Yielding.max
     | Monadic_op -> Monadic_op.max
     | Comonadic_with_locality -> Comonadic_with_locality.max
     | Comonadic_with_regionality -> Comonadic_with_regionality.max
@@ -441,6 +493,7 @@ module Lattices = struct
     | Contention_op -> Contention_op.le a b
     | Linearity -> Linearity.le a b
     | Portability -> Portability.le a b
+    | Yielding -> Yielding.le a b
     | Monadic_op -> Monadic_op.le a b
     | Comonadic_with_locality -> Comonadic_with_locality.le a b
     | Comonadic_with_regionality -> Comonadic_with_regionality.le a b
@@ -454,6 +507,7 @@ module Lattices = struct
     | Contention_op -> Contention_op.join a b
     | Linearity -> Linearity.join a b
     | Portability -> Portability.join a b
+    | Yielding -> Yielding.join a b
     | Monadic_op -> Monadic_op.join a b
     | Comonadic_with_locality -> Comonadic_with_locality.join a b
     | Comonadic_with_regionality -> Comonadic_with_regionality.join a b
@@ -467,6 +521,7 @@ module Lattices = struct
     | Contention_op -> Contention_op.meet a b
     | Linearity -> Linearity.meet a b
     | Portability -> Portability.meet a b
+    | Yielding -> Yielding.meet a b
     | Monadic_op -> Monadic_op.meet a b
     | Comonadic_with_locality -> Comonadic_with_locality.meet a b
     | Comonadic_with_regionality -> Comonadic_with_regionality.meet a b
@@ -480,6 +535,7 @@ module Lattices = struct
     | Contention_op -> Contention_op.imply a b
     | Linearity -> Linearity.imply a b
     | Portability -> Portability.imply a b
+    | Yielding -> Yielding.imply a b
     | Comonadic_with_locality -> Comonadic_with_locality.imply a b
     | Comonadic_with_regionality -> Comonadic_with_regionality.imply a b
     | Monadic_op -> Monadic_op.imply a b
@@ -493,6 +549,7 @@ module Lattices = struct
     | Contention_op -> Contention_op.subtract a b
     | Linearity -> Linearity.subtract a b
     | Portability -> Portability.subtract a b
+    | Yielding -> Yielding.subtract a b
     | Comonadic_with_locality -> Comonadic_with_locality.subtract a b
     | Comonadic_with_regionality -> Comonadic_with_regionality.subtract a b
     | Monadic_op -> Monadic_op.subtract a b
@@ -505,6 +562,7 @@ module Lattices = struct
     | Contention_op -> Contention_op.print
     | Linearity -> Linearity.print
     | Portability -> Portability.print
+    | Yielding -> Yielding.print
     | Monadic_op -> Monadic_op.print
     | Comonadic_with_locality -> Comonadic_with_locality.print
     | Comonadic_with_regionality -> Comonadic_with_regionality.print
@@ -521,11 +579,12 @@ module Lattices = struct
       | Contention_op, Contention_op -> Some Refl
       | Linearity, Linearity -> Some Refl
       | Portability, Portability -> Some Refl
+      | Yielding, Yielding -> Some Refl
       | Monadic_op, Monadic_op -> Some Refl
       | Comonadic_with_locality, Comonadic_with_locality -> Some Refl
       | Comonadic_with_regionality, Comonadic_with_regionality -> Some Refl
       | ( ( Locality | Regionality | Uniqueness_op | Contention_op | Linearity
-          | Portability | Monadic_op | Comonadic_with_locality
+          | Portability | Yielding | Monadic_op | Comonadic_with_locality
           | Comonadic_with_regionality ),
           _ ) ->
         None
@@ -542,6 +601,7 @@ module Lattices_mono = struct
       | Areality : ('a comonadic_with, 'a) t
       | Linearity : ('areality comonadic_with, Linearity.t) t
       | Portability : ('areality comonadic_with, Portability.t) t
+      | Yielding : ('areality comonadic_with, Yielding.t) t
       | Uniqueness : (Monadic_op.t, Uniqueness_op.t) t
       | Contention : (Monadic_op.t, Contention_op.t) t
 
@@ -552,6 +612,7 @@ module Lattices_mono = struct
       | Portability -> Format.fprintf ppf "portability"
       | Uniqueness -> Format.fprintf ppf "uniqueness"
       | Contention -> Format.fprintf ppf "contention"
+      | Yielding -> Format.fprintf ppf "yielding"
 
     let eq : type p r0 r1. (p, r0) t -> (p, r1) t -> (r0, r1) Misc.eq option =
      fun ax0 ax1 ->
@@ -561,24 +622,29 @@ module Lattices_mono = struct
       | Portability, Portability -> Some Refl
       | Uniqueness, Uniqueness -> Some Refl
       | Contention, Contention -> Some Refl
-      | (Areality | Linearity | Uniqueness | Portability | Contention), _ ->
+      | Yielding, Yielding -> Some Refl
+      | ( ( Areality | Linearity | Uniqueness | Portability | Contention
+          | Yielding ),
+          _ ) ->
         None
 
     let proj : type p r. (p, r) t -> p -> r =
      fun ax t ->
       match ax, t with
-      | Areality, (a, _, _) -> a
-      | Linearity, (_, lin, _) -> lin
-      | Portability, (_, _, s) -> s
+      | Areality, (a, _, _, _) -> a
+      | Linearity, (_, lin, _, _) -> lin
+      | Portability, (_, _, s, _) -> s
+      | Yielding, (_, _, _, yld) -> yld
       | Uniqueness, (uni, _) -> uni
       | Contention, (_, con) -> con
 
     let update : type p r. (p, r) t -> r -> p -> p =
      fun ax r t ->
       match ax, t with
-      | Areality, (_, lin, portable) -> r, lin, portable
-      | Linearity, (area, _, portable) -> area, r, portable
-      | Portability, (area, lin, _) -> area, lin, r
+      | Areality, (_, lin, portable, yld) -> r, lin, portable, yld
+      | Linearity, (area, _, portable, yld) -> area, r, portable, yld
+      | Portability, (area, lin, _, yld) -> area, lin, r, yld
+      | Yielding, (area, lin, portable, _) -> area, lin, portable, r
       | Uniqueness, (_, con) -> r, con
       | Contention, (uni, _) -> uni, r
   end
@@ -733,7 +799,7 @@ module Lattices_mono = struct
   end)
 
   let set_areality : type a0 a1. a1 -> a0 comonadic_with -> a1 comonadic_with =
-   fun r (_, lin, portable) -> r, lin, portable
+   fun r (_, lin, portable, yld) -> r, lin, portable, yld
 
   let proj_obj : type t r. (t, r) Axis.t -> t obj -> r obj =
    fun ax obj ->
@@ -744,6 +810,8 @@ module Lattices_mono = struct
     | Linearity, Comonadic_with_regionality -> Linearity
     | Portability, Comonadic_with_locality -> Portability
     | Portability, Comonadic_with_regionality -> Portability
+    | Yielding, Comonadic_with_locality -> Yielding
+    | Yielding, Comonadic_with_regionality -> Yielding
     | Uniqueness, Monadic_op -> Uniqueness_op
     | Contention, Monadic_op -> Contention_op
 
@@ -753,7 +821,7 @@ module Lattices_mono = struct
     | Locality -> Comonadic_with_locality
     | Regionality -> Comonadic_with_regionality
     | Uniqueness_op | Linearity | Monadic_op | Comonadic_with_regionality
-    | Comonadic_with_locality | Contention_op | Portability ->
+    | Comonadic_with_locality | Contention_op | Portability | Yielding ->
       assert false
 
   let rec src : type a b d. b obj -> (a, b, d) morph -> a obj =
@@ -921,15 +989,17 @@ module Lattices_mono = struct
     | Comonadic_with_locality ->
       ( Locality.min,
         unique_to_linear uniqueness,
-        contended_to_portable contention )
+        contended_to_portable contention,
+        Yielding.min )
     | Comonadic_with_regionality ->
       ( Regionality.min,
         unique_to_linear uniqueness,
-        contended_to_portable contention )
+        contended_to_portable contention,
+        Yielding.min )
 
   let comonadic_to_monadic :
       type a. a comonadic_with obj -> a comonadic_with -> Monadic_op.t =
-   fun obj (_, linearity, portability) ->
+   fun obj (_, linearity, portability, _) ->
     match obj with
     | Comonadic_with_locality ->
       linear_to_unique linearity, portable_to_contended portability
@@ -943,11 +1013,13 @@ module Lattices_mono = struct
     | Comonadic_with_locality ->
       ( Locality.max,
         unique_to_linear uniqueness,
-        contended_to_portable contention )
+        contended_to_portable contention,
+        Yielding.max )
     | Comonadic_with_regionality ->
       ( Regionality.max,
         unique_to_linear uniqueness,
-        contended_to_portable contention )
+        contended_to_portable contention,
+        Yielding.max )
 
   let rec apply : type a b d. b obj -> (a, b, d) morph -> a -> b =
    fun dst f a ->
@@ -1036,7 +1108,8 @@ module Lattices_mono = struct
       match ax with
       | Areality -> Some (compose dst f (Proj (src', Areality)))
       | Linearity -> Some (Proj (src', Linearity))
-      | Portability -> Some (Proj (src', Portability)))
+      | Portability -> Some (Proj (src', Portability))
+      | Yielding -> Some (Proj (src', Yielding)))
     | Proj _, Monadic_to_comonadic_min -> None
     | Proj _, Monadic_to_comonadic_max -> None
     | Proj _, Comonadic_to_monadic _ -> None
@@ -1482,6 +1555,24 @@ module Contention = struct
   let zap_to_legacy = zap_to_floor
 end
 
+module Yielding = struct
+  module Const = C.Yielding
+
+  module Obj = struct
+    type const = Const.t
+
+    module Solver = S.Positive
+
+    let obj = C.Yielding
+  end
+
+  include Common (Obj)
+
+  let legacy = of_const Const.legacy
+
+  let zap_to_legacy = zap_to_floor
+end
+
 let regional_to_local m =
   S.Positive.via_monotone Locality.Obj.obj C.Regional_to_local m
 
@@ -1562,20 +1653,25 @@ module Comonadic_with (Areality : Areality) = struct
     let areality = proj Areality m |> Areality.zap_to_legacy in
     let linearity = proj Linearity m |> Linearity.zap_to_legacy in
     let portability = proj Portability m |> Portability.zap_to_legacy in
-    areality, linearity, portability
+    let yielding = proj Yielding m |> Yielding.zap_to_legacy in
+    areality, linearity, portability, yielding
 
   let imply c m = Solver.via_monotone obj (Imply c) (Solver.disallow_left m)
 
   let legacy = of_const Const.legacy
 
-  let axis_of_error { left = area0, lin0, port0; right = area1, lin1, port1 } :
+  let axis_of_error
+      { left = area0, lin0, port0, yld0; right = area1, lin1, port1, yld1 } :
       error =
     if Areality.Const.le area0 area1
     then
       if Linearity.Const.le lin0 lin1
       then
         if Portability.Const.le port0 port1
-        then assert false
+        then
+          if Yielding.Const.le yld0 yld1
+          then assert false
+          else Error (Yielding, { left = yld0; right = yld1 })
         else Error (Portability, { left = port0; right = port1 })
       else Error (Linearity, { left = lin0; right = lin1 })
     else Error (Areality, { left = area0; right = area1 })
@@ -1713,23 +1809,25 @@ module Value_with (Areality : Areality) = struct
     | Monadic ax -> Monadic.proj_obj ax
     | Comonadic ax -> Comonadic.proj_obj ax
 
-  type ('a, 'b, 'c, 'd, 'e) modes =
+  type ('a, 'b, 'c, 'd, 'e, 'f) modes =
     { areality : 'a;
       linearity : 'b;
       uniqueness : 'c;
       portability : 'd;
-      contention : 'e
+      contention : 'e;
+      yielding : 'f
     }
 
-  let split { areality; linearity; portability; uniqueness; contention } =
+  let split
+      { areality; linearity; portability; uniqueness; contention; yielding } =
     let monadic = uniqueness, contention in
-    let comonadic = areality, linearity, portability in
+    let comonadic = areality, linearity, portability, yielding in
     { comonadic; monadic }
 
   let merge { comonadic; monadic } =
-    let areality, linearity, portability = comonadic in
+    let areality, linearity, portability, yielding = comonadic in
     let uniqueness, contention = monadic in
-    { areality; linearity; portability; uniqueness; contention }
+    { areality; linearity; portability; uniqueness; contention; yielding }
 
   let print ?verbose () ppf { monadic; comonadic } =
     Format.fprintf ppf "%a;%a"
@@ -1750,7 +1848,8 @@ module Value_with (Areality : Areality) = struct
         Linearity.Const.t,
         Uniqueness.Const.t,
         Portability.Const.t,
-        Contention.Const.t )
+        Contention.Const.t,
+        Yielding.Const.t )
       modes
 
     module Monadic = Monadic.Const
@@ -1794,7 +1893,8 @@ module Value_with (Areality : Areality) = struct
           Linearity.Const.t option,
           Uniqueness.Const.t option,
           Portability.Const.t option,
-          Contention.Const.t option )
+          Contention.Const.t option,
+          Yielding.Const.t option )
         modes
 
       let none =
@@ -1802,7 +1902,8 @@ module Value_with (Areality : Areality) = struct
           uniqueness = None;
           linearity = None;
           portability = None;
-          contention = None
+          contention = None;
+          yielding = None
         }
 
       let value opt ~default =
@@ -1817,15 +1918,17 @@ module Value_with (Areality : Areality) = struct
         let contention =
           Option.value opt.contention ~default:default.contention
         in
-        { areality; uniqueness; linearity; portability; contention }
+        let yielding = Option.value opt.yielding ~default:default.yielding in
+        { areality; uniqueness; linearity; portability; contention; yielding }
 
-      let print ppf { areality; uniqueness; linearity; portability; contention }
+      let print ppf
+          { areality; uniqueness; linearity; portability; contention; yielding }
           =
         let option_print print ppf = function
           | None -> Format.fprintf ppf "None"
           | Some a -> Format.fprintf ppf "Some %a" print a
         in
-        Format.fprintf ppf "%a,%a,%a,%a,%a"
+        Format.fprintf ppf "%a,%a,%a,%a,%a,%a"
           (option_print Areality.Const.print)
           areality
           (option_print Linearity.Const.print)
@@ -1836,6 +1939,8 @@ module Value_with (Areality : Areality) = struct
           portability
           (option_print Contention.Const.print)
           contention
+          (option_print Yielding.Const.print)
+          yielding
     end
 
     let diff m0 m1 =
@@ -1847,7 +1952,8 @@ module Value_with (Areality : Areality) = struct
         diff Portability.Const.le m0.portability m1.portability
       in
       let contention = diff Contention.Const.le m0.contention m1.contention in
-      { areality; linearity; uniqueness; portability; contention }
+      let yielding = diff Yielding.Const.le m0.yielding m1.yielding in
+      { areality; linearity; uniqueness; portability; contention; yielding }
 
     (** See [Alloc.close_over] for explanation. *)
     let close_over m =
@@ -2139,10 +2245,10 @@ module Alloc = Value_with (Locality)
 
 module Const = struct
   let alloc_as_value
-      ({ areality; linearity; portability; uniqueness; contention } :
+      ({ areality; linearity; portability; uniqueness; contention; yielding } :
         Alloc.Const.t) : Value.Const.t =
     let areality = C.locality_as_regionality areality in
-    { areality; linearity; portability; uniqueness; contention }
+    { areality; linearity; portability; uniqueness; contention; yielding }
 
   let locality_as_regionality = C.locality_as_regionality
 end
diff --git a/typing/mode_intf.mli b/typing/mode_intf.mli
index 5b0f4897265..5498d636979 100644
--- a/typing/mode_intf.mli
+++ b/typing/mode_intf.mli
@@ -263,7 +263,26 @@ module type S = sig
          and type 'd t = (Const.t, 'd) mode_monadic
   end
 
-  type 'a comonadic_with = private 'a * Linearity.Const.t * Portability.Const.t
+  module Yielding : sig
+    module Const : sig
+      type t =
+        | Yielding
+        | Unyielding
+
+      include Lattice with type t := t
+    end
+
+    type error = Const.t Solver.error
+
+    include
+      Common
+        with module Const := Const
+         and type error := error
+         and type 'd t = (Const.t, 'd) mode_comonadic
+  end
+
+  type 'a comonadic_with = private
+    'a * Linearity.Const.t * Portability.Const.t * Yielding.Const.t
 
   type monadic = private Uniqueness.Const.t * Contention.Const.t
 
@@ -274,6 +293,7 @@ module type S = sig
       | Areality : ('a comonadic_with, 'a) t
       | Linearity : ('areality comonadic_with, Linearity.Const.t) t
       | Portability : ('areality comonadic_with, Portability.Const.t) t
+      | Yielding : ('areality comonadic_with, Yielding.Const.t) t
       | Uniqueness : (monadic, Uniqueness.Const.t) t
       | Contention : (monadic, Contention.Const.t) t
 
@@ -317,12 +337,13 @@ module type S = sig
           (Comonadic.Const.t, 'a) Axis.t
           -> (('a, 'd) mode_comonadic, 'a, 'd) axis
 
-    type ('a, 'b, 'c, 'd, 'e) modes =
+    type ('a, 'b, 'c, 'd, 'e, 'f) modes =
       { areality : 'a;
         linearity : 'b;
         uniqueness : 'c;
         portability : 'd;
-        contention : 'e
+        contention : 'e;
+        yielding : 'f
       }
 
     module Const : sig
@@ -333,7 +354,8 @@ module type S = sig
               Linearity.Const.t,
               Uniqueness.Const.t,
               Portability.Const.t,
-              Contention.Const.t )
+              Contention.Const.t,
+              Yielding.Const.t )
             modes
 
       module Option : sig
@@ -344,7 +366,8 @@ module type S = sig
             Linearity.Const.t option,
             Uniqueness.Const.t option,
             Portability.Const.t option,
-            Contention.Const.t option )
+            Contention.Const.t option,
+            Yielding.Const.t option )
           modes
 
         val none : t
diff --git a/typing/oprint.ml b/typing/oprint.ml
index a1b75512ddf..a714d1aec3f 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -197,6 +197,7 @@ let print_out_string ppf s =
   else
     fprintf ppf "%S" s
 
+(* We cannot use the [float32] type in the compiler. *)
 external float32_format : string -> Obj.t -> string = "caml_format_float32"
 
 let float32_to_string f = Stdlib.valid_float_lexem (float32_format "%.9g" f)
@@ -975,6 +976,11 @@ and print_out_type_decl kwd ppf td =
   let print_unboxed ppf =
     if td.otype_unboxed then fprintf ppf " [%@%@unboxed]" else ()
   in
+  let print_or_null_reexport ppf =
+    if td.otype_or_null_reexport then
+      fprintf ppf " [%@%@or_null_reexport]"
+    else ()
+  in
   let print_out_tkind ppf = function
   | Otyp_abstract -> ()
   | Otyp_record lbls ->
@@ -1000,12 +1006,13 @@ and print_out_type_decl kwd ppf td =
         print_private td.otype_private
         !out_type ty
   in
-  fprintf ppf "@[<2>@[<hv 2>%t%a%a@]%t%t@]"
+  fprintf ppf "@[<2>@[<hv 2>%t%a%a@]%t%t%t@]"
     print_name_params
     print_out_jkind_annot td.otype_jkind
     print_out_tkind ty
     print_constraints
     print_unboxed
+    print_or_null_reexport
 
 and print_simple_out_gf_type ppf (ty, gf) =
   let m_legacy, m_new = partition_modalities gf in
diff --git a/typing/outcometree.mli b/typing/outcometree.mli
index b0df11dc455..8defebafc99 100644
--- a/typing/outcometree.mli
+++ b/typing/outcometree.mli
@@ -204,6 +204,7 @@ and out_type_decl =
     otype_jkind: out_jkind option;
 
     otype_unboxed: bool;
+    otype_or_null_reexport: bool;
     otype_cstrs: (out_type * out_type) list }
 and out_extension_constructor =
   { oext_name: string;
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index 593a4d7ca21..277c56addc1 100644
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -923,7 +923,7 @@ let should_extend ext env = match ext with
   | (p,_)::_ ->
       let open Patterns.Head in
       begin match p.pat_desc with
-      | Construct {cstr_tag=Ordinary _} ->
+      | Construct {cstr_tag=Ordinary _ | Null} ->
           let path = get_constructor_type_path p.pat_type p.pat_env in
           Path.same path ext
       | Construct {cstr_tag=Extension _} -> false
@@ -2129,7 +2129,7 @@ let extendable_path path =
     Path.same path Predef.path_option)
 
 let rec collect_paths_from_pat r p = match p.pat_desc with
-| Tpat_construct(_, {cstr_tag=Ordinary _}, ps, _) ->
+| Tpat_construct(_, {cstr_tag=Ordinary _ | Null}, ps, _) ->
     let path = get_constructor_type_path p.pat_type p.pat_env in
     List.fold_left
       collect_paths_from_pat
diff --git a/typing/predef.ml b/typing/predef.ml
index 9b201afbede..6e140f2ffb1 100644
--- a/typing/predef.ml
+++ b/typing/predef.ml
@@ -477,6 +477,8 @@ let add_small_number_beta_extension_types add_type env =
   |> add_type ident_int16 ~jkind:Jkind.Const.Builtin.immediate
 
 let or_null_kind tvar =
+  (* CR layouts v3: use [Variant_with_null] when it's supported
+     in the backend. *)
   variant [cstr ident_null [];
            cstr ident_this [unrestricted tvar or_null_argument_sort]]
 
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index f75357288ad..134d25c9e85 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -1419,7 +1419,8 @@ let tree_of_modes modes =
     tree_of_mode diff.uniqueness [Mode.Uniqueness.Const.Unique, Omd_new "unique"];
     tree_of_mode diff.portability [Mode.Portability.Const.Portable, Omd_new "portable"];
     tree_of_mode diff.contention [Mode.Contention.Const.Contended, Omd_new "contended";
-                                  Mode.Contention.Const.Shared, Omd_new "shared"]]
+                                  Mode.Contention.Const.Shared, Omd_new "shared"];
+    tree_of_mode diff.yielding [Mode.Yielding.Const.Yielding, Omd_new "yielding"]]
   in
   List.filter_map Fun.id l
 
@@ -1934,35 +1935,46 @@ let tree_of_type_decl id decl =
   in
   let (name, args) = type_defined decl in
   let constraints = tree_of_constraints params in
-  let ty, priv, unboxed =
+  let ty, priv, unboxed, or_null_reexport =
     match decl.type_kind with
     | Type_abstract _ ->
         begin match ty_manifest with
-        | None -> (Otyp_abstract, Public, false)
+        | None -> (Otyp_abstract, Public, false, false)
         | Some ty ->
-            tree_of_typexp Type ty, decl.type_private, false
+            tree_of_typexp Type ty, decl.type_private, false, false
         end
     | Type_variant (cstrs, rep) ->
         let unboxed =
           match rep with
           | Variant_unboxed -> true
-          | Variant_boxed _ | Variant_extensible -> false
+          | Variant_boxed _ | Variant_extensible | Variant_with_null -> false
+        in
+        (* CR layouts v3.5: remove when [Variant_with_null] is merged into
+           [Variant_unboxed]. *)
+        let or_null_reexport =
+          match rep with
+          | Variant_with_null -> true
+          | Variant_boxed _ | Variant_unboxed | Variant_extensible -> false
         in
         tree_of_manifest (Otyp_sum (List.map tree_of_constructor_in_decl cstrs)),
         decl.type_private,
-        unboxed
+        unboxed,
+        or_null_reexport
     | Type_record(lbls, rep) ->
         tree_of_manifest (Otyp_record (List.map tree_of_label lbls)),
         decl.type_private,
-        (match rep with Record_unboxed -> true | _ -> false)
+        (match rep with Record_unboxed -> true | _ -> false),
+        false
     | Type_record_unboxed_product(lbls, Record_unboxed_product) ->
         tree_of_manifest
           (Otyp_record_unboxed_product (List.map tree_of_label lbls)),
         decl.type_private,
+        false,
         false
     | Type_open ->
         tree_of_manifest Otyp_open,
         decl.type_private,
+        false,
         false
   in
   (* The algorithm for setting [lay] here is described as Case (C1) in
@@ -1984,6 +1996,7 @@ let tree_of_type_decl id decl =
       otype_private = priv;
       otype_jkind;
       otype_unboxed = unboxed;
+      otype_or_null_reexport = or_null_reexport;
       otype_cstrs = constraints }
 
 let add_type_decl_to_preparation id decl =
diff --git a/typing/printtyped.ml b/typing/printtyped.ml
index 153dd95a48f..5dc8b08d96e 100644
--- a/typing/printtyped.ml
+++ b/typing/printtyped.ml
@@ -188,6 +188,7 @@ let tag ppf = let open Types in function
   | Ordinary {src_index;runtime_tag} ->
       fprintf ppf "Ordinary {index: %d; tag: %d}" src_index runtime_tag
   | Extension p -> fprintf ppf "Extension %a" fmt_path p
+  | Null -> fprintf ppf "Null"
 
 let variant_representation i ppf = let open Types in function
   | Variant_unboxed ->
@@ -198,6 +199,7 @@ let variant_representation i ppf = let open Types in function
          sort_array (i+1) ppf sorts))
       cstrs
   | Variant_extensible -> line i ppf "Variant_inlined\n"
+  | Variant_with_null -> line i ppf "Variant_with_null\n"
 
 let flat_element i ppf flat_element =
   line i ppf "%s\n" (Types.flat_element_to_string flat_element)
diff --git a/typing/typecore.ml b/typing/typecore.ml
index ac078c4bbfa..307a968fd7f 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -551,6 +551,9 @@ let mode_lazy expected_mode =
     (* The thunk is evaluated only once, so we only require it to be [once],
        even if the [lazy] is [many]. *)
     |> Value.join_with (Comonadic Linearity) Linearity.Const.Once
+    (* The thunk is evaluated only when the [lazy] is [uncontended], so we only require it
+       to be [nonportable], even if the [lazy] is [portable]. *)
+    |> Value.join_with (Comonadic Portability) Portability.Const.Nonportable
   in
   {expected_mode with locality_context = Some Lazy }, closure_mode
 
@@ -3011,7 +3014,7 @@ and type_pat_aux
   | Ppat_record(lid_sp_list, closed) ->
       type_record_pat Legacy lid_sp_list closed
   | Ppat_record_unboxed_product(lid_sp_list, closed) ->
-      Language_extension.assert_enabled ~loc Layouts Language_extension.Beta;
+      Language_extension.assert_enabled ~loc Layouts Language_extension.Stable;
       type_record_pat Unboxed_product lid_sp_list closed
   | Ppat_array (mut, spl) ->
       let mut =
@@ -5417,7 +5420,9 @@ and type_expect_
             (rep : rep) =
         match record_form with
         | Legacy -> begin match rep with
-          | Record_unboxed | Record_inlined (_, _, Variant_unboxed) -> false
+          | Record_unboxed
+          | Record_inlined (_, _, (Variant_unboxed | Variant_with_null))
+            -> false
           | Record_boxed _ | Record_float | Record_ufloat | Record_mixed _
           | Record_inlined (_, _, (Variant_boxed _ | Variant_extensible))
             -> true
@@ -6001,7 +6006,7 @@ and type_expect_
   | Pexp_record(lid_sexp_list, opt_sexp) ->
       type_expect_record ~overwrite Legacy lid_sexp_list opt_sexp
   | Pexp_record_unboxed_product(lid_sexp_list, opt_sexp) ->
-      Language_extension.assert_enabled ~loc Layouts Language_extension.Beta;
+      Language_extension.assert_enabled ~loc Layouts Language_extension.Stable;
       type_expect_record ~overwrite Unboxed_product lid_sexp_list opt_sexp
   | Pexp_field(srecord, lid) ->
       let (record, rmode, label, _) =
@@ -6053,7 +6058,7 @@ and type_expect_
         exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_unboxed_field(srecord, lid) ->
-      Language_extension.assert_enabled ~loc Layouts Language_extension.Beta;
+      Language_extension.assert_enabled ~loc Layouts Language_extension.Stable;
       let (record, rmode, label, _) =
         type_label_access Unboxed_product env srecord Env.Projection lid
       in
@@ -8416,7 +8421,7 @@ and type_construct ~overwrite env (expected_mode : expected_mode) loc lid sarg
   in
   let (argument_mode, alloc_mode) =
     match constr.cstr_repr with
-    | Variant_unboxed -> expected_mode, None
+    | Variant_unboxed | Variant_with_null -> expected_mode, None
     | Variant_boxed _ when constr.cstr_constant -> expected_mode, None
     | Variant_boxed _ | Variant_extensible ->
        let alloc_mode, argument_mode = register_allocation expected_mode in
@@ -8453,6 +8458,8 @@ and type_construct ~overwrite env (expected_mode : expected_mode) loc lid sarg
         raise(Error(loc, env, Private_constructor (constr, ty_res)))
     | Variant_boxed _ | Variant_unboxed ->
         raise (Error(loc, env, Private_type ty_res));
+    | Variant_with_null -> assert false
+      (* [Variant_with_null] can't be made private due to [or_null_reexport]. *)
     end;
   (* NOTE: shouldn't we call "re" on this final expression? -- AF *)
   { texp with
@@ -10811,6 +10818,7 @@ let report_error ~loc env = function
         | Error (Monadic Contention, _ ) ->
           contention_hint fail_reason submode_reason contention_context
         | Error (Comonadic Portability, _ ) -> []
+        | Error (Comonadic Yielding, _) -> []
       in
       Location.errorf ~loc ~sub "@[%t@]" begin
         match fail_reason with
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 72b12a3d787..9f50bca7dc4 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -89,6 +89,7 @@ type error =
   | Unboxed_mutable_label
   | Recursive_abbrev of string * Env.t * reaching_type_path
   | Cycle_in_def of string * Env.t * reaching_type_path
+  | Unboxed_recursion of string * Env.t * reaching_type_path
   | Definition_mismatch of type_expr * Env.t * Includecore.type_mismatch option
   | Constraint_failed of Env.t * Errortrace.unification_error
   | Inconsistent_constraint of Env.t * Errortrace.unification_error
@@ -933,7 +934,7 @@ let transl_declaration env sdecl (id, uid) =
           Ttype_record lbls, Type_record(lbls', rep), jkind
       | Ptype_record_unboxed_product lbls ->
           Language_extension.assert_enabled ~loc:sdecl.ptype_loc Layouts
-            Language_extension.Beta;
+            Language_extension.Stable;
           let lbls, lbls' =
             transl_labels ~record_form:Unboxed_product ~new_var_jkind:Any
               ~allow_unboxed:true env None true lbls Record_unboxed_product
@@ -1664,6 +1665,11 @@ let update_decl_jkind env dpath decl =
   let update_variant_kind cstrs rep =
     (* CR layouts: factor out duplication *)
     match cstrs, rep with
+    | _, Variant_with_null ->
+      (* CR layouts v3.5: this case only happens with [or_null_reexport].
+         Change when we allow users to write their own null constructors. *)
+      (* CR layouts v3.3: use [any_non_null]. *)
+      cstrs, rep, Jkind.Builtin.value_or_null ~why:(Primitive Predef.ident_or_null)
     | [{Types.cd_args} as cstr], Variant_unboxed -> begin
         match cd_args with
         | Cstr_tuple [{ca_type=ty; _} as arg] -> begin
@@ -1738,8 +1744,7 @@ let update_decl_jkind env dpath decl =
                   type_jkind;
                   type_has_illegal_crossings },
       type_jkind
-    (* CR layouts v3.0: handle this case in [update_variant_jkind] when
-       [Variant_with_null] introduced.
+    (* CR layouts v3.0: remove this once [or_null] is [Variant_with_null].
 
        No updating required for [or_null_reexport], and we must not
        incorrectly override the jkind to [non_null].
@@ -2061,6 +2066,110 @@ let check_well_founded_decl  ~abs_env env loc path decl to_check =
        end)} in
   it.it_type_declaration it (Ctype.generic_instance_declaration decl)
 
+(* We only allow recursion in unboxed product types to occur through boxes,
+   otherwise the type is uninhabitable and usually also infinite-size.
+   See [typing-layouts-unboxed-records/recursive.ml].
+
+   Because [check_well_founded] already ruled out recursion through structural
+   types, we just look for a cycle in nominal unboxed types ([@@unboxed] types
+   and unboxed records), tracking the set of seen paths.
+
+   For each group of mutually recursive type declarations, we define the
+   following "type contains" transitive relation on type expressions:
+
+   1. Unboxed records and variants defined in the group contain their fields.
+
+      If [type 'a t = #{ ...; lbl : u;  ... }],
+      or [type 'a t = { lbl : u } [@@unboxed]],
+      or [type 'a t = U of u [@@unboxed]]
+      is in the recursive group, then ['a t] contains [u].
+
+   2. Abbreviations defined in the group contain their expansions.
+
+      If [type 'a t = u] is in the recursive group then ['a t] contains [u].
+
+   3. Unboxed tuples contain their components.
+
+      [#(u_1 * ...)] contains all [u_i].
+
+   4. Types not in the group contain the parameters indicated by their layout.
+
+      ['a t] contains ['a] if [layout_of 'a] or [any] occurs in ['a t]'s layout.
+
+      For example, if [('a, 'b) t] has layout [layout_of 'a], it may contain
+      ['a], but not ['b]. If it has layout [any], we must conservatively
+      consider it to contain both ['a] and ['b].
+
+      Note: We don't yet have [layout_of], so currently only consider [any].
+
+   If a path starting from the type expression on the LHS of a declaration
+   contains two types with the same head type constructor, and that repeated
+   type is an unboxed record or variant, then the check raises a type error.
+
+   CR layouts v7.2: accept safe types that expand the same path multiple times,
+   e.g. [type 'a t = #{ a : 'a } and x = int t t], either by using layouts
+   variables or the algorithm from "Unboxed data constructors - or, how cpp
+   decides a halting problem."
+   See https://github.com/ocaml-flambda/flambda-backend/pull/3407.
+*)
+type step_result =
+  | Contained of type_expr list
+  | Expanded_to of type_expr
+  | Is_cyclic
+let check_unboxed_recursion ~abs_env env loc path0 ty0 to_check =
+  let contained_parameters tyl layout =
+    (* A type whose layout has [any] could contain all its parameters.
+       CR layouts v11: update this function for [layout_of] layouts. *)
+    let rec has_any : Jkind_types.Layout.Const.t -> bool = function
+      | Any -> true
+      | Base _ -> false
+      | Product l -> List.exists has_any l
+    in
+    if has_any layout then tyl else []
+  in
+  let step_once parents ty =
+    match get_desc ty with
+    | Tconstr (path, tyl, _) ->
+      if to_check path then
+        if Path.Set.mem path parents then
+          Is_cyclic, parents
+        else
+          let parents = Path.Set.add path parents in
+          match Ctype.try_expand_safe_opt env ty with
+          | ty' ->
+            Expanded_to ty', parents
+          | exception Ctype.Cannot_expand ->
+            Contained (Ctype.contained_without_boxing env ty), parents
+      else
+        begin try
+          (* Determine contained types by layout for decls outside of the
+             recursive group *)
+          let jkind = (Env.find_type path env).type_jkind in
+          let layout = Option.get (Jkind.get_layout jkind) in
+          Contained (contained_parameters tyl layout), parents
+        with Not_found | Invalid_argument _ ->
+          (* Because [to_check path] is false, this decl has already been
+            typechecked, so it's already in [env] with a constant layout. *)
+          Misc.fatal_error "Typedecl.check_unboxed_recursion"
+        end
+    | _ -> Contained (Ctype.contained_without_boxing env ty), parents
+  in
+  let rec visit parents trace ty =
+    match step_once parents ty with
+    | Contained tys, parents ->
+      List.iter (fun ty' -> visit parents (Contains (ty, ty') :: trace) ty') tys
+    | Expanded_to ty', parents ->
+      visit parents (Expands_to(ty,ty') :: trace) ty'
+    | Is_cyclic, _ ->
+      raise (Error (loc, Unboxed_recursion (path0, abs_env, List.rev trace)))
+  in
+  Ctype.wrap_trace_gadt_instances env (visit Path.Set.empty []) ty0
+
+let check_unboxed_recursion_decl ~abs_env env loc path decl to_check =
+  let decl = Ctype.generic_instance_declaration decl in
+  let ty = Btype.newgenty (Tconstr (path, decl.type_params, ref Mnil)) in
+  check_unboxed_recursion ~abs_env env loc (Path.name path) ty to_check
+
 (* Check for non-regular abbreviations; an abbreviation
    [type 'a t = ...] is non-regular if the expansion of [...]
    contains instances [ty t] where [ty] is not equal to ['a].
@@ -2349,6 +2458,11 @@ let transl_type_decl env rec_flag sdecl_list =
     decls;
   List.iter (fun (tdecl, _shape) ->
     check_abbrev_regularity ~abs_env new_env id_loc_list to_check tdecl) tdecls;
+  List.iter (fun (id, decl) ->
+    check_unboxed_recursion_decl ~abs_env new_env (List.assoc id id_loc_list)
+      (Path.Pident id)
+      decl to_check)
+    decls;
   (* Now that we've ruled out ill-formed types, we can perform the delayed
      jkind checks *)
   List.iter (fun (checks,loc) ->
@@ -3434,6 +3548,7 @@ let check_recmod_typedecl env loc recmod_ids path decl =
      (path, decl) is the type declaration to be checked. *)
   let to_check path = Path.exists_free recmod_ids path in
   check_well_founded_decl ~abs_env:env env loc path decl to_check;
+  check_unboxed_recursion_decl ~abs_env:env env loc path decl to_check;
   check_regularity ~abs_env:env env loc path decl to_check;
   (* additional coherence check, as one might build an incoherent signature,
      and use it to build an incoherent module, cf. #7851 *)
@@ -3488,8 +3603,10 @@ module Reaching_path = struct
 
   (* Simplify a reaching path before showing it in error messages. *)
   let simplify path =
+    let is_tconstr ty = match get_desc ty with Tconstr _ -> true | _ -> false in
     let rec simplify : t -> t = function
-      | Contains (ty1, _ty2) :: Contains (_ty2', ty3) :: rest ->
+      | Contains (ty1, _ty2) :: Contains (ty2', ty3) :: rest
+        when not (is_tconstr ty2') ->
           (* If t1 contains t2 and t2 contains t3, then t1 contains t3
              and we don't need to show t2. *)
           simplify (Contains (ty1, ty3) :: rest)
@@ -3577,6 +3694,14 @@ let report_error ppf = function
       fprintf ppf "@[<v>The definition of %a contains a cycle%a@]"
         Style.inline_code s
         Reaching_path.pp_colon reaching_path
+  | Unboxed_recursion (s, env, reaching_path) ->
+      let reaching_path = Reaching_path.simplify reaching_path in
+      Printtyp.wrap_printing_env ~error:true env @@ fun () ->
+      Printtyp.reset ();
+      Reaching_path.add_to_preparation reaching_path;
+      fprintf ppf "@[<v>The definition of %a is recursive without boxing%a@]"
+        Style.inline_code s
+        Reaching_path.pp_colon reaching_path
   | Definition_mismatch (ty, _env, None) ->
       fprintf ppf "@[<v>@[<hov>%s@ %s@;<1 2>%a@]@]"
         "This variant or record definition" "does not match that of type"
diff --git a/typing/typedecl.mli b/typing/typedecl.mli
index 13693ebd5a7..1a1555a9d1a 100644
--- a/typing/typedecl.mli
+++ b/typing/typedecl.mli
@@ -125,6 +125,7 @@ type error =
   | Unboxed_mutable_label
   | Recursive_abbrev of string * Env.t * reaching_type_path
   | Cycle_in_def of string * Env.t * reaching_type_path
+  | Unboxed_recursion of string * Env.t * reaching_type_path
   | Definition_mismatch of type_expr * Env.t * Includecore.type_mismatch option
   | Constraint_failed of Env.t * Errortrace.unification_error
   | Inconsistent_constraint of Env.t * Errortrace.unification_error
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index c78b97000c9..41e1c042633 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -1124,6 +1124,11 @@ let iter_pattern_full ~of_sort ~of_const_sort ~both_sides_of_or f sort pat =
           let sorts =
             match cstr.cstr_repr with
             | Variant_unboxed -> [ sort ]
+            (* CR layouts v3.5: this hardcodes ['a or_null]. Fix when we allow
+               users to write their own null constructors. *)
+            | Variant_with_null when cstr.cstr_constant -> []
+            (* CR layouts v3.3: allow all sorts. *)
+            | Variant_with_null -> [ value ]
             | Variant_boxed _ | Variant_extensible ->
               (List.map (fun { ca_sort } -> of_const_sort ca_sort )
                  cstr.cstr_args)
diff --git a/typing/typemode.ml b/typing/typemode.ml
index 8cbd18650c7..474f7e524df 100644
--- a/typing/typemode.ml
+++ b/typing/typemode.ml
@@ -51,6 +51,8 @@ module Axis_pair = struct
     | "external64" ->
       Any_axis_pair (Nonmodal Externality, Externality.External64)
     | "external_" -> Any_axis_pair (Nonmodal Externality, Externality.External)
+    | "yielding" -> Any_axis_pair (Modal Yielding, Yielding.Const.Yielding)
+    | "unyielding" -> Any_axis_pair (Modal Yielding, Yielding.Const.Unyielding)
     | _ -> raise Not_found
 end
 
@@ -116,7 +118,8 @@ let transl_mode_annots annots : Alloc.Const.Option.t =
     linearity = modes.linearity;
     uniqueness = modes.uniqueness;
     portability = modes.portability;
-    contention = modes.contention
+    contention = modes.contention;
+    yielding = modes.yielding
   }
 
 let untransl_mode_annots ~loc (modes : Mode.Alloc.Const.Option.t) =
@@ -134,9 +137,10 @@ let untransl_mode_annots ~loc (modes : Mode.Alloc.Const.Option.t) =
   let contention =
     print_to_string_opt Mode.Contention.Const.print modes.contention
   in
+  let yielding = print_to_string_opt Mode.Yielding.Const.print modes.yielding in
   List.filter_map
     (fun x -> Option.map (fun s -> { txt = Parsetree.Mode s; loc }) x)
-    [areality; uniqueness; linearity; portability; contention]
+    [areality; uniqueness; linearity; portability; contention; yielding]
 
 let transl_modality ~maturity { txt = Parsetree.Modality modality; loc } =
   let axis_pair =
@@ -155,6 +159,8 @@ let transl_modality ~maturity { txt = Parsetree.Modality modality; loc } =
     Modality.Atom (Comonadic Portability, Meet_with mode)
   | Modal_axis_pair (Contention, mode) ->
     Modality.Atom (Monadic Contention, Join_with mode)
+  | Modal_axis_pair (Yielding, mode) ->
+    Modality.Atom (Comonadic Yielding, Meet_with mode)
 
 let untransl_modality (a : Modality.t) : Parsetree.modality loc =
   let s =
@@ -174,6 +180,9 @@ let untransl_modality (a : Modality.t) : Parsetree.modality loc =
     | Atom (Monadic Contention, Join_with Contention.Const.Shared) -> "shared"
     | Atom (Monadic Contention, Join_with Contention.Const.Uncontended) ->
       "uncontended"
+    | Atom (Comonadic Yielding, Meet_with Yielding.Const.Yielding) -> "yielding"
+    | Atom (Comonadic Yielding, Meet_with Yielding.Const.Unyielding) ->
+      "unyielding"
     | _ -> failwith "BUG: impossible modality atom"
   in
   { txt = Modality s; loc = Location.none }
@@ -188,7 +197,8 @@ let mutable_implied_modalities (mut : Types.mutability) attrs =
   let comonadic : Modality.t list =
     [ Atom (Comonadic Areality, Meet_with Regionality.Const.legacy);
       Atom (Comonadic Linearity, Meet_with Linearity.Const.legacy);
-      Atom (Comonadic Portability, Meet_with Portability.Const.legacy) ]
+      Atom (Comonadic Portability, Meet_with Portability.Const.legacy);
+      Atom (Comonadic Yielding, Meet_with Yielding.Const.legacy) ]
   in
   let monadic : Modality.t list =
     [ Atom (Monadic Uniqueness, Join_with Uniqueness.Const.legacy);
diff --git a/typing/typeopt.ml b/typing/typeopt.ml
index c20a17830fc..75389569b84 100644
--- a/typing/typeopt.ml
+++ b/typing/typeopt.ml
@@ -560,6 +560,15 @@ and value_kind_variant env ~loc ~visited ~depth ~num_nodes_visited
       (cstrs : Types.constructor_declaration list) rep =
   match rep with
   | Variant_extensible -> assert false
+  | Variant_with_null -> begin
+    match cstrs with
+    | [_; {cd_args=Cstr_tuple [{ca_type=ty}]}] ->
+      let num_nodes_visited, kind =
+        value_kind env ~loc ~visited ~depth ~num_nodes_visited ty
+      in
+      num_nodes_visited + 1, { kind with nullable = Nullable }
+    | _ -> assert false
+    end
   | Variant_unboxed -> begin
       (* CR layouts v1.5: This should only be reachable in the case of a missing
          cmi, according to the comment on scrape_ty.  Reevaluate whether it's
@@ -701,6 +710,7 @@ and value_kind_record env ~loc ~visited ~depth ~num_nodes_visited
         value_kind env ~loc ~visited ~depth ~num_nodes_visited ld_type
       | [] | _ :: _ :: _ -> assert false
     end
+  | Record_inlined (_, _, Variant_with_null) -> assert false
   | Record_inlined (_, _, (Variant_boxed _ | Variant_extensible))
   | Record_boxed _ | Record_float | Record_ufloat | Record_mixed _ -> begin
       let is_mutable =
@@ -780,6 +790,7 @@ and value_kind_record env ~loc ~visited ~depth ~num_nodes_visited
           | Record_mixed _ ->
             [0, fields]
           | Record_unboxed -> assert false
+          | Record_inlined (Null, _, _) -> assert false
         in
         (num_nodes_visited, mk_nn (Pvariant { consts = []; non_consts }))
     end
diff --git a/typing/types.ml b/typing/types.ml
index a745ae47150..b9f363f2cc0 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -286,6 +286,7 @@ and ('lbl, 'lbl_flat, 'cstr) type_kind =
 and tag = Ordinary of {src_index: int;     (* Unique name (per type) *)
                        runtime_tag: int}   (* The runtime tag *)
         | Extension of Path.t
+        | Null
 
 and type_origin =
     Definition
@@ -324,6 +325,7 @@ and variant_representation =
   | Variant_boxed of (constructor_representation *
                       Jkind_types.Sort.Const.t array) array
   | Variant_extensible
+  | Variant_with_null
 
 and constructor_representation =
   | Constructor_uniform_value
@@ -606,15 +608,19 @@ let equal_tag t1 t2 =
   | Ordinary {src_index=i1}, Ordinary {src_index=i2} ->
     i2 = i1 (* If i1 = i2, the runtime_tags will also be equal *)
   | Extension path1, Extension path2 -> Path.same path1 path2
-  | (Ordinary _ | Extension _), _ -> false
+  | Null, Null -> true
+  | (Ordinary _ | Extension _ | Null), _ -> false
 
 let compare_tag t1 t2 =
   match (t1, t2) with
   | Ordinary {src_index=i1}, Ordinary {src_index=i2} ->
     Int.compare i1 i2
   | Extension path1, Extension path2 -> Path.compare path1 path2
-  | Ordinary _, Extension _ -> -1
-  | Extension _, Ordinary _ -> 1
+  | Null, Null -> 0
+  | Ordinary _, (Extension _ | Null) -> -1
+  | (Extension _ | Null), Ordinary _ -> 1
+  | Extension _, Null -> -1
+  | Null, Extension _ -> 1
 
 let equal_flat_element e1 e2 =
   match e1, e2 with
@@ -669,7 +675,8 @@ let equal_variant_representation r1 r2 = r1 == r2 || match r1, r2 with
         cstrs_and_sorts2
   | Variant_extensible, Variant_extensible ->
       true
-  | (Variant_unboxed | Variant_boxed _ | Variant_extensible), _ ->
+  | Variant_with_null, Variant_with_null -> true
+  | (Variant_unboxed | Variant_boxed _ | Variant_extensible | Variant_with_null), _ ->
       false
 
 let equal_record_representation r1 r2 = match r1, r2 with
@@ -745,15 +752,14 @@ let find_unboxed_type decl =
   | Type_record_unboxed_product
                 ([{ld_type = arg; _}], Record_unboxed_product)
   | Type_variant ([{cd_args = Cstr_tuple [{ca_type = arg; _}]; _}], Variant_unboxed)
-  | Type_variant ([{cd_args = Cstr_record [{ld_type = arg; _}]; _}],
-                  Variant_unboxed) ->
+  | Type_variant ([{cd_args = Cstr_record [{ld_type = arg; _}]; _}], Variant_unboxed) ->
     Some arg
   | Type_record (_, ( Record_inlined _ | Record_unboxed
                     | Record_boxed _ | Record_float | Record_ufloat
                     | Record_mixed _))
   | Type_record_unboxed_product (_, Record_unboxed_product)
   | Type_variant (_, ( Variant_boxed _ | Variant_unboxed
-                     | Variant_extensible ))
+                     | Variant_extensible | Variant_with_null))
   | Type_abstract _ | Type_open ->
     None
 
diff --git a/typing/types.mli b/typing/types.mli
index c8613d7e262..f74484bdf87 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -570,6 +570,7 @@ and ('lbl, 'lbl_flat, 'cstr) type_kind =
 and tag = Ordinary of {src_index: int;  (* Unique name (per type) *)
                        runtime_tag: int}    (* The runtime tag *)
         | Extension of Path.t
+        | Null (* Null pointer *)
 
 (* A mixed product contains a possibly-empty prefix of values followed by a
    non-empty suffix of "flat" elements. Intuitively, a flat element is one that
@@ -634,6 +635,11 @@ and variant_representation =
      [Constructor_mixed] if the inlined record has any unboxed fields.
   *)
   | Variant_extensible
+  | Variant_with_null
+  (* CR layouts v3.5: A custom variant representation for ['a or_null].
+     Eventually, it should likely be merged into [Variant_unboxed], with
+     [Variant_unboxed] allowing either one ordinary constructor, or one
+     ordinary non-null and one [Null] constructor. *)
 
 and constructor_representation =
   | Constructor_uniform_value
diff --git a/typing/value_rec_check.ml b/typing/value_rec_check.ml
index 6b76def1e0a..bb09b38b606 100644
--- a/typing/value_rec_check.ml
+++ b/typing/value_rec_check.ml
@@ -735,7 +735,7 @@ let rec expression : Typedtree.expression -> term_judg =
         | _ -> empty
       in
       let arg_mode i = match desc.cstr_repr with
-        | Variant_unboxed ->
+        | Variant_unboxed | Variant_with_null ->
           Return
         | Variant_boxed _ | Variant_extensible ->
            (match desc.cstr_shape with
diff --git a/utils/doubly_linked_list.ml b/utils/doubly_linked_list.ml
index b4a1f7c37ca..7f6efc2ebd7 100644
--- a/utils/doubly_linked_list.ml
+++ b/utils/doubly_linked_list.ml
@@ -333,12 +333,20 @@ let exists t ~f =
   aux t f t.first
 
 let for_all t ~f =
-  let rec aux t f curr =
+  let rec aux f curr =
     match curr with
     | Empty -> true
-    | Node node -> if f node.value then aux t f node.next else false
+    | Node node -> if f node.value then aux f node.next else false
   in
-  aux t f t.first
+  aux f t.first
+
+let for_alli t ~f =
+  let rec aux f i curr =
+    match curr with
+    | Empty -> true
+    | Node node -> if f i node.value then aux f (i + 1) node.next else false
+  in
+  aux f 0 t.first
 
 let to_list t = fold_right t ~f:(fun hd tl -> hd :: tl) ~init:[]
 
diff --git a/utils/doubly_linked_list.mli b/utils/doubly_linked_list.mli
index a2f406aff4b..32d572f7a73 100644
--- a/utils/doubly_linked_list.mli
+++ b/utils/doubly_linked_list.mli
@@ -78,6 +78,8 @@ val exists : 'a t -> f:('a -> bool) -> bool
 
 val for_all : 'a t -> f:('a -> bool) -> bool
 
+val for_alli : 'a t -> f:(int -> 'a -> bool) -> bool
+
 val to_list : 'a t -> 'a list
 
 (* Adds all of the elements of `from` to `to_`, and clears `from`. *)
diff --git a/utils/warnings.ml b/utils/warnings.ml
index a5580a86ed7..cd13e4cd3ee 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -129,6 +129,7 @@ type t =
   | Unchecked_zero_alloc_attribute          (* 199 *)
   | Unboxing_impossible                     (* 210 *)
   | Mod_by_top of string                    (* 211 *)
+  | Unnecessary_allow_any_kind              (* 212 *)
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
    the numbers of existing warnings.
@@ -217,6 +218,7 @@ let number = function
   | Unchecked_zero_alloc_attribute -> 199
   | Unboxing_impossible -> 210
   | Mod_by_top _ -> 211
+  | Unnecessary_allow_any_kind -> 212
 ;;
 (* DO NOT REMOVE the ;; above: it is used by
    the testsuite/ests/warnings/mnemonics.mll test to determine where
@@ -592,6 +594,11 @@ let descriptions = [
     names = ["mod-by-top"];
     description = "Including the top-most element of an axis in a kind's modifiers is a no-op.";
     since = since 4 14 };
+  { number = 212;
+    names = ["unnecessary-allow-any-kind"];
+    description = "[@@unsafe_allow_any_kind_in_{impl,intf}] attributes included \
+                   on a type and a signature with matching kinds";
+    since = since 5 1 };
 ]
 
 let name_to_number =
@@ -1235,6 +1242,10 @@ let message = function
         "%s is the top-most modifier.\n\
          Modifying by a top element is a no-op."
         modifier
+  | Unnecessary_allow_any_kind ->
+    Printf.sprintf
+      "[@@allow_any_kind_in_intf] and [@@allow_any_kind_in_impl] set on a \n\
+       type, but the kind matches. The attributes can be removed."
 ;;
 
 let nerrors = ref 0
diff --git a/utils/warnings.mli b/utils/warnings.mli
index d925ffce77d..e7c7da9d588 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -135,6 +135,7 @@ type t =
   | Unchecked_zero_alloc_attribute          (* 199 *)
   | Unboxing_impossible                     (* 210 *)
   | Mod_by_top of string                    (* 211 *)
+  | Unnecessary_allow_any_kind              (* 212 *)
 
 type alert = {kind:string; message:string; def:loc; use:loc}