diff --git a/backend/cmmgen.ml b/backend/cmmgen.ml
index d227d569b12..f30f30fa02a 100644
--- a/backend/cmmgen.ml
+++ b/backend/cmmgen.ml
@@ -156,8 +156,9 @@ type rhs_kind =
 let rec expr_size env = function
   | Uvar id ->
       begin try V.find_same id env with Not_found -> RHS_nonrec end
-  | Uclosure(fundecls, clos_vars) ->
-      RHS_block (fundecls_size fundecls + List.length clos_vars)
+  | Uclosure { functions ; not_scanned_slots ; scanned_slots } ->
+      RHS_block (fundecls_size functions + List.length not_scanned_slots
+        + List.length scanned_slots)
   | Ulet(_str, _kind, id, exp, body) ->
       expr_size (V.add (VP.var id) (expr_size env exp) env) body
   | Uletrec(bindings, body) ->
@@ -426,18 +427,18 @@ let rec transl env e =
       end
   | Uconst sc ->
       transl_constant Debuginfo.none sc
-  | Uclosure(fundecls, []) ->
+  | Uclosure { functions ; not_scanned_slots = [] ; scanned_slots = [] } ->
       let sym = Compilenv.new_const_symbol() in
-      Cmmgen_state.add_constant sym (Const_closure (Local, fundecls, []));
-      List.iter (fun f -> Cmmgen_state.add_function f) fundecls;
+      Cmmgen_state.add_constant sym (Const_closure (Local, functions, []));
+      List.iter (fun f -> Cmmgen_state.add_function f) functions;
       let dbg =
-        match fundecls with
+        match functions with
         | [] -> Debuginfo.none
         | fundecl::_ -> fundecl.dbg
       in
       Cconst_symbol (sym, dbg)
-  | Uclosure(fundecls, clos_vars) ->
-      let startenv = fundecls_size fundecls in
+  | Uclosure { functions ; not_scanned_slots ; scanned_slots } ->
+      let startenv = fundecls_size functions + List.length not_scanned_slots in
       let mode =
         Option.get @@
         List.fold_left (fun s { mode; dbg; _ } ->
@@ -447,10 +448,10 @@ let rec transl env e =
              if not (Lambda.eq_mode mode m') then
                Misc.fatal_errorf "Inconsistent modes in let rec at %s"
                  (Debuginfo.to_string dbg);
-             s) None fundecls in
+             s) None functions in
       let rec transl_fundecls pos = function
           [] ->
-            List.map (transl env) clos_vars
+            List.map (transl env) (not_scanned_slots @ scanned_slots)
         | f :: rem ->
             let is_last = match rem with [] -> true | _::_ -> false in
             Cmmgen_state.add_function f;
@@ -474,11 +475,11 @@ let rec transl env e =
             else alloc_infix_header pos f.dbg :: without_header
       in
       let dbg =
-        match fundecls with
+        match functions with
         | [] -> Debuginfo.none
         | fundecl::_ -> fundecl.dbg
       in
-      make_alloc ~mode dbg Obj.closure_tag (transl_fundecls 0 fundecls)
+      make_alloc ~mode dbg Obj.closure_tag (transl_fundecls 0 functions)
   | Uoffset(arg, offset) ->
       (* produces a valid Caml value, pointing just after an infix header *)
       let ptr = transl env arg in
diff --git a/middle_end/clambda.ml b/middle_end/clambda.ml
index 70d719de6b7..5f0414079ae 100644
--- a/middle_end/clambda.ml
+++ b/middle_end/clambda.ml
@@ -52,7 +52,11 @@ and ulambda =
       function_label * ulambda list * Lambda.probe * apply_kind * Debuginfo.t
   | Ugeneric_apply of
       ulambda * ulambda list * apply_kind * Debuginfo.t
-  | Uclosure of ufunction list * ulambda list
+  | Uclosure of {
+      functions : ufunction list ;
+      not_scanned_slots : ulambda list ;
+      scanned_slots : ulambda list ;
+    }
   | Uoffset of ulambda * int
   | Ulet of mutable_flag * value_kind * Backend_var.With_provenance.t
       * ulambda * ulambda
diff --git a/middle_end/clambda.mli b/middle_end/clambda.mli
index 35254c1617e..f8ac77dde51 100644
--- a/middle_end/clambda.mli
+++ b/middle_end/clambda.mli
@@ -63,7 +63,11 @@ and ulambda =
       function_label * ulambda list * Lambda.probe * apply_kind * Debuginfo.t
   | Ugeneric_apply of
       ulambda * ulambda list * apply_kind * Debuginfo.t
-  | Uclosure of ufunction list * ulambda list
+  | Uclosure of {
+      functions : ufunction list ;
+      not_scanned_slots : ulambda list ;
+      scanned_slots : ulambda list
+    }
   | Uoffset of ulambda * int
   | Ulet of mutable_flag * value_kind * Backend_var.With_provenance.t
       * ulambda * ulambda
diff --git a/middle_end/closure/closure.ml b/middle_end/closure/closure.ml
index df91f57981e..917f557ed2b 100644
--- a/middle_end/closure/closure.ml
+++ b/middle_end/closure/closure.ml
@@ -50,12 +50,20 @@ let rec split_list n l =
     | a::l -> let (l1, l2) = split_list (n-1) l in (a::l1, l2)
   end
 
-let rec build_closure_env env_param pos = function
-    [] -> V.Map.empty
+let rec add_to_closure_env env_param pos cenv = function
+    [] -> cenv
   | id :: rem ->
       V.Map.add id
         (Uprim(P.Pfield pos, [Uvar env_param], Debuginfo.none))
-          (build_closure_env env_param (pos+1) rem)
+          (add_to_closure_env env_param (pos+1) cenv rem)
+
+let is_gc_ignorable kind =
+  match kind with
+  | Pintval -> true
+  | Pgenval | Pfloatval | Pboxedintval _ | Pvariant _ | Parrayval _ -> false
+
+let split_closure_fv kinds fv =
+  List.partition (fun id -> is_gc_ignorable (V.Map.find id kinds)) fv
 
 (* Auxiliary for accessing globals.  We change the name of the global
    to the name of the corresponding asm symbol.  This is done here
@@ -99,7 +107,8 @@ let occurs_var var u =
     | Udirect_apply(_lbl, args, _, _, _) -> List.exists occurs args
     | Ugeneric_apply(funct, args, _, _) ->
         occurs funct || List.exists occurs args
-    | Uclosure(_fundecls, clos) -> List.exists occurs clos
+    | Uclosure { functions = _ ; not_scanned_slots ; scanned_slots } ->
+      List.exists occurs not_scanned_slots || List.exists occurs scanned_slots
     | Uoffset(u, _ofs) -> occurs u
     | Ulet(_str, _kind, _id, def, body) -> occurs def || occurs body
     | Uphantom_let _ -> no_phantom_lets ()
@@ -604,7 +613,7 @@ let rec substitute loc ((backend, fpc) as st) sb rn ulam =
       let dbg = subst_debuginfo loc dbg in
       Ugeneric_apply(substitute loc st sb rn fn,
                      List.map (substitute loc st sb rn) args, kind, dbg)
-  | Uclosure(defs, env) ->
+  | Uclosure { functions ; not_scanned_slots ; scanned_slots } ->
       (* Question: should we rename function labels as well?  Otherwise,
          there is a risk that function labels are not globally unique.
          This should not happen in the current system because:
@@ -613,7 +622,12 @@ let rec substitute loc ((backend, fpc) as st) sb rn ulam =
          - When we substitute offsets for idents bound by let rec
            in [close], case [Lletrec], we discard the original
            let rec body and use only the substituted term. *)
-      Uclosure(defs, List.map (substitute loc st sb rn) env)
+      let subst = substitute loc st sb rn in
+      Uclosure {
+        functions ;
+        not_scanned_slots = List.map subst not_scanned_slots ;
+        scanned_slots = List.map subst scanned_slots
+      }
   | Uoffset(u, ofs) -> Uoffset(substitute loc st sb rn u, ofs)
   | Ulet(str, kind, id, u1, u2) ->
       let id' = VP.rename id in
@@ -754,6 +768,7 @@ type env = {
   cenv : ulambda V.Map.t;
   fenv : value_approximation V.Map.t;
   mutable_vars : V.Set.t;
+  kinds: value_kind V.Map.t;
 }
 
 (* Perform an inline expansion:
@@ -960,7 +975,7 @@ let close_approx_var { fenv; cenv } id =
 let close_var env id =
   let (ulam, _app) = close_approx_var env id in ulam
 
-let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
+let rec close ({ backend; fenv; cenv ; mutable_vars; kinds } as env) lam =
   let module B = (val backend : Backend_intf.S) in
   match lam with
   | Lvar id ->
@@ -1037,6 +1052,11 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
           when nargs < nparams ->
         let first_args = List.map (fun arg ->
           (V.create_local "arg", arg) ) uargs in
+        (* CR mshinwell: Edit when Lapply has kinds *)
+        let kinds =
+          List.fold_left (fun kinds (arg, _) -> V.Map.add arg Pgenval kinds)
+            kinds first_args
+        in
         let final_args =
           Array.to_list (Array.init (nparams - nargs)
                                     (fun _ -> V.create_local "arg")) in
@@ -1053,6 +1073,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
         in
         let funct_var = V.create_local "funct" in
         let fenv = V.Map.add funct_var fapprox fenv in
+        let kinds = V.Map.add funct_var Pgenval kinds in
         let new_clos_mode, kind =
           (* If the closure has a local suffix, and we've supplied
              enough args to hit it, then the closure must be local
@@ -1067,7 +1088,8 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
         in
         if is_local_mode clos_mode then assert (is_local_mode new_clos_mode);
         let ret_mode = if fundesc.fun_region then alloc_heap else alloc_local in
-        let (new_fun, approx) = close { backend; fenv; cenv; mutable_vars }
+        let (new_fun, approx) =
+          close { backend; fenv; cenv; mutable_vars; kinds }
           (lfunction
                ~kind
                ~return:Pgenval
@@ -1100,6 +1122,11 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
                                 _approx_res)), uargs)
         when nargs > nparams ->
           let args = List.map (fun arg -> V.create_local "arg", arg) uargs in
+          (* CR mshinwell: Edit when Lapply has kinds *)
+          let kinds =
+            List.fold_left (fun kinds (var, _) -> V.Map.add var Pgenval kinds)
+              kinds args
+          in
           let (first_args, rem_args) = split_list nparams args in
           let first_args = List.map (fun (id, _) -> Uvar id) first_args in
           let rem_args = List.map (fun (id, _) -> Uvar id) rem_args in
@@ -1108,7 +1135,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
           fail_if_probe ~probe "Over-application";
           let mode' = if fundesc.fun_region then alloc_heap else alloc_local in
           let body =
-            Ugeneric_apply(direct_apply env ~loc ~attribute
+            Ugeneric_apply(direct_apply { env with kinds } ~loc ~attribute
                               fundesc ufunct first_args
                               Rc_normal mode'
                               ~probe,
@@ -1145,23 +1172,36 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
        Value_unknown)
   | Llet(str, kind, id, lam, body) ->
       let (ulam, alam) = close_named env id lam in
+      let kinds = V.Map.add id kind kinds in
       begin match alam with
       | Value_const _
         when str = Alias || is_pure ulam ->
-          close { backend; fenv = (V.Map.add id alam fenv); cenv; mutable_vars }
+          close {
+              backend;
+              fenv = (V.Map.add id alam fenv);
+              cenv;
+              mutable_vars;
+              kinds
+            }
             body
       | _ ->
           let (ubody, abody) =
             close
-              { backend; fenv = (V.Map.add id alam fenv); cenv; mutable_vars }
+              { backend;
+                fenv = (V.Map.add id alam fenv);
+                cenv;
+                mutable_vars;
+                kinds
+              }
               body
           in
           (Ulet(Immutable, kind, VP.create id, ulam, ubody), abody)
       end
   | Lmutlet(kind, id, lam, body) ->
      let (ulam, _) = close_named env id lam in
+     let kinds = V.Map.add id kind kinds in
      let env = {env with mutable_vars = V.Set.add id env.mutable_vars} in
-     let (ubody, abody) = close env body in
+     let (ubody, abody) = close { env with kinds } body in
      (Ulet(Mutable, kind, VP.create id, ulam, ubody), abody)
   | Lletrec(defs, body) ->
       if List.for_all
@@ -1175,8 +1215,21 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
           List.fold_right
             (fun (id, _pos, approx) fenv -> V.Map.add id approx fenv)
             infos fenv in
+        let kinds_body =
+          List.fold_right
+            (fun (id, _pos, _approx) kinds -> V.Map.add id Pgenval kinds)
+            infos (V.Map.add clos_ident Pgenval kinds)
+        in
         let (ubody, approx) =
-          close { backend; fenv = fenv_body; cenv; mutable_vars } body in
+          close
+            { backend;
+              fenv = fenv_body;
+              cenv;
+              mutable_vars;
+              kinds = kinds_body
+            }
+            body
+        in
         let sb =
           List.fold_right
             (fun (id, pos, _approx) sb ->
@@ -1188,15 +1241,19 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
          approx)
       end else begin
         (* General case: recursive definition of values *)
+        let kinds =
+          List.fold_left (fun kinds (id, _) -> V.Map.add id Pgenval kinds)
+            kinds defs
+        in
         let rec clos_defs = function
           [] -> ([], fenv)
         | (id, lam) :: rem ->
             let (udefs, fenv_body) = clos_defs rem in
-            let (ulam, approx) = close_named env id lam in
+            let (ulam, approx) = close_named { env with kinds } id lam in
             ((VP.create id, ulam) :: udefs, V.Map.add id approx fenv_body) in
         let (udefs, fenv_body) = clos_defs defs in
         let (ubody, approx) =
-          close { backend; fenv = fenv_body; cenv; mutable_vars } body in
+          close { backend; fenv = fenv_body; cenv; mutable_vars; kinds } body in
         (Uletrec(udefs, ubody), approx)
       end
   (* Compile-time constants *)
@@ -1304,12 +1361,17 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
       (Ustaticfail (i, close_list env args), Value_unknown)
   | Lstaticcatch(body, (i, vars), handler, kind) ->
       let (ubody, _) = close env body in
-      let (uhandler, _) = close env handler in
+      let kinds =
+        List.fold_left (fun kinds (var, k) -> V.Map.add var k kinds) kinds vars
+      in
+      let (uhandler, _) = close { env with kinds } handler in
       let vars = List.map (fun (var, k) -> VP.create var, k) vars in
       (Ucatch(i, vars, ubody, uhandler, kind), Value_unknown)
   | Ltrywith(body, id, handler, kind) ->
       let (ubody, _) = close env body in
-      let (uhandler, _) = close env handler in
+      let (uhandler, _) =
+        close { env with kinds = V.Map.add id Pgenval kinds } handler
+      in
       (Utrywith(ubody, VP.create id, uhandler, kind), Value_unknown)
   | Lifthenelse(arg, ifso, ifnot, kind) ->
       begin match close env arg with
@@ -1332,7 +1394,9 @@ let rec close ({ backend; fenv; cenv ; mutable_vars } as env) lam =
   | Lfor {for_id; for_from; for_to; for_dir; for_body} ->
       let (ulo, _) = close env for_from in
       let (uhi, _) = close env for_to in
-      let (ubody, _) = close env for_body in
+      let (ubody, _) =
+        close { env with kinds = V.Map.add for_id Pintval kinds } for_body
+      in
       (Ufor(VP.create for_id, ulo, uhi, for_dir, ubody), Value_unknown)
   | Lassign(id, lam) ->
       let (ulam, _) = close env lam in
@@ -1366,7 +1430,7 @@ and close_named env id = function
 
 (* Build a shared closure for a set of mutually recursive functions *)
 
-and close_functions { backend; fenv; cenv; mutable_vars } fun_defs =
+and close_functions { backend; fenv; cenv; mutable_vars; kinds } fun_defs =
   let fun_defs =
     List.flatten
       (List.map
@@ -1390,6 +1454,8 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs =
   (* Determine the free variables of the functions *)
   let fv =
     V.Set.elements (free_variables (Lletrec(fun_defs, lambda_unit))) in
+  let not_scanned_fv, scanned_fv = split_closure_fv kinds fv in
+  let not_scanned_fv_size = List.length not_scanned_fv in
   (* Build the function descriptors for the functions.
      Initially all functions are assumed not to need their environment
      parameter. *)
@@ -1423,6 +1489,12 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs =
       (fun (id, _params, _return, _body, mode, _attrib, fundesc, _dbg) fenv ->
         V.Map.add id (Value_closure(mode, fundesc, Value_unknown)) fenv)
       uncurried_defs fenv in
+  let kinds_rec =
+    List.fold_right
+      (fun (id, _params, _return, _body, _mode, _attrib, _fundesc, _dbg)
+           kinds ->
+         V.Map.add id Pgenval kinds)
+      uncurried_defs kinds in
   (* Determine the offsets of each function's closure in the shared block *)
   let env_pos = ref (-1) in
   let clos_offsets =
@@ -1441,14 +1513,33 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs =
   let clos_fundef (id, params, return, body, mode, check, fundesc, dbg) env_pos =
     let env_param = V.create_local "env" in
     let cenv_fv =
-      build_closure_env env_param (fv_pos - env_pos) fv in
+      add_to_closure_env env_param
+        (fv_pos - env_pos) V.Map.empty not_scanned_fv
+    in
+    let cenv_fv =
+      add_to_closure_env env_param
+        (fv_pos - env_pos + not_scanned_fv_size) cenv_fv scanned_fv
+    in
     let cenv_body =
       List.fold_right2
         (fun (id, _params, _return, _body, _mode, _attrib, _fundesc, _dbg) pos env ->
           V.Map.add id (Uoffset(Uvar env_param, pos - env_pos)) env)
-        uncurried_defs clos_offsets cenv_fv in
+        uncurried_defs clos_offsets cenv_fv
+    in
+    let kinds_body =
+      List.fold_right
+        (fun (id, kind) kinds -> V.Map.add id kind kinds)
+        params (V.Map.add env_param Pgenval kinds_rec)
+    in
     let (ubody, approx) =
-      close { backend; fenv = fenv_rec; cenv = cenv_body; mutable_vars } body
+      close
+        { backend;
+          fenv = fenv_rec;
+          cenv = cenv_body;
+          mutable_vars;
+          kinds = kinds_body
+        }
+        body
     in
     if !useless_env && occurs_var env_param ubody then raise NotClosed;
     let fun_params =
@@ -1522,9 +1613,14 @@ and close_functions { backend; fenv; cenv; mutable_vars } fun_defs =
   (* Return the Uclosure node and the list of all identifiers defined,
      with offsets and approximations. *)
   let (clos, infos) = List.split clos_info_list in
-  let fv = if !useless_env then [] else fv in
-  (Uclosure(clos,
-            List.map (close_var { backend; fenv; cenv; mutable_vars }) fv),
+  let not_scanned_fv, scanned_fv =
+    if !useless_env then [], [] else not_scanned_fv, scanned_fv in
+  let env = { backend; fenv; cenv; mutable_vars; kinds } in
+  (Uclosure {
+      functions = clos ;
+      not_scanned_slots = List.map (close_var env) not_scanned_fv ;
+      scanned_slots = List.map (close_var env) scanned_fv
+    },
    infos)
 
 (* Same, for one non-recursive function *)
@@ -1615,9 +1711,10 @@ let collect_exported_structured_constants a =
     | Uconst c -> const c
     | Udirect_apply (_, ul, _, _, _) -> List.iter ulam ul
     | Ugeneric_apply (u, ul, _, _) -> ulam u; List.iter ulam ul
-    | Uclosure (fl, ul) ->
-        List.iter (fun f -> ulam f.body) fl;
-        List.iter ulam ul
+    | Uclosure { functions ; not_scanned_slots ; scanned_slots } ->
+        List.iter (fun f -> ulam f.body) functions;
+        List.iter ulam not_scanned_slots;
+        List.iter ulam scanned_slots
     | Uoffset(u, _) -> ulam u
     | Ulet (_str, _kind, _, u1, u2) -> ulam u1; ulam u2
     | Uphantom_let _ -> no_phantom_lets ()
@@ -1663,7 +1760,8 @@ let intro ~backend ~size lam =
   Compilenv.set_global_approx(Value_tuple (alloc_heap, !global_approx));
   let (ulam, _approx) =
     close { backend; fenv = V.Map.empty;
-            cenv = V.Map.empty; mutable_vars = V.Set.empty } lam
+            cenv = V.Map.empty; mutable_vars = V.Set.empty;
+            kinds = V.Map.empty } lam
   in
   let opaque =
     !Clflags.opaque
diff --git a/middle_end/flambda/augment_specialised_args.ml b/middle_end/flambda/augment_specialised_args.ml
index b56b1b274c2..024af89169c 100644
--- a/middle_end/flambda/augment_specialised_args.ml
+++ b/middle_end/flambda/augment_specialised_args.ml
@@ -22,18 +22,19 @@ module B = Inlining_cost.Benefit
 
 module Definition = struct
   type t =
-    | Existing_inner_free_var of Variable.t
-    | Projection_from_existing_specialised_arg of Projection.t
+    | Existing_inner_free_var of Variable.t * Lambda.value_kind
+    | Projection_from_existing_specialised_arg of Projection.t * Lambda.value_kind
 
   include Identifiable.Make (struct
     type nonrec t = t
 
     let compare t1 t2 =
       match t1, t2 with
-      | Existing_inner_free_var var1, Existing_inner_free_var var2 ->
+      | Existing_inner_free_var (var1, _),
+        Existing_inner_free_var (var2, _) ->
         Variable.compare var1 var2
-      | Projection_from_existing_specialised_arg proj1,
-          Projection_from_existing_specialised_arg proj2 ->
+      | Projection_from_existing_specialised_arg (proj1, _),
+        Projection_from_existing_specialised_arg (proj2, _) ->
         Projection.compare proj1 proj2
       | Existing_inner_free_var _, _ -> -1
       | _, Existing_inner_free_var _ -> 1
@@ -45,12 +46,12 @@ module Definition = struct
 
     let print ppf t =
       match t with
-      | Existing_inner_free_var var ->
-        Format.fprintf ppf "Existing_inner_free_var %a"
-          Variable.print var
-      | Projection_from_existing_specialised_arg projection ->
-        Format.fprintf ppf "Projection_from_existing_specialised_arg %a"
-          Projection.print projection
+      | Existing_inner_free_var (var, kind) ->
+        Format.fprintf ppf "Existing_inner_free_var (%a, %a)"
+          Variable.print var Printlambda.value_kind kind
+      | Projection_from_existing_specialised_arg (projection, kind) ->
+        Format.fprintf ppf "Projection_from_existing_specialised_arg (%a, %a)"
+          Projection.print projection Printlambda.value_kind kind
 
     let output _ _ = failwith "Definition.output not yet implemented"
   end)
@@ -163,7 +164,7 @@ module Processed_what_to_specialise = struct
       let existing_outer_var =
         match definition with
         | Existing_inner_free_var _ -> None
-        | Projection_from_existing_specialised_arg projection ->
+        | Projection_from_existing_specialised_arg (projection, _) ->
           let projection = lift_projection t ~projection in
           match
             Projection.Map.find projection
@@ -176,7 +177,7 @@ module Processed_what_to_specialise = struct
       | Some existing_outer_var -> existing_outer_var, t
       | None ->
         match definition with
-        | Existing_inner_free_var existing_inner_var ->
+        | Existing_inner_free_var (existing_inner_var, _) ->
           begin match
             Variable.Map.find existing_inner_var
               t.set_of_closures.free_vars
@@ -190,7 +191,7 @@ module Processed_what_to_specialise = struct
               Flambda.print_set_of_closures t.set_of_closures
           | existing_outer_var -> existing_outer_var.var, t
           end
-        | Projection_from_existing_specialised_arg projection ->
+        | Projection_from_existing_specialised_arg (projection, _) ->
           let new_outer_var = Variable.rename group in
           let projection = lift_projection t ~projection in
           let new_outer_vars_indexed_by_new_lifted_defns =
@@ -294,9 +295,10 @@ module Processed_what_to_specialise = struct
                 else
                   let definition : Definition.t =
                     match spec_to.projection with
-                    | None -> Existing_inner_free_var inner_var
+                    | None -> Existing_inner_free_var (inner_var, spec_to.kind)
                     | Some projection ->
-                      Projection_from_existing_specialised_arg projection
+                      Projection_from_existing_specialised_arg
+                        (projection, spec_to.kind)
                   in
                   Definition.Set.add definition definitions)
               what_to_specialise.set_of_closures.specialised_args
@@ -481,15 +483,16 @@ module Make (T : S) = struct
           let definition : Definition.t =
             match (definition : Definition.t) with
             | Existing_inner_free_var _ -> definition
-            | Projection_from_existing_specialised_arg projection ->
+            | Projection_from_existing_specialised_arg (projection, kind) ->
               Projection_from_existing_specialised_arg
                 (Projection.map_projecting_from projection
-                  ~f:find_wrapper_param)
+                  ~f:find_wrapper_param,
+                kind)
           in
           let benefit =
             match (definition : Definition.t) with
             | Existing_inner_free_var _ -> benefit
-            | Projection_from_existing_specialised_arg projection ->
+            | Projection_from_existing_specialised_arg (projection, _) ->
               B.add_projection projection benefit
           in
           match
@@ -500,9 +503,9 @@ module Make (T : S) = struct
           | new_inner_var_of_wrapper ->
             let named : Flambda.named =
               match definition with
-              | Existing_inner_free_var existing_inner_var ->
+              | Existing_inner_free_var (existing_inner_var, _) ->
                 Expr (Var existing_inner_var)
-              | Projection_from_existing_specialised_arg projection ->
+              | Projection_from_existing_specialised_arg (projection, _) ->
                 Flambda_utils.projection_to_named projection
             in
             let wrapper_body =
@@ -526,6 +529,7 @@ module Make (T : S) = struct
           let spec_to : Flambda.specialised_to =
             { var = spec_to.var;
               projection;
+              kind = spec_to.kind;
             }
           in
           Variable.Map.add inner_var spec_to result)
@@ -584,11 +588,12 @@ module Make (T : S) = struct
             | exception Not_found -> assert false
             | new_outer_var ->
               match definition with
-              | Existing_inner_free_var _ ->
+              | Existing_inner_free_var (_, kind) ->
                 { var = new_outer_var;
                   projection = None;
+                  kind;
                 }
-              | Projection_from_existing_specialised_arg projection ->
+              | Projection_from_existing_specialised_arg (projection, kind) ->
                 let projecting_from = Projection.projecting_from projection in
                 assert (Variable.Map.mem projecting_from
                   set_of_closures.specialised_args);
@@ -596,6 +601,7 @@ module Make (T : S) = struct
                   (Parameter.Set.vars function_decl.params));
                 { var = new_outer_var;
                   projection = Some projection;
+                  kind;
                 })
           for_one_function.new_definitions_indexed_by_new_inner_vars
       in
@@ -625,7 +631,17 @@ module Make (T : S) = struct
             function_decl.alloc_mode function_decl.params
         in
         let new_params =
-          List.map (fun p -> Parameter.wrap p last_mode) new_params
+          List.map (fun p ->
+              let definition =
+                Variable.Map.find p
+                  for_one_function.new_definitions_indexed_by_new_inner_vars
+              in
+              let kind =
+                match definition with
+                | Existing_inner_free_var (_, kind) -> kind
+                | Projection_from_existing_specialised_arg (_, kind) -> kind
+              in
+              Parameter.wrap p last_mode kind) new_params
         in
         function_decl.params @ new_params
       in
diff --git a/middle_end/flambda/augment_specialised_args.mli b/middle_end/flambda/augment_specialised_args.mli
index 910a2d1532f..949baea0b93 100644
--- a/middle_end/flambda/augment_specialised_args.mli
+++ b/middle_end/flambda/augment_specialised_args.mli
@@ -18,8 +18,8 @@
 
 module Definition : sig
   type t =
-    | Existing_inner_free_var of Variable.t
-    | Projection_from_existing_specialised_arg of Projection.t
+    | Existing_inner_free_var of Variable.t * Lambda.value_kind
+    | Projection_from_existing_specialised_arg of Projection.t * Lambda.value_kind
 end
 
 module What_to_specialise : sig
diff --git a/middle_end/flambda/closure_conversion.ml b/middle_end/flambda/closure_conversion.ml
index c27869e2628..3ac2c5f2968 100644
--- a/middle_end/flambda/closure_conversion.ml
+++ b/middle_end/flambda/closure_conversion.ml
@@ -103,7 +103,7 @@ let tupled_function_call_stub original_params unboxed_version ~closure_bound_var
   in
   (* Tupled functions are always Alloc_heap. See translcore.ml *)
   let alloc_mode = Lambda.alloc_heap in
-  let tuple_param = Parameter.wrap tuple_param_var alloc_mode in
+  let tuple_param = Parameter.wrap tuple_param_var alloc_mode Pgenval in
   Flambda.create_function_declaration ~params:[tuple_param] ~alloc_mode ~region
     ~body ~stub:true ~inline:Default_inline
     ~specialise:Default_specialise ~check:Default_check ~is_a_functor:false
@@ -179,14 +179,14 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
   match lam with
   | Lvar id ->
     begin match Env.find_var_exn env id with
-    | var -> Var var
+    | var, _kind -> Var var
     | exception Not_found ->
       Misc.fatal_errorf "Closure_conversion.close: unbound identifier %a"
         Ident.print id
     end
   | Lmutvar id ->
     begin match Env.find_mutable_var_exn env id with
-    | mut_var ->
+    | mut_var, _kind ->
        name_expr (Read_mutable mut_var) ~name:Names.read_mutable
     | exception Not_found ->
        Misc.fatal_errorf
@@ -196,13 +196,12 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
   | Lconst cst ->
     let cst, name = close_const t cst in
     name_expr cst ~name
-  | Llet ((Strict | Alias | StrictOpt), _value_kind, id, defining_expr, body) ->
-    (* TODO: keep value_kind in flambda *)
+  | Llet ((Strict | Alias | StrictOpt), value_kind, id, defining_expr, body) ->
     let var = Variable.create_with_same_name_as_ident id in
     let defining_expr =
       close_let_bound_expression t var env defining_expr
     in
-    let body = close t (Env.add_var env id var) body in
+    let body = close t (Env.add_var env id var value_kind) body in
     Flambda.create_let var defining_expr body
   | Lmutlet (block_kind, id, defining_expr, body) ->
     let mut_var = Mutable_variable.create_with_same_name_as_ident id in
@@ -210,7 +209,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
     let defining_expr =
       close_let_bound_expression t var env defining_expr
     in
-    let body = close t (Env.add_mutable_var env id mut_var) body in
+    let body = close t (Env.add_mutable_var env id mut_var block_kind) body in
     Flambda.create_let var defining_expr
       (Let_mutable
          { var = mut_var;
@@ -229,7 +228,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
     let set_of_closures =
       let decl =
         Function_decl.create ~let_rec_ident:None ~closure_bound_var ~kind ~mode
-          ~region ~params:(List.map fst params) ~body ~attr ~loc
+          ~region ~params ~body ~attr ~loc
       in
       close_functions t env (Function_decls.create [decl])
     in
@@ -264,7 +263,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
   | Lletrec (defs, body) ->
     let env =
       List.fold_right (fun (id,  _) env ->
-          Env.add_var env id (Variable.create_with_same_name_as_ident id))
+          Env.add_var env id (Variable.create_with_same_name_as_ident id) Pgenval)
         defs env
     in
     let function_declarations =
@@ -280,7 +279,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
             let function_declaration =
               Function_decl.create ~let_rec_ident:(Some let_rec_ident)
                 ~closure_bound_var ~kind ~mode ~region
-                ~params:(List.map fst params) ~body ~attr ~loc
+                ~params ~body ~attr ~loc
             in
             Some function_declaration
           | _ -> None)
@@ -305,7 +304,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
         List.fold_left (fun body decl ->
             let let_rec_ident = Function_decl.let_rec_ident decl in
             let closure_bound_var = Function_decl.closure_bound_var decl in
-            let let_bound_var = Env.find_var env let_rec_ident in
+            let let_bound_var, _kind = Env.find_var env let_rec_ident in
             (* Inside the body of the [let], each function is referred to by
                a [Project_closure] expression, which projects from the set of
                closures. *)
@@ -324,7 +323,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
          individual closures. *)
       let defs =
         List.map (fun (id, def) ->
-            let var = Env.find_var env id in
+            let var, _kind = Env.find_var env id in
             var, close_let_bound_expression t ~let_rec_ident:id var env def)
           defs
       in
@@ -526,15 +525,16 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
   | Lstaticcatch (body, (i, ids), handler, kind) ->
     let st_exn = Static_exception.create () in
     let env = Env.add_static_exception env i st_exn in
-    let ids = List.map fst ids in
     let vars =
-      List.map (fun ident -> Variable.create_with_same_name_as_ident ident) ids
+      List.map (fun (ident, kind) ->
+          (Variable.create_with_same_name_as_ident ident, kind)) ids
     in
-    Static_catch (st_exn, vars, close t env body,
-      close t (Env.add_vars env ids vars) handler, kind)
+    Static_catch (st_exn, List.map fst vars, close t env body,
+      close t (Env.add_vars env (List.map fst ids) vars) handler, kind)
   | Ltrywith (body, id, handler, kind) ->
     let var = Variable.create_with_same_name_as_ident id in
-    Try_with (close t env body, var, close t (Env.add_var env id var) handler,
+    Try_with (close t env body, var,
+              close t (Env.add_var env id var Pgenval) handler,
               kind)
   | Lifthenelse (cond, ifso, ifnot, kind) ->
     let cond = close t env cond in
@@ -552,12 +552,12 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
     let bound_var = Variable.create_with_same_name_as_ident for_id in
     let from_value = Variable.create Names.for_from in
     let to_value = Variable.create Names.for_to in
-    let body = close t (Env.add_var env for_id bound_var) for_body in
+    let body = close t (Env.add_var env for_id bound_var Pintval) for_body in
     Flambda.create_let from_value (Expr (close t env for_from))
       (Flambda.create_let to_value (Expr (close t env for_to))
         (For { bound_var; from_value; to_value; direction=for_dir; body; }))
   | Lassign (id, new_value) ->
-    let being_assigned =
+    let being_assigned, _kind =
       match Env.find_mutable_var_exn env id with
       | being_assigned -> being_assigned
       | exception Not_found ->
@@ -597,8 +597,8 @@ and close_functions t external_env function_declarations : Flambda.named =
        This induces a renaming on [Function_decl.free_idents]; the results of
        that renaming are stored in [free_variables]. *)
     let closure_env =
-      List.fold_right (fun id env ->
-          Env.add_var env id (Variable.create_with_same_name_as_ident id))
+      List.fold_right (fun (id, kind) env ->
+          Env.add_var env id (Variable.create_with_same_name_as_ident id) kind)
         params closure_env_without_parameters
     in
     (* If the function is the wrapper for a function with an optional
@@ -606,7 +606,7 @@ and close_functions t external_env function_declarations : Flambda.named =
        CR-someday pchambart: eta-expansion wrapper for a primitive are
        not marked as stub but certainly should *)
     let stub = Function_decl.stub decl in
-    let param_vars = List.map (Env.find_var closure_env) params in
+    let param_vars = List.map (fun (id, _) -> Env.find_var closure_env id) params in
     let nheap =
       match Function_decl.mode decl, Function_decl.kind decl with
       | _, Curried {nlocal} -> List.length params - nlocal
@@ -614,11 +614,11 @@ and close_functions t external_env function_declarations : Flambda.named =
       | Alloc_local, Tupled ->
          Misc.fatal_error "Closure_conversion: Tupled Alloc_local function found"
     in
-    let params = List.mapi (fun i v ->
+    let params = List.mapi (fun i (v, kind) ->
       let alloc_mode =
         if i < nheap then Lambda.alloc_heap else Lambda.alloc_local
       in
-      Parameter.wrap v alloc_mode) param_vars
+      Parameter.wrap v alloc_mode kind) param_vars
     in
     let closure_bound_var = Function_decl.closure_bound_var decl in
     let unboxed_version = Variable.rename closure_bound_var in
@@ -643,7 +643,7 @@ and close_functions t external_env function_declarations : Flambda.named =
     | Tupled ->
       let unboxed_version = Variable.rename closure_bound_var in
       let generic_function_stub =
-        tupled_function_call_stub param_vars unboxed_version
+        tupled_function_call_stub (List.map fst param_vars) unboxed_version
           ~closure_bound_var ~region
       in
       Variable.Map.add unboxed_version fun_decl
@@ -663,13 +663,12 @@ and close_functions t external_env function_declarations : Flambda.named =
   let set_of_closures =
     let free_vars =
       Ident.Set.fold (fun var map ->
-          let internal_var =
+          let internal_var, _ =
             Env.find_var closure_env_without_parameters var
           in
+          let var, kind = Env.find_var external_env var in
           let external_var : Flambda.specialised_to =
-            { var = Env.find_var external_env var;
-              projection = None;
-            }
+            { var ; projection = None; kind }
           in
           Variable.Map.add internal_var external_var map)
         all_free_idents Variable.Map.empty
@@ -694,7 +693,7 @@ and close_let_bound_expression t ?let_rec_ident let_bound_var env
     in
     let decl =
       Function_decl.create ~let_rec_ident ~closure_bound_var ~kind ~mode ~region
-        ~params:(List.map fst params) ~body ~attr ~loc
+        ~params ~body ~attr ~loc
     in
     let set_of_closures_var = Variable.rename let_bound_var in
     let set_of_closures =
diff --git a/middle_end/flambda/closure_conversion_aux.ml b/middle_end/flambda/closure_conversion_aux.ml
index 807536d3737..41dc76abe00 100644
--- a/middle_end/flambda/closure_conversion_aux.ml
+++ b/middle_end/flambda/closure_conversion_aux.ml
@@ -19,8 +19,8 @@ open! Int_replace_polymorphic_compare
 
 module Env = struct
   type t = {
-    variables : Variable.t Ident.tbl;
-    mutable_variables : Mutable_variable.t Ident.tbl;
+    variables : (Variable.t * Lambda.value_kind) Ident.tbl;
+    mutable_variables : (Mutable_variable.t * Lambda.value_kind) Ident.tbl;
     static_exceptions : Static_exception.t Numbers.Int.Map.t;
     globals : Symbol.t Numbers.Int.Map.t;
     at_toplevel : bool;
@@ -37,8 +37,10 @@ module Env = struct
   let clear_local_bindings env =
     { empty with globals = env.globals }
 
-  let add_var t id var = { t with variables = Ident.add id var t.variables }
-  let add_vars t ids vars = List.fold_left2 add_var t ids vars
+  let add_var t id var kind =
+    { t with variables = Ident.add id (var, kind) t.variables }
+  let add_vars t ids vars =
+    List.fold_left2 (fun t id (var, kind) -> add_var t id var kind) t ids vars
 
   let find_var t id =
     try Ident.find_same id t.variables
@@ -50,8 +52,9 @@ module Env = struct
   let find_var_exn t id =
     Ident.find_same id t.variables
 
-  let add_mutable_var t id mutable_var =
-    { t with mutable_variables = Ident.add id mutable_var t.mutable_variables }
+  let add_mutable_var t id mutable_var kind =
+    let mutable_variables = Ident.add id (mutable_var, kind) t.mutable_variables in
+    { t with mutable_variables }
 
   let find_mutable_var_exn t id =
     Ident.find_same id t.mutable_variables
@@ -89,7 +92,7 @@ module Function_decls = struct
       kind : Lambda.function_kind;
       mode : Lambda.alloc_mode;
       region : bool;
-      params : Ident.t list;
+      params : (Ident.t * Lambda.value_kind) list;
       body : Lambda.lambda;
       free_idents_of_body : Ident.Set.t;
       attr : Lambda.function_attribute;
@@ -165,7 +168,7 @@ module Function_decls = struct
      difference *)
   let all_free_idents function_decls =
     set_diff (set_diff (all_free_idents function_decls)
-        (all_params function_decls))
+        (List.map fst (all_params function_decls)))
       (let_rec_idents function_decls)
 
   let create (function_decls : Function_decl.t list) =
@@ -182,11 +185,13 @@ module Function_decls = struct
       (* For "let rec"-bound functions. *)
       List.fold_right (fun function_decl env ->
           Env.add_var env (Function_decl.let_rec_ident function_decl)
-            (Function_decl.closure_bound_var function_decl))
+            (Function_decl.closure_bound_var function_decl) Pgenval)
         t.function_decls (Env.clear_local_bindings external_env)
     in
     (* For free variables. *)
     Ident.Set.fold (fun id env ->
-        Env.add_var env id (Variable.create_with_same_name_as_ident id))
+        let _, kind = Env.find_var external_env id in
+        Env.add_var env id (Variable.create_with_same_name_as_ident id) kind
+      )
       t.all_free_idents closure_env
 end
diff --git a/middle_end/flambda/closure_conversion_aux.mli b/middle_end/flambda/closure_conversion_aux.mli
index 111f4c392f8..595a34759e6 100644
--- a/middle_end/flambda/closure_conversion_aux.mli
+++ b/middle_end/flambda/closure_conversion_aux.mli
@@ -26,14 +26,16 @@ module Env : sig
 
   val empty : t
 
-  val add_var : t -> Ident.t -> Variable.t -> t
-  val add_vars : t -> Ident.t list -> Variable.t list -> t
+  val add_var : t -> Ident.t -> Variable.t -> Lambda.value_kind -> t
+  val add_vars : t -> Ident.t list -> (Variable.t * Lambda.value_kind) list -> t
 
-  val find_var : t -> Ident.t -> Variable.t
-  val find_var_exn : t -> Ident.t -> Variable.t
+  val find_var : t -> Ident.t -> Variable.t * Lambda.value_kind
+  val find_var_exn : t -> Ident.t -> Variable.t * Lambda.value_kind
 
-  val add_mutable_var : t -> Ident.t -> Mutable_variable.t -> t
-  val find_mutable_var_exn : t -> Ident.t -> Mutable_variable.t
+  val add_mutable_var :
+    t -> Ident.t -> Mutable_variable.t -> Lambda.value_kind -> t
+  val find_mutable_var_exn :
+    t -> Ident.t -> Mutable_variable.t * Lambda.value_kind
 
   val add_static_exception : t -> int -> Static_exception.t -> t
   val find_static_exception : t -> int -> Static_exception.t
@@ -58,7 +60,7 @@ module Function_decls : sig
       -> kind:Lambda.function_kind
       -> mode:Lambda.alloc_mode
       -> region:bool
-      -> params:Ident.t list
+      -> params:(Ident.t * Lambda.value_kind) list
       -> body:Lambda.lambda
       -> attr:Lambda.function_attribute
       -> loc:Lambda.scoped_location
@@ -69,7 +71,7 @@ module Function_decls : sig
     val kind : t -> Lambda.function_kind
     val mode : t -> Lambda.alloc_mode
     val region : t -> bool
-    val params : t -> Ident.t list
+    val params : t -> (Ident.t * Lambda.value_kind) list
     val body : t -> Lambda.lambda
     val inline : t -> Lambda.inline_attribute
     val specialise : t -> Lambda.specialise_attribute
diff --git a/middle_end/flambda/closure_offsets.ml b/middle_end/flambda/closure_offsets.ml
index 51a09f02cb3..ea5954e8af8 100644
--- a/middle_end/flambda/closure_offsets.ml
+++ b/middle_end/flambda/closure_offsets.ml
@@ -68,9 +68,18 @@ let add_closure_offsets
     let map = Var_within_closure.Map.add var_within_closure pos map in
     (map, pos + 1)
   in
+  let gc_invisible_free_vars, gc_visible_free_vars =
+    Variable.Map.partition (fun _ (free_var : Flambda.specialised_to) ->
+        Lambda.equal_value_kind free_var.kind Pintval)
+      free_vars
+  in
+  let free_variable_offsets, free_variable_pos =
+    Variable.Map.fold assign_free_variable_offset
+      gc_invisible_free_vars (free_variable_offsets, free_variable_pos)
+  in
   let free_variable_offsets, _ =
     Variable.Map.fold assign_free_variable_offset
-      free_vars (free_variable_offsets, free_variable_pos)
+      gc_visible_free_vars (free_variable_offsets, free_variable_pos)
   in
   { function_offsets;
     free_variable_offsets;
diff --git a/middle_end/flambda/flambda.ml b/middle_end/flambda/flambda.ml
index 25dd353c594..c4ef871d9ae 100644
--- a/middle_end/flambda/flambda.ml
+++ b/middle_end/flambda/flambda.ml
@@ -59,6 +59,7 @@ type project_var = Projection.project_var
 type specialised_to = {
   var : Variable.t;
   projection : Projection.t option;
+  kind : Lambda.value_kind;
 }
 
 type t =
@@ -188,11 +189,15 @@ module Int = Numbers.Int
 
 let print_specialised_to ppf (spec_to : specialised_to) =
   match spec_to.projection with
-  | None -> fprintf ppf "%a" Variable.print spec_to.var
+  | None ->
+    fprintf ppf "%a[%a]"
+      Variable.print spec_to.var
+      Printlambda.value_kind spec_to.kind
   | Some projection ->
-    fprintf ppf "%a(= %a)"
+    fprintf ppf "%a(= %a)[%a]"
       Variable.print spec_to.var
       Projection.print projection
+      Printlambda.value_kind spec_to.kind
 
 (* CR-soon mshinwell: delete uses of old names *)
 let print_project_var = Projection.print_project_var
@@ -1323,6 +1328,7 @@ let equal_specialised_to (spec_to1 : specialised_to)
       | Some _, None | None, Some _ -> false
       | Some proj1, Some proj2 -> Projection.equal proj1 proj2
     end
+    && Lambda.equal_value_kind spec_to1.kind spec_to2.kind
 
 let compare_project_var = Projection.compare_project_var
 let compare_project_closure = Projection.compare_project_closure
diff --git a/middle_end/flambda/flambda.mli b/middle_end/flambda/flambda.mli
index cce0b2a9196..67fe32c0716 100644
--- a/middle_end/flambda/flambda.mli
+++ b/middle_end/flambda/flambda.mli
@@ -87,6 +87,7 @@ type specialised_to = {
       [specialised_args] respectively) in the same set of closures.
       As such, this field describes a relation of projections between
       either the [free_vars] or the [specialised_args]. *)
+  kind : Lambda.value_kind;
 }
 
 (** Flambda terms are partitioned in a pseudo-ANF manner; many terms are
diff --git a/middle_end/flambda/flambda_to_clambda.ml b/middle_end/flambda/flambda_to_clambda.ml
index ef7bb008564..1bf5a98ab26 100644
--- a/middle_end/flambda/flambda_to_clambda.ml
+++ b/middle_end/flambda/flambda_to_clambda.ml
@@ -585,13 +585,23 @@ and to_clambda_set_of_closures t env
       check = function_decl.check;
     }
   in
-  let funs = List.map to_clambda_function all_functions in
-  let free_vars =
-    Variable.Map.bindings (Variable.Map.map (
-      fun (free_var : Flambda.specialised_to) ->
-        subst_var env free_var.var) free_vars)
+  let functions = List.map to_clambda_function all_functions in
+  let not_scanned_fv, scanned_fv =
+    Variable.Map.partition (fun _ (free_var : Flambda.specialised_to) ->
+        Lambda.equal_value_kind free_var.kind Pintval)
+      free_vars
   in
-  Uclosure (funs, List.map snd free_vars)
+  let to_closure_args free_vars =
+    List.map snd (
+      Variable.Map.bindings (Variable.Map.map (
+          fun (free_var : Flambda.specialised_to) ->
+            subst_var env free_var.var) free_vars))
+  in
+  Uclosure {
+    functions ;
+    not_scanned_slots = to_closure_args not_scanned_fv ;
+    scanned_slots = to_closure_args scanned_fv
+  }
 
 and to_clambda_closed_set_of_closures t env symbol
       ({ function_decls; } : Flambda.set_of_closures)
diff --git a/middle_end/flambda/flambda_utils.ml b/middle_end/flambda/flambda_utils.ml
index 8c7a557e6f6..180ce15c4ae 100644
--- a/middle_end/flambda/flambda_utils.ml
+++ b/middle_end/flambda/flambda_utils.ml
@@ -343,16 +343,16 @@ let toplevel_substitution_named sb named =
   | _ -> assert false
 
 let make_closure_declaration
-      ~is_classic_mode ~id ~alloc_mode ~region ~body ~params : Flambda.t =
-  let free_variables = Flambda.free_variables body in
+      ~is_classic_mode ~id ~alloc_mode ~region ~body ~params ~free_variables : Flambda.t =
   let param_set = Parameter.Set.vars params in
-  if not (Variable.Set.subset param_set free_variables) then begin
+  let free_variables_set = Variable.Map.keys free_variables in
+  if not (Variable.Set.subset param_set free_variables_set) then begin
     Misc.fatal_error "Flambda_utils.make_closure_declaration"
   end;
   let sb =
     Variable.Set.fold
       (fun id sb -> Variable.Map.add id (Variable.rename id) sb)
-      free_variables Variable.Map.empty
+      free_variables_set Variable.Map.empty
   in
   (* CR-soon mshinwell: try to eliminate this [toplevel_substitution].  This
      function is only called from [Inline_and_simplify], so we should be able
@@ -368,13 +368,15 @@ let make_closure_declaration
       ~closure_origin:(Closure_origin.create (Closure_id.wrap id))
       ~poll:Default_poll
   in
-  assert (Variable.Set.equal (Variable.Set.map subst free_variables)
+  assert (Variable.Set.equal (Variable.Set.map subst free_variables_set)
     function_declaration.free_variables);
   let free_vars =
     Variable.Map.fold (fun id id' fv' ->
+        let kind = Variable.Map.find id free_variables in
         let spec_to : Flambda.specialised_to =
           { var = id;
             projection = None;
+            kind;
           }
         in
         Variable.Map.add id' spec_to fv')
diff --git a/middle_end/flambda/flambda_utils.mli b/middle_end/flambda/flambda_utils.mli
index 86f1d59e14d..735763c92a2 100644
--- a/middle_end/flambda/flambda_utils.mli
+++ b/middle_end/flambda/flambda_utils.mli
@@ -69,6 +69,7 @@ val make_closure_declaration
   -> region:bool
   -> body:Flambda.t
   -> params:Parameter.t list
+  -> free_variables:Lambda.value_kind Variable.Map.t
   -> Flambda.t
 
 val toplevel_substitution
diff --git a/middle_end/flambda/inline_and_simplify.ml b/middle_end/flambda/inline_and_simplify.ml
index 15b15954d89..f9e08e956b8 100644
--- a/middle_end/flambda/inline_and_simplify.ml
+++ b/middle_end/flambda/inline_and_simplify.ml
@@ -859,12 +859,20 @@ and simplify_partial_application env r ~lhs_of_application
       Variable.rename ~debug_info:(Closure_id.debug_info closure_id_being_applied)
         (Closure_id.unwrap closure_id_being_applied)
     in
+    let free_variables =
+      Variable.Map.of_list
+        (List.map (fun p -> Parameter.var p, Parameter.kind p) freshened_params)
+    in
+    let free_variables =
+      Variable.Map.add lhs_of_application Lambda.Pgenval free_variables
+    in
     Flambda_utils.make_closure_declaration ~id:closure_variable
       ~is_classic_mode:false
       ~body
       ~alloc_mode:partial_mode
       ~region:function_decl.A.region
       ~params:remaining_args
+      ~free_variables
   in
   let with_known_args =
     Flambda_utils.bind
diff --git a/middle_end/flambda/inline_and_simplify_aux.ml b/middle_end/flambda/inline_and_simplify_aux.ml
index e9937d99186..618957141f7 100644
--- a/middle_end/flambda/inline_and_simplify_aux.ml
+++ b/middle_end/flambda/inline_and_simplify_aux.ml
@@ -576,8 +576,7 @@ let prepare_to_simplify_set_of_closures ~env
         let approx = E.find_exn env var in
         (* The projections are freshened below in one step, once we know
            the closure freshening substitution. *)
-        let projection = external_var.projection in
-        ({ var; projection; } : Flambda.specialised_to), approx)
+        ({ external_var with var } : Flambda.specialised_to), approx)
       set_of_closures.free_vars
   in
   let specialised_args =
@@ -603,8 +602,7 @@ let prepare_to_simplify_set_of_closures ~env
             | None -> var
             | Some var -> var
           in
-          let projection = spec_to.projection in
-          Some ({ var; projection; } : Flambda.specialised_to))
+          Some ({ spec_to with var } : Flambda.specialised_to))
   in
   let environment_before_cleaning = env in
   (* [E.local] helps us to catch bugs whereby variables escape their scope. *)
diff --git a/middle_end/flambda/inlining_transforms.ml b/middle_end/flambda/inlining_transforms.ml
index 0fd297dea84..1387c3d7f15 100644
--- a/middle_end/flambda/inlining_transforms.ml
+++ b/middle_end/flambda/inlining_transforms.ml
@@ -295,6 +295,7 @@ let register_arguments ~specialised_args ~invariant_params
    [old_params_to_new_outside] then also add it to the new specialised args. *)
 let add_param ~specialised_args ~state ~param =
   let alloc_mode = Parameter.alloc_mode param in
+  let kind = Parameter.kind param in
   let param = Parameter.var param in
   let new_param = Variable.rename param in
   let old_inside_to_new_inside =
@@ -316,7 +317,7 @@ let add_param ~specialised_args ~state ~param =
         | None -> state.new_specialised_args_with_old_projections
         | Some new_outside_var ->
             let new_spec : Flambda.specialised_to =
-              { var = new_outside_var; projection = None }
+              { var = new_outside_var; projection = None; kind }
             in
             Variable.Map.add new_param new_spec
               state.new_specialised_args_with_old_projections
@@ -326,7 +327,7 @@ let add_param ~specialised_args ~state ~param =
     { state with old_inside_to_new_inside;
                  new_specialised_args_with_old_projections }
   in
-  state, Parameter.wrap new_param alloc_mode
+  state, Parameter.wrap new_param alloc_mode kind
 
 (* Add a let binding for an old fun_var, add it to the new free variables, and
    add it to [old_inside_to_new_inside] *)
@@ -343,7 +344,7 @@ let add_fun_var ~lhs_of_application ~closure_id_being_applied ~state ~fun_var =
     in
     let let_bindings = (outside_var, expr) :: state.let_bindings in
     let spec : Flambda.specialised_to =
-      { var = outside_var; projection = None; }
+      { var = outside_var; projection = None; kind = Pgenval }
     in
     let new_free_vars_with_old_projections =
       Variable.Map.add inside_var spec state.new_free_vars_with_old_projections
diff --git a/middle_end/flambda/parameter.ml b/middle_end/flambda/parameter.ml
index 93607e4e384..7ff5625ccdc 100644
--- a/middle_end/flambda/parameter.ml
+++ b/middle_end/flambda/parameter.ml
@@ -24,33 +24,40 @@ open! Int_replace_polymorphic_compare
 type parameter = {
   var : Variable.t;
   mode : Lambda.alloc_mode;
+  kind : Lambda.value_kind;
 }
 
-let wrap var mode = { var; mode }
+let wrap var mode kind = { var; mode; kind }
 
 let var p = p.var
 let alloc_mode p = p.mode
+let kind p = p.kind
 
 module M =
   Identifiable.Make (struct
     type t = parameter
 
-    let compare { var = var1; mode = _ } { var = var2; mode = _ } =
+    let compare
+        { var = var1; mode = _ ; kind = _ }
+        { var = var2; mode = _ ; kind = _ } =
       Variable.compare var1 var2
 
-    let equal { var = var1; mode = _ } { var = var2; mode = _ } =
+    let equal
+        { var = var1; mode = _ ; kind = _ }
+        { var = var2; mode = _ ; kind = _ } =
       Variable.equal var1 var2
 
-    let hash { var; mode = _ } =
+    let hash { var; mode = _ ; kind = _ } =
       Variable.hash var
 
-    let print ppf { var; mode } =
+    let print ppf { var; mode ; kind } =
       let mode = match mode with
         | Lambda.Alloc_heap -> ""
         | Lambda.Alloc_local -> "[->L]" in
-      Format.fprintf ppf "%a%s" Variable.print var mode
+      Format.fprintf ppf "%a%s[%a]"
+        Variable.print var mode Printlambda.value_kind kind
 
-    let output o { var; mode = _ } =
+    let output o { var; mode = _ ; kind = _ } =
       Variable.output o var
   end)
 
@@ -65,10 +72,10 @@ module Set = struct
 end
 
 let rename ?current_compilation_unit p =
-  { var = Variable.rename ?current_compilation_unit p.var; mode = p.mode }
+  { p with var = Variable.rename ?current_compilation_unit p.var }
 
-let map_var f { var; mode } = { var = f var; mode }
+let map_var f { var ; mode ; kind } = { var = f var; mode; kind }
 
 module List = struct
-  let vars params = List.map (fun { var; mode=_ } -> var) params
+  let vars params = List.map (fun { var ; mode = _ ; kind = _ } -> var) params
 end
diff --git a/middle_end/flambda/parameter.mli b/middle_end/flambda/parameter.mli
index 4687d4d0fd9..3c99abe20cc 100644
--- a/middle_end/flambda/parameter.mli
+++ b/middle_end/flambda/parameter.mli
@@ -23,7 +23,7 @@ type t
 type parameter = t
 
 (** Make a parameter from a variable with default attributes *)
-val wrap : Variable.t -> Lambda.alloc_mode -> t
+val wrap : Variable.t -> Lambda.alloc_mode -> Lambda.value_kind -> t
 
 val var : t -> Variable.t
 
@@ -31,6 +31,8 @@ val var : t -> Variable.t
     up to and including this parameter *)
 val alloc_mode : t -> Lambda.alloc_mode
 
+val kind : t -> Lambda.value_kind
+
 (** Rename the inner variable of the parameter *)
 val rename
    : ?current_compilation_unit:Compilation_unit.t
diff --git a/middle_end/flambda/un_anf.ml b/middle_end/flambda/un_anf.ml
index 3146a16a2f5..87e04cddc7b 100644
--- a/middle_end/flambda/un_anf.ml
+++ b/middle_end/flambda/un_anf.ml
@@ -144,8 +144,9 @@ let make_var_info (clam : Clambda.ulambda) : var_info =
       List.iter (loop ~depth) args;
       ignore_apply_kind info;
       ignore_debuginfo dbg
-    | Uclosure (functions, captured_variables) ->
-      List.iter (loop ~depth) captured_variables;
+    | Uclosure { functions; not_scanned_slots ; scanned_slots } ->
+      List.iter (loop ~depth) not_scanned_slots;
+      List.iter (loop ~depth) scanned_slots;
       List.iter (fun (
         { Clambda. label; arity=_; params; return; body; dbg; env; mode=_;
             check=_; poll=_ } as clos) ->
@@ -321,8 +322,9 @@ let let_bound_vars_that_can_be_moved var_info (clam : Clambda.ulambda) =
       examine_argument_list (args @ [func]);
       ignore_apply_kind info;
       ignore_debuginfo dbg
-    | Uclosure (functions, captured_variables) ->
-      ignore_ulambda_list captured_variables;
+    | Uclosure { functions ; not_scanned_slots ; scanned_slots } ->
+      ignore_ulambda_list not_scanned_slots;
+      ignore_ulambda_list scanned_slots;
       (* Start a new let stack for speed. *)
       List.iter (fun {Clambda. label; arity=_; params; return; body; dbg; env; mode=_;
                       check=_; poll=_} ->
@@ -501,7 +503,7 @@ let rec substitute_let_moveable is_let_moveable env (clam : Clambda.ulambda)
     let func = substitute_let_moveable is_let_moveable env func in
     let args = substitute_let_moveable_list is_let_moveable env args in
     Ugeneric_apply (func, args, kind, dbg)
-  | Uclosure (functions, variables_bound_by_the_closure) ->
+  | Uclosure { functions ; not_scanned_slots ; scanned_slots } ->
     let functions =
       List.map (fun (ufunction : Clambda.ufunction) ->
           { ufunction with
@@ -509,11 +511,15 @@ let rec substitute_let_moveable is_let_moveable env (clam : Clambda.ulambda)
           })
         functions
     in
-    let variables_bound_by_the_closure =
+    let not_scanned_slots =
       substitute_let_moveable_list is_let_moveable env
-        variables_bound_by_the_closure
+        not_scanned_slots
     in
-    Uclosure (functions, variables_bound_by_the_closure)
+    let scanned_slots =
+      substitute_let_moveable_list is_let_moveable env
+        scanned_slots
+    in
+    Uclosure { functions ; not_scanned_slots; scanned_slots }
   | Uoffset (clam, n) ->
     let clam = substitute_let_moveable is_let_moveable env clam in
     Uoffset (clam, n)
@@ -701,7 +707,7 @@ let rec un_anf_and_moveable var_info env (clam : Clambda.ulambda)
     let func = un_anf var_info env func in
     let args = un_anf_list var_info env args in
     Ugeneric_apply (func, args, kind, dbg), Fixed
-  | Uclosure (functions, variables_bound_by_the_closure) ->
+  | Uclosure { functions ; not_scanned_slots ; scanned_slots } ->
     let functions =
       List.map (fun (ufunction : Clambda.ufunction) ->
           { ufunction with
@@ -709,10 +715,9 @@ let rec un_anf_and_moveable var_info env (clam : Clambda.ulambda)
           })
         functions
     in
-    let variables_bound_by_the_closure =
-      un_anf_list var_info env variables_bound_by_the_closure
-    in
-    Uclosure (functions, variables_bound_by_the_closure), Fixed
+    let not_scanned_slots = un_anf_list var_info env not_scanned_slots in
+    let scanned_slots = un_anf_list var_info env scanned_slots in
+    Uclosure { functions ; not_scanned_slots ; scanned_slots }, Fixed
   | Uoffset (clam, n) ->
     let clam, moveable = un_anf_and_moveable var_info env clam in
     Uoffset (clam, n), both_moveable Moveable moveable
diff --git a/middle_end/flambda/unbox_closures.ml b/middle_end/flambda/unbox_closures.ml
index 5c86bed3da7..2045ca90c38 100644
--- a/middle_end/flambda/unbox_closures.ml
+++ b/middle_end/flambda/unbox_closures.ml
@@ -76,9 +76,10 @@ module Transform = struct
               set_of_closures.function_decls
           in
           Variable.Set.fold (fun inner_free_var what_to_specialise ->
+              let kind = (Variable.Map.find inner_free_var set_of_closures.free_vars).kind in
               W.new_specialised_arg what_to_specialise
                 ~fun_var ~group:inner_free_var
-                ~definition:(Existing_inner_free_var inner_free_var))
+                ~definition:(Existing_inner_free_var (inner_free_var, kind)))
             bound_by_the_closure
             what_to_specialise)
     end
diff --git a/middle_end/flambda/unbox_free_vars_of_closures.ml b/middle_end/flambda/unbox_free_vars_of_closures.ml
index 7a4e48ed44e..a9a20422bd5 100644
--- a/middle_end/flambda/unbox_free_vars_of_closures.ml
+++ b/middle_end/flambda/unbox_free_vars_of_closures.ml
@@ -104,6 +104,7 @@ let run ~env ~(set_of_closures : Flambda.set_of_closures) =
                    "new inner" and a fresh "new outer" var, since we know
                    the definition is not a duplicate. *)
                 let projecting_from = Projection.projecting_from projection in
+                let kind = (Variable.Map.find projecting_from set_of_closures.free_vars).kind in
                 let new_inner_var = Variable.rename projecting_from in
                 let new_outer_var = Variable.rename projecting_from in
                 let definitions_indexed_by_new_inner_vars =
@@ -117,6 +118,7 @@ let run ~env ~(set_of_closures : Flambda.set_of_closures) =
                 let new_outer_var : Flambda.specialised_to =
                   { var = new_outer_var;
                     projection = Some projection;
+                    kind;
                   }
                 in
                 let additional_free_vars =
diff --git a/middle_end/flambda/unbox_specialised_args.ml b/middle_end/flambda/unbox_specialised_args.ml
index 428e7f9608b..ac928428a08 100644
--- a/middle_end/flambda/unbox_specialised_args.ml
+++ b/middle_end/flambda/unbox_specialised_args.ml
@@ -51,10 +51,11 @@ module Transform = struct
                   what_to_specialise ->
               let group = Projection.projecting_from projection in
               assert (Variable.Map.mem group set_of_closures.specialised_args);
+              let kind = (Variable.Map.find group set_of_closures.specialised_args).kind in
               let what_to_specialise =
                 W.new_specialised_arg what_to_specialise ~fun_var ~group
                   ~definition:(Projection_from_existing_specialised_arg
-                      projection)
+                      (projection, kind))
               in
               match Variable.Map.find group invariant_params_flow with
               | exception Not_found -> what_to_specialise
@@ -80,6 +81,7 @@ module Transform = struct
                          corresponding inner specialised arg of
                          [target_fun_var].  (The outer vars referenced in the
                          projection remain unchanged.) *)
+                      let kind = (Variable.Map.find target_spec_arg set_of_closures.specialised_args).kind in
                       let projection =
                         Projection.map_projecting_from projection
                           ~f:(fun var ->
@@ -89,7 +91,7 @@ module Transform = struct
                       W.new_specialised_arg what_to_specialise
                         ~fun_var:target_fun_var ~group
                         ~definition:
-                          (Projection_from_existing_specialised_arg projection)
+                          (Projection_from_existing_specialised_arg (projection, kind))
                     end)
                   flow
                   what_to_specialise)
diff --git a/middle_end/flambda2/compare/compare.ml b/middle_end/flambda2/compare/compare.ml
index 9915955a4fb..5250f7867cc 100644
--- a/middle_end/flambda2/compare/compare.ml
+++ b/middle_end/flambda2/compare/compare.ml
@@ -242,10 +242,10 @@ let subst_unary_primitive env (p : Flambda_primitive.unary_primitive) :
     let move_from = subst_function_slot env move_from in
     let move_to = subst_function_slot env move_to in
     Project_function_slot { move_from; move_to }
-  | Project_value_slot { project_from; value_slot } ->
+  | Project_value_slot { project_from; value_slot; kind } ->
     let project_from = subst_function_slot env project_from in
     let value_slot = subst_value_slot env value_slot in
-    Project_value_slot { project_from; value_slot }
+    Project_value_slot { project_from; value_slot; kind }
   | _ -> p
 
 let subst_primitive env (p : Flambda_primitive.t) : Flambda_primitive.t =
@@ -270,8 +270,8 @@ let subst_set_of_closures env set =
   let value_slots =
     Set_of_closures.value_slots set
     |> Value_slot.Map.bindings
-    |> List.map (fun (var, simple) ->
-           subst_value_slot env var, subst_simple env simple)
+    |> List.map (fun (var, (simple, kind)) ->
+           subst_value_slot env var, (subst_simple env simple, kind))
     |> Value_slot.Map.of_list
   in
   Set_of_closures.create Alloc_mode.For_allocations.heap ~value_slots decls
@@ -631,15 +631,26 @@ let unary_prim_ops env (prim_op1 : Flambda_primitive.unary_primitive)
            Flambda_primitive.Project_function_slot
              { move_from = move_from1'; move_to = move_to1' })
   | ( Project_value_slot
-        { project_from = function_slot1; value_slot = value_slot1 },
+        { project_from = function_slot1;
+          value_slot = value_slot1;
+          kind = kind1
+        },
       Project_value_slot
-        { project_from = function_slot2; value_slot = value_slot2 } ) ->
-    pairs ~f1:function_slots ~f2:value_slots env
-      (function_slot1, value_slot1)
-      (function_slot2, value_slot2)
-    |> Comparison.map ~f:(fun (function_slot1', value_slot1') ->
+        { project_from = function_slot2;
+          value_slot = value_slot2;
+          kind = kind2
+        } ) ->
+    triples ~f1:function_slots ~f2:value_slots
+      ~f3:(Comparator.of_predicate Flambda_kind.With_subkind.equal)
+      env
+      (function_slot1, value_slot1, kind1)
+      (function_slot2, value_slot2, kind2)
+    |> Comparison.map ~f:(fun (function_slot1', value_slot1', kind1') ->
            Flambda_primitive.Project_value_slot
-             { project_from = function_slot1'; value_slot = value_slot1' })
+             { project_from = function_slot1';
+               value_slot = value_slot1';
+               kind = kind1'
+             })
   | _, _ ->
     if Flambda_primitive.equal_unary_primitive prim_op1 prim_op2
     then Equivalent
@@ -738,21 +749,22 @@ let sets_of_closures env set1 set2 : Set_of_closures.t Comparison.t =
    * similar (and less worrisome) with function slots. *)
   let value_slots_by_value set =
     Value_slot.Map.bindings (Set_of_closures.value_slots set)
-    |> List.map (fun (var, value) -> subst_simple env value, var)
+    |> List.map (fun (var, (value, kind)) -> kind, subst_simple env value, var)
   in
   (* We want to process the whole map to find new correspondences between
    * value slots, so we need to remember whether we've found any mismatches *)
   let ok = ref true in
   let () =
-    let compare (value1, _var1) (value2, _var2) =
-      Simple.compare value1 value2
+    let compare (kind1, value1, _var1) (kind2, value2, _var2) =
+      let c = Flambda_kind.With_subkind.compare kind1 kind2 in
+      if c = 0 then Simple.compare value1 value2 else c
     in
     iter2_merged (value_slots_by_value set1) (value_slots_by_value set2)
       ~compare ~f:(fun elt1 elt2 ->
         match elt1, elt2 with
         | None, None -> ()
         | Some _, None | None, Some _ -> ok := false
-        | Some (_value1, var1), Some (_value2, var2) -> (
+        | Some (_kind1, _value1, var1), Some (_kind2, _value2, var2) -> (
           match value_slots env var1 var2 with
           | Equivalent -> ()
           | Different { approximant = _ } -> ok := false))
diff --git a/middle_end/flambda2/from_lambda/closure_conversion.ml b/middle_end/flambda2/from_lambda/closure_conversion.ml
index 4a37d248840..654fc2a1510 100644
--- a/middle_end/flambda2/from_lambda/closure_conversion.ml
+++ b/middle_end/flambda2/from_lambda/closure_conversion.ml
@@ -55,7 +55,10 @@ let declare_symbol_for_function_slot env ident function_slot : Env.t * Symbol.t
       (Compilation_unit.get_current_exn ())
       (Linkage_name.of_string (Function_slot.to_string function_slot))
   in
-  let env = Env.add_simple_to_substitute env ident (Simple.symbol symbol) in
+  let env =
+    Env.add_simple_to_substitute env ident (Simple.symbol symbol)
+      K.With_subkind.any_value
+  in
   env, symbol
 
 let register_const0 acc constant name =
@@ -163,16 +166,18 @@ let close_const acc const =
   let named = Named.create_simple simple in
   acc, named, name
 
-let find_simple_from_id env id =
+let find_simple_from_id_with_kind env id =
   match Env.find_simple_to_substitute_exn env id with
-  | simple -> simple
+  | simple, kind -> simple, kind
   | exception Not_found -> (
     match Env.find_var_exn env id with
     | exception Not_found ->
       Misc.fatal_errorf
         "find_simple_from_id: Cannot find [Ident] %a in environment" Ident.print
         id
-    | var -> Simple.var var)
+    | var, kind -> Simple.var var, kind)
+
+let find_simple_from_id env id = fst (find_simple_from_id_with_kind env id)
 
 (* CR mshinwell: Avoid the double lookup *)
 let find_simple acc env (simple : IR.simple) =
@@ -723,15 +728,16 @@ let close_named acc env ~let_bound_var (named : IR.named)
       (fun acc named -> k acc (Some named))
   | Prim { prim; args; loc; exn_continuation; region } ->
     close_primitive acc env ~let_bound_var named prim ~args loc exn_continuation
-      ~current_region:(Env.find_var env region) k
+      ~current_region:(fst (Env.find_var env region))
+      k
 
-let close_let acc env id user_visible defining_expr
+let close_let acc env id user_visible kind defining_expr
     ~(body : Acc.t -> Env.t -> Expr_with_acc.t) : Expr_with_acc.t =
-  let body_env, var = Env.add_var_like env id user_visible in
+  let body_env, var = Env.add_var_like env id user_visible kind in
   let cont acc (defining_expr : Named.t option) =
     match defining_expr with
     | Some (Simple simple) ->
-      let body_env = Env.add_simple_to_substitute env id simple in
+      let body_env = Env.add_simple_to_substitute env id simple kind in
       body acc body_env
     | None -> body acc body_env
     | Some (Prim ((Nullary Begin_region | Unary (End_region, _)), _))
@@ -795,7 +801,8 @@ let close_let acc env id user_visible defining_expr
               (* In spirit, this is the same as the simple case but more
                  cumbersome to detect, we have to remove the now useless
                  let-binding later. *)
-              Some (Env.add_simple_to_substitute env id (Simple.symbol sym))
+              Some
+                (Env.add_simple_to_substitute env id (Simple.symbol sym) kind)
             | _ ->
               Some (Env.add_value_approximation body_env (Name.var var) approx))
           )
@@ -827,17 +834,16 @@ let close_let_cont acc env ~name ~is_exn_handler ~params
       Misc.fatal_errorf
         "[Let_cont]s marked as exception handlers must be [Nonrecursive]: %a"
         Continuation.print name);
-  let params_with_kinds = params in
-  let handler_env, params =
-    Env.add_vars_like env
-      (List.map
-         (fun (param, user_visible, _kind) -> param, user_visible)
-         params)
+  let params_with_kinds =
+    List.map
+      (fun (param, user_visible, kind) ->
+        param, user_visible, K.With_subkind.from_lambda kind)
+      params
   in
+  let handler_env, params = Env.add_vars_like env params_with_kinds in
   let handler_params =
     List.map2
-      (fun param (_, _, kind) ->
-        BP.create param (K.With_subkind.from_lambda kind))
+      (fun param (_, _, kind) -> BP.create param kind)
       params params_with_kinds
     |> Bound_parameters.create
   in
@@ -847,13 +853,13 @@ let close_let_cont acc env ~name ~is_exn_handler ~params
       | None -> handler_env
       | Some args ->
         List.fold_left2
-          (fun env arg_approx (param, (param_id, _, _)) ->
+          (fun env arg_approx (param, (param_id, _, kind)) ->
             let env =
               Env.add_value_approximation env (Name.var param) arg_approx
             in
             match (arg_approx : Env.value_approximation) with
             | Value_symbol s | Closure_approximation { symbol = Some s; _ } ->
-              Env.add_simple_to_substitute env param_id (Simple.symbol s)
+              Env.add_simple_to_substitute env param_id (Simple.symbol s) kind
             | _ -> env)
           handler_env args
           (List.combine params params_with_kinds)
@@ -888,7 +894,7 @@ let close_exact_or_unknown_apply acc env
   let callee = find_simple_from_id env func in
   let current_region =
     match replace_region with
-    | None -> Env.find_var env region
+    | None -> fst (Env.find_var env region)
     | Some region -> region
   in
   let mode = Alloc_mode.For_types.from_lambda mode in
@@ -1188,7 +1194,10 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot decl
           in
           let simple = Simple.with_coercion (Simple.var var) coerce_to_deeper in
           let approx = Function_slot.Map.find function_slot approx_map in
-          let env = Env.add_simple_to_substitute env let_rec_ident simple in
+          let env =
+            Env.add_simple_to_substitute env let_rec_ident simple
+              K.With_subkind.any_value
+          in
           let env = Env.add_value_approximation env (Name.var var) approx in
           to_bind, env)
         (Variable.Map.empty, closure_env)
@@ -1197,23 +1206,27 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot decl
   let closure_env =
     Ident.Map.fold
       (fun id var env ->
-        Simple.pattern_match
-          (find_simple_from_id external_env id)
+        let simple, kind = find_simple_from_id_with_kind external_env id in
+        Simple.pattern_match simple
           ~const:(fun _ -> assert false)
           ~name:(fun name ~coercion:_ ->
-            Env.add_approximation_alias (Env.add_var env id var) name
-              (Name.var var)))
+            Env.add_approximation_alias
+              (Env.add_var env id var kind)
+              name (Name.var var)))
       value_slots_for_idents closure_env
   in
   let closure_env =
     List.fold_right
-      (fun (id, _) env ->
-        let env, _var = Env.add_var_like env id User_visible in
+      (fun (id, kind) env ->
+        let env, _var =
+          Env.add_var_like env id User_visible (K.With_subkind.from_lambda kind)
+        in
         env)
       params closure_env
   in
   let closure_env, my_region =
     Env.add_var_like closure_env my_region Not_user_visible
+      K.With_subkind.region
   in
   let closure_env = Env.with_depth closure_env my_depth in
   let closure_env, absolute_history, relative_history =
@@ -1233,7 +1246,7 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot decl
      as stubs but certainly should be. *)
   let stub = Function_decl.stub decl in
   let param_vars =
-    List.map (fun (id, kind) -> Env.find_var closure_env id, kind) params
+    List.map (fun (id, kind) -> fst (Env.find_var closure_env id), kind) params
   in
   let params =
     List.map
@@ -1284,7 +1297,11 @@ let close_one_function acc ~code_id ~external_env ~by_function_slot decl
         let named =
           Named.create_prim
             (Unary
-               ( Project_value_slot { project_from = function_slot; value_slot },
+               ( Project_value_slot
+                   { project_from = function_slot;
+                     value_slot;
+                     kind = K.With_subkind.any_value
+                   },
                  my_closure' ))
             Debuginfo.none
         in
@@ -1404,7 +1421,7 @@ let close_functions acc external_env ~current_region function_declarations =
         let has_non_var_subst, subst_var =
           match Env.find_simple_to_substitute_exn external_env id with
           | exception Not_found -> false, None
-          | simple ->
+          | simple, _kind ->
             Simple.pattern_match simple
               ~const:(fun _ -> true, None)
               ~name:(fun name ~coercion:_ ->
@@ -1580,11 +1597,13 @@ let close_functions acc external_env ~current_region function_declarations =
   let value_slots =
     Ident.Map.fold
       (fun id value_slot map ->
-        let external_simple = find_simple_from_id external_env id in
+        let external_simple, kind =
+          find_simple_from_id_with_kind external_env id
+        in
         (* We're sure [external_simple] is a variable since
            [value_slot_from_idents] has already filtered constants and symbols
            out. *)
-        Value_slot.Map.add value_slot external_simple map)
+        Value_slot.Map.add value_slot (external_simple, kind) map)
       value_slots_from_idents Value_slot.Map.empty
   in
   let set_of_closures =
@@ -1621,12 +1640,14 @@ let close_functions acc external_env ~current_region function_declarations =
 
 let close_let_rec acc env ~function_declarations
     ~(body : Acc.t -> Env.t -> Expr_with_acc.t) ~current_region =
-  let current_region = Env.find_var env current_region in
+  let current_region = fst (Env.find_var env current_region) in
   let env =
     List.fold_right
       (fun decl env ->
         let id = Function_decl.let_rec_ident decl in
-        let env, _var = Env.add_var_like env id User_visible in
+        let env, _var =
+          Env.add_var_like env id User_visible K.With_subkind.any_value
+        in
         env)
       function_declarations env
   in
@@ -1634,7 +1655,9 @@ let close_let_rec acc env ~function_declarations
     List.fold_left
       (fun (fun_vars_map, ident_map) decl ->
         let ident = Function_decl.let_rec_ident decl in
-        let fun_var = VB.create (Env.find_var env ident) Name_mode.normal in
+        let fun_var =
+          VB.create (fst (Env.find_var env ident)) Name_mode.normal
+        in
         let function_slot = Function_decl.function_slot decl in
         ( Function_slot.Map.add function_slot fun_var fun_vars_map,
           Function_slot.Map.add function_slot ident ident_map ))
@@ -1678,6 +1701,7 @@ let close_let_rec acc env ~function_declarations
           let ident = Function_slot.Map.find function_slot ident_map in
           let env =
             Env.add_simple_to_substitute env ident (Simple.symbol symbol)
+              K.With_subkind.any_value
           in
           Env.add_value_approximation env (Name.symbol symbol) approx)
         symbols env
@@ -1839,7 +1863,7 @@ let wrap_over_application acc env full_call (apply : IR.apply) over_args
   in
   let apply_region =
     match needs_region with
-    | None -> Env.find_var env apply.region
+    | None -> fst (Env.find_var env apply.region)
     | Some (region, _) -> region
   in
   let perform_over_application acc =
@@ -2117,6 +2141,7 @@ let close_program (type mode) ~(mode : mode Flambda_features.mode) ~big_endian
   let return_cont = Continuation.create ~sort:Toplevel_return () in
   let env, toplevel_my_region =
     Env.add_var_like env toplevel_my_region Not_user_visible
+      Flambda_kind.With_subkind.region
   in
   let slot_offsets = Slot_offsets.empty in
   let acc = Acc.create ~slot_offsets in
diff --git a/middle_end/flambda2/from_lambda/closure_conversion.mli b/middle_end/flambda2/from_lambda/closure_conversion.mli
index 9666a0a6ce5..d5f25b53426 100644
--- a/middle_end/flambda2/from_lambda/closure_conversion.mli
+++ b/middle_end/flambda2/from_lambda/closure_conversion.mli
@@ -27,6 +27,7 @@ val close_let :
   Env.t ->
   Ident.t ->
   IR.user_visible ->
+  Flambda_kind.With_subkind.t ->
   IR.named ->
   body:(Acc.t -> Env.t -> Expr_with_acc.t) ->
   Expr_with_acc.t
diff --git a/middle_end/flambda2/from_lambda/closure_conversion_aux.ml b/middle_end/flambda2/from_lambda/closure_conversion_aux.ml
index 4eee4c076d6..214d8899195 100644
--- a/middle_end/flambda2/from_lambda/closure_conversion_aux.ml
+++ b/middle_end/flambda2/from_lambda/closure_conversion_aux.ml
@@ -131,9 +131,10 @@ module Env = struct
   type value_approximation = Code_or_metadata.t Value_approximation.t
 
   type t =
-    { variables : Variable.t Ident.Map.t;
+    { variables : (Variable.t * Flambda_kind.With_subkind.t) Ident.Map.t;
       globals : Symbol.t Numeric_types.Int.Map.t;
-      simples_to_substitute : Simple.t Ident.Map.t;
+      simples_to_substitute :
+        (Simple.t * Flambda_kind.With_subkind.t) Ident.Map.t;
       current_unit : Compilation_unit.t;
       current_depth : Variable.t option;
       value_approximations : value_approximation Name.Map.t;
@@ -229,7 +230,7 @@ module Env = struct
       } =
     let simples_to_substitute =
       Ident.Map.filter
-        (fun _ simple -> not (Simple.is_var simple))
+        (fun _ (simple, _kind) -> not (Simple.is_var simple))
         simples_to_substitute
     in
     { variables = Ident.Map.empty;
@@ -246,35 +247,37 @@ module Env = struct
 
   let with_depth t depth_var = { t with current_depth = Some depth_var }
 
-  let add_var t id var = { t with variables = Ident.Map.add id var t.variables }
+  let add_var t id var kind =
+    { t with variables = Ident.Map.add id (var, kind) t.variables }
 
-  let add_vars t ids vars = List.fold_left2 add_var t ids vars
+  let add_vars t ids vars =
+    List.fold_left2 (fun t id (var, kind) -> add_var t id var kind) t ids vars
 
   let add_var_map t map =
     { t with variables = Ident.Map.union_right t.variables map }
 
-  let add_var_like t id (user_visible : IR.user_visible) =
+  let add_var_like t id (user_visible : IR.user_visible) kind =
     let user_visible =
       match user_visible with
       | Not_user_visible -> None
       | User_visible -> Some ()
     in
     let var = Variable.create_with_same_name_as_ident ?user_visible id in
-    add_var t id var, var
+    add_var t id var kind, var
 
   let add_vars_like t ids =
     let vars =
       List.map
-        (fun (id, (user_visible : IR.user_visible)) ->
+        (fun (id, (user_visible : IR.user_visible), kind) ->
           let user_visible =
             match user_visible with
             | Not_user_visible -> None
             | User_visible -> Some ()
           in
-          Variable.create_with_same_name_as_ident ?user_visible id)
+          Variable.create_with_same_name_as_ident ?user_visible id, kind)
         ids
     in
-    add_vars t (List.map fst ids) vars, vars
+    add_vars t (List.map (fun (id, _, _) -> id) ids) vars, List.map fst vars
 
   let find_var t id =
     try Ident.Map.find id t.variables
@@ -285,9 +288,9 @@ module Env = struct
 
   let find_var_exn t id = Ident.Map.find id t.variables
 
-  let find_name t id = Name.var (find_var t id)
+  let find_name t id = Name.var (fst (find_var t id))
 
-  let find_name_exn t id = Name.var (find_var_exn t id)
+  let find_name_exn t id = Name.var (fst (find_var_exn t id))
 
   let find_vars t ids = List.map (fun id -> find_var t id) ids
 
@@ -300,13 +303,14 @@ module Env = struct
       Misc.fatal_error
         ("Closure_conversion.Env.find_global: global " ^ string_of_int pos)
 
-  let add_simple_to_substitute t id simple =
+  let add_simple_to_substitute t id simple kind =
     if Ident.Map.mem id t.simples_to_substitute
     then
       Misc.fatal_errorf "Cannot redefine [Simple] associated with %a"
         Ident.print id;
     { t with
-      simples_to_substitute = Ident.Map.add id simple t.simples_to_substitute
+      simples_to_substitute =
+        Ident.Map.add id (simple, kind) t.simples_to_substitute
     }
 
   let add_simple_to_substitute_map t map =
diff --git a/middle_end/flambda2/from_lambda/closure_conversion_aux.mli b/middle_end/flambda2/from_lambda/closure_conversion_aux.mli
index 8314c27c8a7..f415043e7e7 100644
--- a/middle_end/flambda2/from_lambda/closure_conversion_aux.mli
+++ b/middle_end/flambda2/from_lambda/closure_conversion_aux.mli
@@ -104,36 +104,49 @@ module Env : sig
 
   val clear_local_bindings : t -> t
 
-  val add_var : t -> Ident.t -> Variable.t -> t
+  val add_var : t -> Ident.t -> Variable.t -> Flambda_kind.With_subkind.t -> t
 
-  val add_vars : t -> Ident.t list -> Variable.t list -> t
+  val add_vars :
+    t -> Ident.t list -> (Variable.t * Flambda_kind.With_subkind.t) list -> t
 
-  val add_var_map : t -> Variable.t Ident.Map.t -> t
+  val add_var_map :
+    t -> (Variable.t * Flambda_kind.With_subkind.t) Ident.Map.t -> t
 
-  val add_var_like : t -> Ident.t -> IR.user_visible -> t * Variable.t
+  val add_var_like :
+    t ->
+    Ident.t ->
+    IR.user_visible ->
+    Flambda_kind.With_subkind.t ->
+    t * Variable.t
 
   val add_vars_like :
-    t -> (Ident.t * IR.user_visible) list -> t * Variable.t list
+    t ->
+    (Ident.t * IR.user_visible * Flambda_kind.With_subkind.t) list ->
+    t * Variable.t list
 
   val find_name : t -> Ident.t -> Name.t
 
   val find_name_exn : t -> Ident.t -> Name.t
 
-  val find_var : t -> Ident.t -> Variable.t
+  val find_var : t -> Ident.t -> Variable.t * Flambda_kind.With_subkind.t
 
-  val find_var_exn : t -> Ident.t -> Variable.t
+  val find_var_exn : t -> Ident.t -> Variable.t * Flambda_kind.With_subkind.t
 
-  val find_vars : t -> Ident.t list -> Variable.t list
+  val find_vars :
+    t -> Ident.t list -> (Variable.t * Flambda_kind.With_subkind.t) list
 
   val add_global : t -> int -> Symbol.t -> t
 
   val find_global : t -> int -> Symbol.t
 
-  val add_simple_to_substitute : t -> Ident.t -> Simple.t -> t
+  val add_simple_to_substitute :
+    t -> Ident.t -> Simple.t -> Flambda_kind.With_subkind.t -> t
 
-  val add_simple_to_substitute_map : t -> Simple.t Ident.Map.t -> t
+  val add_simple_to_substitute_map :
+    t -> (Simple.t * Flambda_kind.With_subkind.t) Ident.Map.t -> t
 
-  val find_simple_to_substitute_exn : t -> Ident.t -> Simple.t
+  val find_simple_to_substitute_exn :
+    t -> Ident.t -> Simple.t * Flambda_kind.With_subkind.t
 
   val add_value_approximation : t -> Name.t -> value_approximation -> t
 
diff --git a/middle_end/flambda2/from_lambda/lambda_to_flambda.ml b/middle_end/flambda2/from_lambda/lambda_to_flambda.ml
index e73d5378c25..451d1e9aa04 100644
--- a/middle_end/flambda2/from_lambda/lambda_to_flambda.ml
+++ b/middle_end/flambda2/from_lambda/lambda_to_flambda.ml
@@ -78,6 +78,9 @@ module Env : sig
 
   val get_mutable_variable : t -> Ident.t -> Ident.t
 
+  val get_mutable_variable_with_kind :
+    t -> Ident.t -> Ident.t * Lambda.value_kind
+
   (** About local allocation regions:
 
       In this pass, we have to transform [Lregion] expressions in Lambda to
@@ -345,11 +348,13 @@ end = struct
   let extra_args_for_continuation t cont =
     List.map fst (extra_args_for_continuation_with_kinds t cont)
 
-  let get_mutable_variable t id =
+  let get_mutable_variable_with_kind t id =
     match Ident.Map.find id t.current_values_of_mutables_in_scope with
     | exception Not_found ->
       Misc.fatal_errorf "Mutable variable %a not bound in env" Ident.print id
-    | id, _kind -> id
+    | id, kind -> id, kind
+
+  let get_mutable_variable t id = fst (get_mutable_variable_with_kind t id)
 
   let entering_region t id ~continuation_closing_region
       ~continuation_after_closing_region =
@@ -532,7 +537,8 @@ let compile_staticfail acc env ccenv ~(continuation : Continuation.t) ~args :
       fun acc ccenv ->
         CC.close_let acc ccenv
           (Ident.create_local "unit")
-          Not_user_visible (End_region region) ~body
+          Not_user_visible Flambda_kind.With_subkind.tagged_immediate
+          (End_region region) ~body
     in
     let no_end_region after_everything = after_everything in
     match
@@ -774,8 +780,8 @@ let restore_continuation_context acc env ccenv cont ~close_early body =
     if close_early
     then
       CC.close_let acc ccenv (Ident.create_local "unit")
-        Not_user_visible (End_region region) ~body:(fun acc ccenv ->
-          body acc ccenv cont)
+        Not_user_visible Flambda_kind.With_subkind.tagged_immediate
+        (End_region region) ~body:(fun acc ccenv -> body acc ccenv cont)
     else
       let ({ continuation_closing_region; continuation_after_closing_region }
             : Env.region_closure_continuation) =
@@ -929,6 +935,82 @@ let primitive_can_raise (prim : Lambda.primitive) =
   | Pprobe_is_enabled _ | Pobj_dup | Pobj_magic ->
     false
 
+let primitive_result_kind (prim : Lambda.primitive) :
+    Flambda_kind.With_subkind.t =
+  match prim with
+  | Pccall { prim_native_repr_res = _, Untagged_int; _ } ->
+    Flambda_kind.With_subkind.tagged_immediate
+  | Pccall { prim_native_repr_res = _, Unboxed_float; _ }
+  | Pfloatofint _ | Pnegfloat _ | Pabsfloat _ | Paddfloat _ | Psubfloat _
+  | Pmulfloat _ | Pdivfloat _ | Pfloatfield _
+  | Parrayrefs Pfloatarray
+  | Parrayrefu Pfloatarray
+  | Pbigarrayref (_, _, (Pbigarray_float32 | Pbigarray_float64), _) ->
+    Flambda_kind.With_subkind.boxed_float
+  | Pccall { prim_native_repr_res = _, Unboxed_integer Pnativeint; _ }
+  | Pbigarrayref (_, _, Pbigarray_native_int, _) ->
+    Flambda_kind.With_subkind.boxed_nativeint
+  | Pccall { prim_native_repr_res = _, Unboxed_integer Pint32; _ }
+  | Pstring_load_32 _ | Pbytes_load_32 _ | Pbigstring_load_32 _
+  | Pbigarrayref (_, _, Pbigarray_int32, _) ->
+    Flambda_kind.With_subkind.boxed_int32
+  | Pccall { prim_native_repr_res = _, Unboxed_integer Pint64; _ }
+  | Pstring_load_64 _ | Pbytes_load_64 _ | Pbigstring_load_64 _
+  | Pbigarrayref (_, _, Pbigarray_int64, _) ->
+    Flambda_kind.With_subkind.boxed_int64
+  | Pnegint | Paddint | Psubint | Pmulint | Pandint | Porint | Pxorint | Plslint
+  | Plsrint | Pasrint | Pmodint _ | Pdivint _ | Pignore | Psequand | Psequor
+  | Pnot | Pbytesrefs | Pstringrefs | Pbytessets | Pstring_load_16 _
+  | Pbytes_load_16 _ | Pbigstring_load_16 _ | Pbytes_set_16 _ | Pbytes_set_32 _
+  | Pbytes_set_64 _ | Pbigstring_set_16 _ | Pbigstring_set_32 _
+  | Pbigstring_set_64 _ | Pintcomp _ | Pcompare_ints | Pcompare_floats
+  | Pcompare_bints _ | Pintoffloat | Pfloatcomp _ | Parraysets _
+  | Pbigarrayset _ | Psetfield _ | Psetfield_computed _ | Psetfloatfield _
+  | Pstringlength | Pstringrefu | Pbyteslength | Pbytesrefu | Pbytessetu
+  | Parraylength _ | Parraysetu _ | Pisint _ | Pbintcomp _ | Pintofbint _
+  | Pisout
+  | Parrayrefs Pintarray
+  | Parrayrefu Pintarray
+  | Pprobe_is_enabled _ | Pctconst _ | Pbswap16
+  | Pbigarrayref
+      ( _,
+        _,
+        ( Pbigarray_sint8 | Pbigarray_uint8 | Pbigarray_sint16
+        | Pbigarray_uint16 | Pbigarray_caml_int ),
+        _ ) ->
+    Flambda_kind.With_subkind.tagged_immediate
+  | Pdivbint { size = bi; _ }
+  | Pmodbint { size = bi; _ }
+  | Pandbint (bi, _)
+  | Porbint (bi, _)
+  | Pxorbint (bi, _)
+  | Plslbint (bi, _)
+  | Plsrbint (bi, _)
+  | Pasrbint (bi, _)
+  | Pnegbint (bi, _)
+  | Paddbint (bi, _)
+  | Psubbint (bi, _)
+  | Pmulbint (bi, _)
+  | Pbintofint (bi, _)
+  | Pcvtbint (_, bi, _)
+  | Pbbswap (bi, _) -> (
+    match bi with
+    | Pint32 -> Flambda_kind.With_subkind.boxed_int32
+    | Pint64 -> Flambda_kind.With_subkind.boxed_int64
+    | Pnativeint -> Flambda_kind.With_subkind.boxed_nativeint)
+  | Pccall { prim_native_repr_res = _, Same_as_ocaml_repr; _ }
+  | Praise _
+  | Parrayrefs (Pgenarray | Paddrarray)
+  | Parrayrefu (Pgenarray | Paddrarray)
+  | Pbytes_to_string | Pbytes_of_string | Pgetglobal _ | Psetglobal _
+  | Pgetpredef _ | Pmakeblock _ | Pmakefloatblock _ | Pfield _
+  | Pfield_computed _ | Pduprecord _ | Poffsetint _ | Poffsetref _
+  | Pmakearray _ | Pduparray _ | Pbigarraydim _
+  | Pbigarrayref
+      (_, _, (Pbigarray_complex32 | Pbigarray_complex64 | Pbigarray_unknown), _)
+  | Pint_as_pointer | Popaque | Pobj_dup | Pobj_magic ->
+    Flambda_kind.With_subkind.any_value
+
 type cps_continuation =
   | Tail of Continuation.t
   | Non_tail of (Acc.t -> Env.t -> CCenv.t -> IR.simple -> Expr_with_acc.t)
@@ -951,12 +1033,12 @@ let maybe_insert_let_cont result_var_name kind k acc env ccenv body =
       ~handler:(fun acc env ccenv -> k acc env ccenv (IR.Var result_var))
       ~body
 
-let name_if_not_var acc ccenv name simple body =
+let name_if_not_var acc ccenv name simple kind body =
   match simple with
   | IR.Var id -> body id acc ccenv
   | IR.Const _ ->
     let id = Ident.create_local name in
-    CC.close_let acc ccenv id Not_user_visible (IR.Simple simple)
+    CC.close_let acc ccenv id Not_user_visible kind (IR.Simple simple)
       ~body:(body id)
 
 let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
@@ -980,6 +1062,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
         ap_specialised = _;
         ap_probe
       } ->
+    (* Note that we don't need kind information about [ap_args] since we already
+       have it on the corresponding [Simple]s in the environment. *)
     maybe_insert_let_cont "apply_result" Pgenval k acc env ccenv
       (fun acc env ccenv k ->
         cps_tail_apply acc env ccenv ap_func ap_args ap_region_close ap_mode
@@ -1002,7 +1086,9 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
       ~handler:(fun acc env ccenv ->
         let env, new_id = Env.register_mutable_variable env id value_kind in
         let body acc ccenv = cps acc env ccenv body k k_exn in
-        CC.close_let acc ccenv new_id User_visible (Simple (Var temp_id)) ~body)
+        CC.close_let acc ccenv new_id User_visible
+          (Flambda_kind.With_subkind.from_lambda value_kind)
+          (Simple (Var temp_id)) ~body)
   | Llet ((Strict | Alias | StrictOpt), Pgenval, fun_id, Lfunction func, body)
     ->
     (* This case is here to get function names right. *)
@@ -1018,14 +1104,16 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
     let_expr acc ccenv
   | Llet
       ( (Strict | Alias | StrictOpt),
-        ( Pgenval | Pfloatval | Pboxedintval _ | Pintval | Pvariant _
-        | Parrayval _ ),
+        (( Pgenval | Pfloatval | Pboxedintval _ | Pintval | Pvariant _
+         | Parrayval _ ) as value_kind),
         id,
         Lconst const,
         body ) ->
     (* This case avoids extraneous continuations. *)
     let body acc ccenv = cps acc env ccenv body k k_exn in
-    CC.close_let acc ccenv id User_visible (Simple (Const const)) ~body
+    CC.close_let acc ccenv id User_visible
+      (Flambda_kind.With_subkind.from_lambda value_kind)
+      (Simple (Const const)) ~body
   | Llet
       ( ((Strict | Alias | StrictOpt) as let_kind),
         (( Pgenval | Pfloatval | Pboxedintval _ | Pintval | Pvariant _
@@ -1050,6 +1138,7 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
           let body acc ccenv = cps acc env ccenv body k k_exn in
           let region = Env.current_region env in
           CC.close_let acc ccenv id User_visible
+            (Flambda_kind.With_subkind.from_lambda value_kind)
             (Prim { prim; args; loc; exn_continuation; region })
             ~body)
         k_exn
@@ -1074,9 +1163,15 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
         let body acc ccenv =
           let body acc ccenv = cps acc env ccenv body k k_exn in
           CC.close_let acc ccenv id Not_user_visible
+            Flambda_kind.With_subkind.tagged_immediate
             (Simple (Const L.const_unit)) ~body
         in
-        CC.close_let acc ccenv new_id User_visible (Simple new_value) ~body)
+        let value_kind =
+          snd (Env.get_mutable_variable_with_kind env being_assigned)
+        in
+        CC.close_let acc ccenv new_id User_visible
+          (Flambda_kind.With_subkind.from_lambda value_kind)
+          (Simple new_value) ~body)
       k_exn
   | Llet
       ( (Strict | Alias | StrictOpt),
@@ -1095,7 +1190,7 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
      value_kind. *)
   (* let k acc env ccenv value =
    *   let body acc ccenv = cps acc env ccenv body k k_exn in
-   *   CC.close_let acc ccenv id User_visible (Simple value) ~body
+   *   CC.close_let acc ccenv id User_visible value_kind (Simple value) ~body
    * in
    * cps_non_tail_simple acc env ccenv defining_expr k k_exn *)
   | Lletrec (bindings, body) -> (
@@ -1126,6 +1221,7 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
         (fun acc env ccenv args ->
           let body acc ccenv = apply_cps_cont ~dbg k acc env ccenv result_var in
           CC.close_let acc ccenv result_var Not_user_visible
+            (primitive_result_kind prim)
             (Prim { prim; args; loc; exn_continuation; region = current_region })
             ~body)
         k_exn
@@ -1179,6 +1275,7 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
     cps_non_tail_simple acc env ccenv obj
       (fun acc env ccenv obj ->
         cps_non_tail_var "meth" acc env ccenv meth
+          Flambda_kind.With_subkind.any_value
           (fun acc env ccenv meth ->
             cps_non_tail_list acc env ccenv args
               (fun acc env ccenv args ->
@@ -1225,6 +1322,7 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
        ensure that the parent does not get deleted unless the try region is
        unused. *)
     CC.close_let acc ccenv region Not_user_visible
+      Flambda_kind.With_subkind.region
       (Begin_region { try_region_parent = Some (Env.current_region env) })
       ~body:(fun acc ccenv ->
         maybe_insert_let_cont "try_with_result" kind k acc env ccenv
@@ -1255,7 +1353,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
                       [IR.Var body_result]))
               ~handler:(fun acc env ccenv ->
                 CC.close_let acc ccenv (Ident.create_local "unit")
-                  Not_user_visible (End_region region) ~body:(fun acc ccenv ->
+                  Not_user_visible Flambda_kind.With_subkind.tagged_immediate
+                  (End_region region) ~body:(fun acc ccenv ->
                     let env = Env.leaving_try_region env in
                     cps_tail acc env ccenv handler k k_exn))))
   | Lifthenelse (cond, ifso, ifnot, kind) ->
@@ -1291,7 +1390,12 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
         let body acc ccenv =
           apply_cps_cont_simple k acc env ccenv (Const L.const_unit)
         in
-        CC.close_let acc ccenv new_id User_visible (Simple new_value) ~body)
+        let _, value_kind =
+          Env.get_mutable_variable_with_kind env being_assigned
+        in
+        CC.close_let acc ccenv new_id User_visible
+          (Flambda_kind.With_subkind.from_lambda value_kind)
+          (Simple new_value) ~body)
       k_exn
   | Levent (body, _event) -> cps acc env ccenv body k k_exn
   | Lifused _ ->
@@ -1310,6 +1414,7 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
     let region = Ident.create_local "region" in
     let dbg = Debuginfo.none in
     CC.close_let acc ccenv region Not_user_visible
+      Flambda_kind.With_subkind.region
       (Begin_region { try_region_parent = None })
       ~body:(fun acc ccenv ->
         maybe_insert_let_cont "body_return" Pgenval k acc env ccenv
@@ -1346,7 +1451,8 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
                 cps_tail acc env ccenv body k k_exn)
               ~handler:(fun acc env ccenv ->
                 CC.close_let acc ccenv (Ident.create_local "unit")
-                  Not_user_visible (End_region region) ~body:(fun acc ccenv ->
+                  Not_user_visible Flambda_kind.With_subkind.tagged_immediate
+                  (End_region region) ~body:(fun acc ccenv ->
                     (* Both body and handler will continue at
                        [return_continuation] by default.
                        [restore_region_context] will intercept the
@@ -1357,10 +1463,10 @@ let rec cps acc env ccenv (lam : L.lambda) (k : cps_continuation)
 and cps_non_tail_simple acc env ccenv lam k k_exn =
   cps acc env ccenv lam (Non_tail k) k_exn
 
-and cps_non_tail_var name acc env ccenv lam k k_exn =
+and cps_non_tail_var name acc env ccenv lam kind k k_exn =
   cps_non_tail_simple acc env ccenv lam
     (fun acc env ccenv simple ->
-      name_if_not_var acc ccenv name simple (fun var acc ccenv ->
+      name_if_not_var acc ccenv name simple kind (fun var acc ccenv ->
           k acc env ccenv var))
     k_exn
 
@@ -1370,6 +1476,7 @@ and cps_tail_apply acc env ccenv ap_func ap_args ap_region_close ap_mode ap_loc
   cps_non_tail_list acc env ccenv ap_args
     (fun acc env ccenv args ->
       cps_non_tail_var "func" acc env ccenv ap_func
+        Flambda_kind.With_subkind.any_value
         (fun acc env ccenv func ->
           let exn_continuation : IR.exn_continuation =
             { exn_handler = k_exn;
@@ -1591,6 +1698,7 @@ and cps_switch acc env ccenv (switch : L.lambda_switch) ~condition_dbg
       ([], wrappers) cases
   in
   cps_non_tail_var "scrutinee" acc env ccenv scrutinee
+    Flambda_kind.With_subkind.any_value
     (fun acc env ccenv scrutinee ->
       let consts_rev, wrappers = convert_arms_rev env switch.sw_consts [] in
       let blocks_rev, wrappers =
@@ -1623,7 +1731,7 @@ and cps_switch acc env ccenv (switch : L.lambda_switch) ~condition_dbg
             CC.close_switch acc ccenv ~condition_dbg scrutinee_tag block_switch
           in
           CC.close_let acc ccenv scrutinee_tag Not_user_visible
-            (Get_tag scrutinee) ~body
+            Flambda_kind.With_subkind.naked_immediate (Get_tag scrutinee) ~body
         in
         if switch.sw_numblocks = 0
         then const_switch, wrappers
@@ -1646,6 +1754,7 @@ and cps_switch acc env ccenv (switch : L.lambda_switch) ~condition_dbg
             in
             let region = Env.current_region env in
             CC.close_let acc ccenv is_scrutinee_int Not_user_visible
+              Flambda_kind.With_subkind.naked_immediate
               (Prim
                  { prim = Pisint { variant_only = true };
                    args = [Var scrutinee];
diff --git a/middle_end/flambda2/parser/fexpr_to_flambda.ml b/middle_end/flambda2/parser/fexpr_to_flambda.ml
index dad8af2b36c..06c0857a459 100644
--- a/middle_end/flambda2/parser/fexpr_to_flambda.ml
+++ b/middle_end/flambda2/parser/fexpr_to_flambda.ml
@@ -315,7 +315,8 @@ let unop env (unop : Fexpr.unop) : Flambda_primitive.unary_primitive =
   | Project_value_slot { project_from; value_slot } ->
     let value_slot = fresh_or_existing_value_slot env value_slot in
     let project_from = fresh_or_existing_function_slot env project_from in
-    Project_value_slot { project_from; value_slot }
+    Project_value_slot
+      { project_from; value_slot; kind = Flambda_kind.With_subkind.any_value }
   | Project_function_slot { move_from; move_to } ->
     let move_from = fresh_or_existing_function_slot env move_from in
     let move_to = fresh_or_existing_function_slot env move_to in
@@ -415,9 +416,10 @@ let set_of_closures env fun_decls value_slots =
     |> Function_slot.Lmap.of_list |> Function_declarations.create
   in
   let value_slots = Option.value value_slots ~default:[] in
-  let value_slots : Simple.t Value_slot.Map.t =
+  let value_slots : (Simple.t * Flambda_kind.With_subkind.t) Value_slot.Map.t =
     let convert ({ var; value } : Fexpr.one_value_slot) =
-      fresh_or_existing_value_slot env var, simple env value
+      ( fresh_or_existing_value_slot env var,
+        (simple env value, Flambda_kind.With_subkind.any_value) )
     in
     List.map convert value_slots |> Value_slot.Map.of_list
   in
diff --git a/middle_end/flambda2/parser/flambda_to_fexpr.ml b/middle_end/flambda2/parser/flambda_to_fexpr.ml
index 668cdc5be8b..643a37feaec 100644
--- a/middle_end/flambda2/parser/flambda_to_fexpr.ml
+++ b/middle_end/flambda2/parser/flambda_to_fexpr.ml
@@ -437,7 +437,7 @@ let unop env (op : Flambda_primitive.unary_primitive) : Fexpr.unop =
   | Opaque_identity _ -> Opaque_identity
   | Unbox_number bk -> Unbox_number bk
   | Untag_immediate -> Untag_immediate
-  | Project_value_slot { project_from; value_slot } ->
+  | Project_value_slot { project_from; value_slot; kind = _ } ->
     let project_from = Env.translate_function_slot env project_from in
     let value_slot = Env.translate_value_slot env value_slot in
     Project_value_slot { project_from; value_slot }
@@ -521,7 +521,13 @@ let prim env (p : Flambda_primitive.t) : Fexpr.prim =
 
 let value_slots env map =
   List.map
-    (fun (var, value) ->
+    (fun (var, (value, kind)) ->
+      if not
+           (Flambda_kind.equal
+              (Flambda_kind.With_subkind.kind kind)
+              Flambda_kind.value)
+      then
+        Misc.fatal_errorf "Value slot %a not of kind Value" Simple.print value;
       let var = Env.translate_value_slot env var in
       let value = simple env value in
       { Fexpr.var; value })
diff --git a/middle_end/flambda2/simplify/expr_builder.ml b/middle_end/flambda2/simplify/expr_builder.ml
index d923f93f28a..240d31d4411 100644
--- a/middle_end/flambda2/simplify/expr_builder.ml
+++ b/middle_end/flambda2/simplify/expr_builder.ml
@@ -529,8 +529,9 @@ let create_let_symbols uacc lifted_constant ~body =
                   }
               in
               Binary (Block_load (block_access_kind, Immutable), symbol, index)
-            | Project_value_slot { project_from; value_slot } ->
-              Unary (Project_value_slot { project_from; value_slot }, symbol)
+            | Project_value_slot { project_from; value_slot; kind } ->
+              Unary
+                (Project_value_slot { project_from; value_slot; kind }, symbol)
           in
           ( Named.create_prim prim Debuginfo.none,
             coercion_from_proj_to_var,
diff --git a/middle_end/flambda2/simplify/lifting/lifted_constant.ml b/middle_end/flambda2/simplify/lifting/lifted_constant.ml
index 2369871e7f2..e5e783cd269 100644
--- a/middle_end/flambda2/simplify/lifting/lifted_constant.ml
+++ b/middle_end/flambda2/simplify/lifting/lifted_constant.ml
@@ -294,7 +294,8 @@ let apply_projection t proj =
       | Block_load { index } ->
         T.meet_block_field_simple typing_env ~min_name_mode:Name_mode.normal ty
           index
-      | Project_value_slot { project_from = _; value_slot } ->
+      | Project_value_slot { project_from = _; value_slot; kind = _ } ->
+        (* CR mshinwell: could use [kind]? *)
         T.meet_project_value_slot_simple typing_env
           ~min_name_mode:Name_mode.normal ty value_slot
     in
diff --git a/middle_end/flambda2/simplify/simplify_apply_expr.ml b/middle_end/flambda2/simplify/simplify_apply_expr.ml
index efdf7939e29..71870ecc512 100644
--- a/middle_end/flambda2/simplify/simplify_apply_expr.ml
+++ b/middle_end/flambda2/simplify/simplify_apply_expr.ml
@@ -375,12 +375,7 @@ let simplify_direct_partial_application ~simplify_expr dacc apply
   assert (arity > args_arity);
   let applied_args, remaining_param_arity =
     Misc.Stdlib.List.map2_prefix
-      (fun arg kind ->
-        if not (K.equal (K.With_subkind.kind kind) K.value)
-        then
-          Misc.fatal_errorf "Non-[value] kind in partial application: %a"
-            Apply.print apply;
-        arg)
+      (fun arg kind -> arg, kind)
       args
       (Flambda_arity.With_subkinds.to_list param_arity)
   in
@@ -464,12 +459,13 @@ let simplify_direct_partial_application ~simplify_expr dacc apply
             { var : Variable.t;
               (* name to bind to projected variable *)
               value : Simple.t;
-              (* value to store in closure *)
+              kind : K.With_subkind.t;
+              (* value to store in closure, with kind *)
               value_slot : Value_slot.t
             }
     end in
     let mk_value_slot () = Value_slot.create compilation_unit ~name:"arg" in
-    let applied_value value =
+    let applied_value (value, kind) =
       Simple.pattern_match' value
         ~const:(fun const -> Const const)
         ~symbol:(fun symbol ~coercion ->
@@ -477,11 +473,23 @@ let simplify_direct_partial_application ~simplify_expr dacc apply
           then Symbol symbol
           else
             let var = Variable.create "symbol" in
-            In_closure { var; value; value_slot = mk_value_slot () })
+            if not (K.equal (K.With_subkind.kind kind) K.value)
+            then
+              Misc.fatal_errorf
+                "Simple %a which is a symbol should be of kind Value"
+                Simple.print value;
+            In_closure
+              { var;
+                value;
+                kind = K.With_subkind.any_value;
+                value_slot = mk_value_slot ()
+              })
         ~var:(fun var ~coercion:_ ->
-          In_closure { var; value; value_slot = mk_value_slot () })
+          In_closure { var; value; kind; value_slot = mk_value_slot () })
+    in
+    let applied_callee =
+      applied_value (Apply.callee apply, K.With_subkind.any_value)
     in
-    let applied_callee = applied_value (Apply.callee apply) in
     let applied_args = List.map applied_value applied_args in
     let applied_values = applied_callee :: applied_args in
     let my_closure = Variable.create "my_closure" in
@@ -516,12 +524,12 @@ let simplify_direct_partial_application ~simplify_expr dacc apply
         (fun (expr, cost_metrics, free_names) applied_value ->
           match applied_value with
           | Const _ | Symbol _ -> expr, cost_metrics, free_names
-          | In_closure { var; value_slot; value = _ } ->
+          | In_closure { var; value_slot; value = _; kind } ->
             let arg = VB.create var Name_mode.normal in
             let prim =
               P.Unary
                 ( Project_value_slot
-                    { project_from = wrapper_function_slot; value_slot },
+                    { project_from = wrapper_function_slot; value_slot; kind },
                   Simple.var my_closure )
             in
             let cost_metrics_of_defining_expr =
@@ -594,7 +602,8 @@ let simplify_direct_partial_application ~simplify_expr dacc apply
         (fun value ->
           match value with
           | Const _ | Symbol _ -> None
-          | In_closure { value_slot; value; var = _ } -> Some (value_slot, value))
+          | In_closure { value_slot; value; kind; var = _ } ->
+            Some (value_slot, (value, kind)))
         applied_values
       |> Value_slot.Map.of_list
     in
diff --git a/middle_end/flambda2/simplify/simplify_let_expr.ml b/middle_end/flambda2/simplify/simplify_let_expr.ml
index 29b59c24a5d..18025cb2f82 100644
--- a/middle_end/flambda2/simplify/simplify_let_expr.ml
+++ b/middle_end/flambda2/simplify/simplify_let_expr.ml
@@ -151,7 +151,8 @@ let rebuild_let simplify_named_result removed_operations ~rewrite_id
     in
     after_rebuild body uacc
 
-let record_one_value_slot_for_data_flow symbol value_slot simple data_flow =
+let record_one_value_slot_for_data_flow symbol value_slot (simple, _kind)
+    data_flow =
   Flow.Acc.record_value_slot (Name.symbol symbol) value_slot
     (Simple.free_names simple) data_flow
 
diff --git a/middle_end/flambda2/simplify/simplify_set_of_closures.ml b/middle_end/flambda2/simplify/simplify_set_of_closures.ml
index 622f27d8386..6a02c1c5a5a 100644
--- a/middle_end/flambda2/simplify/simplify_set_of_closures.ml
+++ b/middle_end/flambda2/simplify/simplify_set_of_closures.ml
@@ -615,16 +615,17 @@ let simplify_and_lift_set_of_closures dacc ~closure_bound_vars_inverse
   in
   let value_slot_types =
     Value_slot.Map.map
-      (fun value_slot ->
+      (fun (value_slot, kind_with_subkind) ->
+        let kind = K.With_subkind.kind kind_with_subkind in
         Simple.pattern_match value_slot
-          ~const:(fun _ -> T.alias_type_of K.value value_slot)
+          ~const:(fun _ -> T.alias_type_of kind value_slot)
           ~name:(fun name ~coercion ->
             Name.pattern_match name
               ~var:(fun var ->
                 match Variable.Map.find var closure_bound_vars_inverse with
                 | exception Not_found ->
                   assert (DE.mem_variable (DA.denv dacc) var);
-                  T.alias_type_of K.value value_slot
+                  T.alias_type_of kind value_slot
                 | function_slot ->
                   let closure_symbol =
                     Function_slot.Map.find function_slot closure_symbols_map
@@ -632,8 +633,8 @@ let simplify_and_lift_set_of_closures dacc ~closure_bound_vars_inverse
                   let simple =
                     Simple.with_coercion (Simple.symbol closure_symbol) coercion
                   in
-                  T.alias_type_of K.value simple)
-              ~symbol:(fun _sym -> T.alias_type_of K.value value_slot)))
+                  T.alias_type_of kind simple)
+              ~symbol:(fun _sym -> T.alias_type_of kind value_slot)))
       value_slots
   in
   let context =
@@ -739,7 +740,7 @@ let simplify_non_lifted_set_of_closures0 dacc bound_vars ~closure_bound_vars
 
 type lifting_decision_result =
   { can_lift : bool;
-    value_slots : Simple.t Value_slot.Map.t;
+    value_slots : (Simple.t * K.With_subkind.t) Value_slot.Map.t;
     value_slot_types : T.t Value_slot.Map.t;
     symbol_projections : Symbol_projection.t Variable.Map.t
   }
@@ -757,7 +758,7 @@ let type_value_slots_and_make_lifting_decision_for_one_set dacc
      available.) *)
   let value_slots, value_slot_types, symbol_projections =
     Value_slot.Map.fold
-      (fun value_slot env_entry
+      (fun value_slot (env_entry, kind)
            (value_slots, value_slot_types, symbol_projections) ->
         let env_entry, ty, symbol_projections =
           let ty =
@@ -781,7 +782,9 @@ let type_value_slots_and_make_lifting_decision_for_one_set dacc
           in
           simple, ty, symbol_projections
         in
-        let value_slots = Value_slot.Map.add value_slot env_entry value_slots in
+        let value_slots =
+          Value_slot.Map.add value_slot (env_entry, kind) value_slots
+        in
         let value_slot_types =
           Value_slot.Map.add value_slot ty value_slot_types
         in
@@ -825,7 +828,7 @@ let type_value_slots_and_make_lifting_decision_for_one_set dacc
          | Unknown -> false)
        | Heap -> true
   in
-  let value_slot_permits_lifting _value_slot simple =
+  let value_slot_permits_lifting _value_slot (simple, _kind) =
     can_lift_coercion (Simple.coercion simple)
     && Simple.pattern_match' simple
          ~const:(fun _ -> true)
diff --git a/middle_end/flambda2/simplify/simplify_unary_primitive.ml b/middle_end/flambda2/simplify/simplify_unary_primitive.ml
index c1b7b95ff82..50a9021c36d 100644
--- a/middle_end/flambda2/simplify/simplify_unary_primitive.ml
+++ b/middle_end/flambda2/simplify/simplify_unary_primitive.ml
@@ -43,8 +43,8 @@ let simplify_project_function_slot ~move_from ~move_to ~min_name_mode dacc
            ~this_function_slot:move_from closures)
       ~result_var ~result_kind:K.value
 
-let simplify_project_value_slot function_slot value_slot ~min_name_mode dacc
-    ~original_term ~arg:closure ~arg_ty:closure_ty ~result_var =
+let simplify_project_value_slot function_slot value_slot kind ~min_name_mode
+    dacc ~original_term ~arg:closure ~arg_ty:closure_ty ~result_var =
   let result =
     (* We try a faster method before falling back to [simplify_projection]. *)
     match
@@ -76,14 +76,15 @@ let simplify_project_value_slot function_slot value_slot ~min_name_mode dacc
             (T.closure_with_at_least_this_value_slot
                ~this_function_slot:function_slot value_slot
                ~value_slot_var:(Bound_var.var result_var))
-          ~result_var ~result_kind:K.value
+          ~result_var ~result_kind:(K.With_subkind.kind kind)
       in
       let dacc = DA.add_use_of_value_slot result.dacc value_slot in
       SPR.with_dacc result dacc
   in
   let dacc =
     Simplify_common.add_symbol_projection result.dacc ~projected_from:closure
-      (Symbol_projection.Projection.project_value_slot function_slot value_slot)
+      (Symbol_projection.Projection.project_value_slot function_slot value_slot
+         kind)
       ~projection_bound_to:result_var
   in
   SPR.with_dacc result dacc
@@ -555,8 +556,8 @@ let simplify_unary_primitive dacc original_prim (prim : P.unary_primitive) ~arg
   let original_term = Named.create_prim original_prim dbg in
   let simplifier =
     match prim with
-    | Project_value_slot { project_from; value_slot } ->
-      simplify_project_value_slot project_from value_slot ~min_name_mode
+    | Project_value_slot { project_from; value_slot; kind } ->
+      simplify_project_value_slot project_from value_slot ~min_name_mode kind
     | Project_function_slot { move_from; move_to } ->
       simplify_project_function_slot ~move_from ~move_to ~min_name_mode
     | Unbox_number boxable_number_kind ->
diff --git a/middle_end/flambda2/simplify/unboxing/is_unboxing_beneficial.ml b/middle_end/flambda2/simplify/unboxing/is_unboxing_beneficial.ml
index 6ebd5dc581c..c30062be732 100644
--- a/middle_end/flambda2/simplify/unboxing/is_unboxing_beneficial.ml
+++ b/middle_end/flambda2/simplify/unboxing/is_unboxing_beneficial.ml
@@ -32,13 +32,13 @@ let rec filter_non_beneficial_decisions decision : U.decision =
   | Unbox (Unique_tag_and_size { tag; fields }) ->
     let is_unboxing_beneficial, fields =
       List.fold_left_map
-        (fun is_unboxing_beneficial ({ epa; decision } : U.field_decision) :
-             (_ * U.field_decision) ->
+        (fun is_unboxing_beneficial ({ epa; decision; kind } : U.field_decision)
+             : (_ * U.field_decision) ->
           let is_unboxing_beneficial =
             is_unboxing_beneficial || is_unboxing_beneficial_for_epa epa
           in
           let decision = filter_non_beneficial_decisions decision in
-          is_unboxing_beneficial, { epa; decision })
+          is_unboxing_beneficial, { epa; decision; kind })
         false fields
     in
     if is_unboxing_beneficial
@@ -48,11 +48,11 @@ let rec filter_non_beneficial_decisions decision : U.decision =
     let is_unboxing_beneficial = ref false in
     let vars_within_closure =
       Value_slot.Map.map
-        (fun ({ epa; decision } : U.field_decision) : U.field_decision ->
+        (fun ({ epa; decision; kind } : U.field_decision) : U.field_decision ->
           is_unboxing_beneficial
             := !is_unboxing_beneficial || is_unboxing_beneficial_for_epa epa;
           let decision = filter_non_beneficial_decisions decision in
-          { epa; decision })
+          { epa; decision; kind })
         vars_within_closure
     in
     if !is_unboxing_beneficial
@@ -63,11 +63,12 @@ let rec filter_non_beneficial_decisions decision : U.decision =
     let fields_by_tag =
       Tag.Scannable.Map.map
         (List.map
-           (fun ({ epa; decision } : U.field_decision) : U.field_decision ->
+           (fun ({ epa; decision; kind } : U.field_decision) : U.field_decision
+           ->
              is_unboxing_beneficial
                := !is_unboxing_beneficial || is_unboxing_beneficial_for_epa epa;
              let decision = filter_non_beneficial_decisions decision in
-             { epa; decision }))
+             { epa; decision; kind }))
         fields_by_tag
     in
     if !is_unboxing_beneficial
diff --git a/middle_end/flambda2/simplify/unboxing/optimistic_unboxing_decision.ml b/middle_end/flambda2/simplify/unboxing/optimistic_unboxing_decision.ml
index b8d4bd93020..457ecabdb85 100644
--- a/middle_end/flambda2/simplify/unboxing/optimistic_unboxing_decision.ml
+++ b/middle_end/flambda2/simplify/unboxing/optimistic_unboxing_decision.ml
@@ -128,6 +128,9 @@ and make_optimistic_fields ~add_tag_to_name ~depth tenv param_type (tag : Tag.t)
     then K.naked_float, "unboxed_float_field"
     else K.value, "unboxed_field"
   in
+  let field_kind_with_subkind =
+    K.With_subkind.create field_kind K.With_subkind.Subkind.Anything
+  in
   let field_name n =
     Format.asprintf "%s%a_%d" field_base_name (pp_tag add_tag_to_name) tag n
   in
@@ -168,7 +171,7 @@ and make_optimistic_fields ~add_tag_to_name ~depth tenv param_type (tag : Tag.t)
         let decision =
           make_optimistic_decision ~depth:(depth + 1) tenv ~param_type:var_type
         in
-        { epa; decision })
+        { epa; decision; kind = field_kind_with_subkind })
       field_vars field_types
   in
   fields
@@ -183,5 +186,10 @@ and make_optimistic_vars_within_closure ~depth tenv closures_entry =
       let decision =
         make_optimistic_decision ~depth:(depth + 1) tenv ~param_type:var_type
       in
-      { epa; decision })
+      let kind =
+        K.With_subkind.create
+          (Flambda2_types.kind var_type)
+          K.With_subkind.Subkind.Anything
+      in
+      { epa; decision; kind })
     map
diff --git a/middle_end/flambda2/simplify/unboxing/unboxers.ml b/middle_end/flambda2/simplify/unboxing/unboxers.ml
index b06cabd9918..0172e975148 100644
--- a/middle_end/flambda2/simplify/unboxing/unboxers.ml
+++ b/middle_end/flambda2/simplify/unboxing/unboxers.ml
@@ -139,15 +139,16 @@ module Field = struct
 end
 
 module Closure_field = struct
-  let unboxing_prim function_slot ~closure value_slot =
+  let unboxing_prim function_slot ~closure value_slot kind =
     P.Unary
-      (Project_value_slot { project_from = function_slot; value_slot }, closure)
+      ( Project_value_slot { project_from = function_slot; value_slot; kind },
+        closure )
 
-  let unboxer function_slot value_slot =
+  let unboxer function_slot value_slot kind =
     { var_name = "closure_field_at_use";
       invalid_const = Const.const_zero;
       unboxing_prim =
-        (fun closure -> unboxing_prim function_slot ~closure value_slot);
+        (fun closure -> unboxing_prim function_slot ~closure value_slot kind);
       prove_simple =
         (fun tenv ~min_name_mode t ->
           T.meet_project_value_slot_simple tenv ~min_name_mode t value_slot)
diff --git a/middle_end/flambda2/simplify/unboxing/unboxers.mli b/middle_end/flambda2/simplify/unboxing/unboxers.mli
index ddd4e4e393e..bfa61f223c4 100644
--- a/middle_end/flambda2/simplify/unboxing/unboxers.mli
+++ b/middle_end/flambda2/simplify/unboxing/unboxers.mli
@@ -60,7 +60,13 @@ module Field : sig
 end
 
 module Closure_field : sig
-  val unboxing_prim : Function_slot.t -> closure:Simple.t -> Value_slot.t -> P.t
+  val unboxing_prim :
+    Function_slot.t ->
+    closure:Simple.t ->
+    Value_slot.t ->
+    Flambda_kind.With_subkind.t ->
+    P.t
 
-  val unboxer : Function_slot.t -> Value_slot.t -> unboxer
+  val unboxer :
+    Function_slot.t -> Value_slot.t -> Flambda_kind.With_subkind.t -> unboxer
 end
diff --git a/middle_end/flambda2/simplify/unboxing/unboxing_epa.ml b/middle_end/flambda2/simplify/unboxing/unboxing_epa.ml
index 42649e39f48..e5e7737d91e 100644
--- a/middle_end/flambda2/simplify/unboxing/unboxing_epa.ml
+++ b/middle_end/flambda2/simplify/unboxing/unboxing_epa.ml
@@ -272,7 +272,7 @@ and compute_extra_args_for_block ~pass rewrite_id ~typing_env_at_use
   in
   let _, fields =
     List.fold_left_map
-      (fun field_nth ({ epa; decision } : U.field_decision) :
+      (fun field_nth ({ epa; decision; kind } : U.field_decision) :
            (_ * U.field_decision) ->
         let unboxer =
           Unboxers.Field.unboxer ~invalid_const bak ~index:field_nth
@@ -287,7 +287,7 @@ and compute_extra_args_for_block ~pass rewrite_id ~typing_env_at_use
           compute_extra_args_for_one_decision_and_use ~pass rewrite_id
             ~typing_env_at_use new_arg_being_unboxed decision
         in
-        Targetint_31_63.(add one field_nth), { epa; decision })
+        Targetint_31_63.(add one field_nth), { epa; decision; kind })
       Targetint_31_63.zero fields
   in
   Unbox (Unique_tag_and_size { tag; fields })
@@ -296,8 +296,8 @@ and compute_extra_args_for_closure ~pass rewrite_id ~typing_env_at_use
     arg_being_unboxed function_slot vars_within_closure : U.decision =
   let vars_within_closure =
     Value_slot.Map.mapi
-      (fun var ({ epa; decision } : U.field_decision) : U.field_decision ->
-        let unboxer = Unboxers.Closure_field.unboxer function_slot var in
+      (fun var ({ epa; decision; kind } : U.field_decision) : U.field_decision ->
+        let unboxer = Unboxers.Closure_field.unboxer function_slot var kind in
         let new_extra_arg, new_arg_being_unboxed =
           unbox_arg unboxer ~typing_env_at_use arg_being_unboxed
         in
@@ -308,7 +308,7 @@ and compute_extra_args_for_closure ~pass rewrite_id ~typing_env_at_use
           compute_extra_args_for_one_decision_and_use ~pass rewrite_id
             ~typing_env_at_use new_arg_being_unboxed decision
         in
-        { epa; decision })
+        { epa; decision; kind })
       vars_within_closure
   in
   Unbox (Closure_single_entry { function_slot; vars_within_closure })
@@ -377,7 +377,7 @@ and compute_extra_args_for_variant ~pass rewrite_id ~typing_env_at_use
         let new_fields_decisions, _ =
           List.fold_left
             (fun (new_decisions, field_nth)
-                 ({ epa; decision } : U.field_decision) ->
+                 ({ epa; decision; kind } : U.field_decision) ->
               let new_extra_arg, new_arg_being_unboxed =
                 if are_there_non_const_ctors_at_use
                    && Tag.Scannable.equal tag_at_use_site tag_decision
@@ -398,7 +398,7 @@ and compute_extra_args_for_variant ~pass rewrite_id ~typing_env_at_use
                 compute_extra_args_for_one_decision_and_use ~pass rewrite_id
                   ~typing_env_at_use new_arg_being_unboxed decision
               in
-              let field_decision : U.field_decision = { epa; decision } in
+              let field_decision : U.field_decision = { epa; decision; kind } in
               let new_decisions = field_decision :: new_decisions in
               new_decisions, Targetint_31_63.(add one field_nth))
             ([], Targetint_31_63.zero) block_fields
@@ -412,14 +412,9 @@ let add_extra_params_and_args extra_params_and_args decision =
   let rec aux extra_params_and_args (decision : U.decision) =
     match decision with
     | Do_not_unbox _ -> extra_params_and_args
-    | Unbox (Unique_tag_and_size { tag; fields }) ->
+    | Unbox (Unique_tag_and_size { tag = _; fields }) ->
       List.fold_left
-        (fun extra_params_and_args ({ epa; decision } : U.field_decision) ->
-          let kind =
-            if Tag.equal Tag.double_array_tag tag
-            then K.With_subkind.naked_float
-            else K.With_subkind.any_value
-          in
+        (fun extra_params_and_args ({ epa; decision; kind } : U.field_decision) ->
           let extra_param = BP.create epa.param kind in
           let extra_params_and_args =
             EPA.add extra_params_and_args ~extra_param ~extra_args:epa.args
@@ -428,8 +423,9 @@ let add_extra_params_and_args extra_params_and_args decision =
         extra_params_and_args fields
     | Unbox (Closure_single_entry { function_slot = _; vars_within_closure }) ->
       Value_slot.Map.fold
-        (fun _ ({ epa; decision } : U.field_decision) extra_params_and_args ->
-          let extra_param = BP.create epa.param K.With_subkind.any_value in
+        (fun _ ({ epa; decision; kind } : U.field_decision)
+             extra_params_and_args ->
+          let extra_param = BP.create epa.param kind in
           let extra_params_and_args =
             EPA.add extra_params_and_args ~extra_param ~extra_args:epa.args
           in
@@ -440,10 +436,9 @@ let add_extra_params_and_args extra_params_and_args decision =
         Tag.Scannable.Map.fold
           (fun _ block_fields extra_params_and_args ->
             List.fold_left
-              (fun extra_params_and_args ({ epa; decision } : U.field_decision) ->
-                let extra_param =
-                  BP.create epa.param K.With_subkind.any_value
-                in
+              (fun extra_params_and_args
+                   ({ epa; decision; kind } : U.field_decision) ->
+                let extra_param = BP.create epa.param kind in
                 let extra_params_and_args =
                   EPA.add extra_params_and_args ~extra_param
                     ~extra_args:epa.args
diff --git a/middle_end/flambda2/simplify/unboxing/unboxing_types.ml b/middle_end/flambda2/simplify/unboxing/unboxing_types.ml
index e85ec3ad58e..0efd64cffbb 100644
--- a/middle_end/flambda2/simplify/unboxing/unboxing_types.ml
+++ b/middle_end/flambda2/simplify/unboxing/unboxing_types.ml
@@ -64,7 +64,8 @@ type unboxing_decision =
 
 and field_decision =
   { epa : Extra_param_and_args.t;
-    decision : decision
+    decision : decision;
+    kind : Flambda_kind.With_subkind.t
   }
 
 and const_ctors_decision =
@@ -126,10 +127,11 @@ let rec print_decision ppf = function
       "@[<hv 1>(number@ @[<h>(kind %a)@]@ @[<hv 1>(var %a)@])@]"
       Flambda_kind.Naked_number_kind.print kind Extra_param_and_args.print epa
 
-and print_field_decision ppf { epa; decision } =
+and print_field_decision ppf { epa; decision; kind } =
   Format.fprintf ppf
-    "@[<hv 1>(@,@[<hov 1>(var %a)@]@ @[<hv 1>(decision@ %a)@])@]"
+    "@[<hv 1>(@,@[<hov 1>(var %a)@]@ @[<hv 1>(decision@ %a)@]@ (kind@ %a))@]"
     Extra_param_and_args.print epa print_decision decision
+    Flambda_kind.With_subkind.print kind
 
 and print_fields_decisions ppf l =
   let pp_sep = Format.pp_print_space in
diff --git a/middle_end/flambda2/simplify/unboxing/unboxing_types.mli b/middle_end/flambda2/simplify/unboxing/unboxing_types.mli
index a4ea06e687e..8660f4e8404 100644
--- a/middle_end/flambda2/simplify/unboxing/unboxing_types.mli
+++ b/middle_end/flambda2/simplify/unboxing/unboxing_types.mli
@@ -57,7 +57,8 @@ type unboxing_decision =
 
 and field_decision =
   { epa : Extra_param_and_args.t;
-    decision : decision
+    decision : decision;
+    kind : Flambda_kind.With_subkind.t
   }
 
 and const_ctors_decision =
diff --git a/middle_end/flambda2/simplify_shared/exported_offsets.ml b/middle_end/flambda2/simplify_shared/exported_offsets.ml
index f605411f396..c3483188e03 100644
--- a/middle_end/flambda2/simplify_shared/exported_offsets.ml
+++ b/middle_end/flambda2/simplify_shared/exported_offsets.ml
@@ -19,11 +19,13 @@
     compilation cannot see, all offsets that occur in the current compilation
     unit should be re-exported. *)
 
+type words = int
+
 type function_slot_info =
   | Dead_function_slot
   | Live_function_slot of
-      { offset : int;
-        size : int
+      { offset : words;
+        size : words
             (* Number of fields taken for the function:
 
                2 fields (code pointer + arity) for function of arity one
@@ -33,7 +35,11 @@ type function_slot_info =
 
 type value_slot_info =
   | Dead_value_slot
-  | Live_value_slot of { offset : int }
+  | Live_value_slot of
+      { offset : words;
+        size : words;
+        is_scanned : bool
+      }
 
 type t =
   { function_slot_offsets : function_slot_info Function_slot.Map.t;
@@ -48,7 +54,8 @@ let print_function_slot_info fmt = function
 let print_value_slot_info fmt (info : value_slot_info) =
   match info with
   | Dead_value_slot -> Format.fprintf fmt "@[<h>(removed)@]"
-  | Live_value_slot { offset } -> Format.fprintf fmt "@[<h>(o:%d)@]" offset
+  | Live_value_slot { offset; size; is_scanned } ->
+    Format.fprintf fmt "@[<h>(o:%d, s:%d, v:%b)@]" offset size is_scanned
 
 let [@ocamlformat "disable"] print fmt env =
   Format.fprintf fmt "{@[<v>closures: @[<v>%a@]@,value_slots: @[<v>%a@]@]}"
@@ -74,7 +81,9 @@ let equal_function_slot_info (info1 : function_slot_info)
 let equal_value_slot_info (info1 : value_slot_info) (info2 : value_slot_info) =
   match info1, info2 with
   | Dead_value_slot, Dead_value_slot -> true
-  | Live_value_slot { offset = o1 }, Live_value_slot { offset = o2 } -> o1 = o2
+  | ( Live_value_slot { offset = o1; size = s1; is_scanned = v1 },
+      Live_value_slot { offset = o2; size = s2; is_scanned = v2 } ) ->
+    o1 = o2 && s1 = s2 && v1 = v2
   | Dead_value_slot, Live_value_slot _ | Live_value_slot _, Dead_value_slot ->
     false
 
diff --git a/middle_end/flambda2/simplify_shared/exported_offsets.mli b/middle_end/flambda2/simplify_shared/exported_offsets.mli
index 700b79d7de6..1446ba79679 100644
--- a/middle_end/flambda2/simplify_shared/exported_offsets.mli
+++ b/middle_end/flambda2/simplify_shared/exported_offsets.mli
@@ -15,11 +15,13 @@
 (** Public state to store the mapping from elements of a closure to offset. *)
 type t
 
+type words = int
+
 type function_slot_info =
   | Dead_function_slot
   | Live_function_slot of
-      { offset : int;
-        size : int
+      { offset : words;
+        size : words
             (* Number of fields taken for the function:
 
                2 fields (code pointer + arity) for function of arity one
@@ -29,7 +31,11 @@ type function_slot_info =
 
 type value_slot_info =
   | Dead_value_slot
-  | Live_value_slot of { offset : int }
+  | Live_value_slot of
+      { offset : words;
+        size : words;
+        is_scanned : bool
+      }
 
 (** The empty environment *)
 val empty : t
diff --git a/middle_end/flambda2/simplify_shared/slot_offsets.ml b/middle_end/flambda2/simplify_shared/slot_offsets.ml
index 9e3e10decf6..aac0bd86e64 100644
--- a/middle_end/flambda2/simplify_shared/slot_offsets.ml
+++ b/middle_end/flambda2/simplify_shared/slot_offsets.ml
@@ -32,16 +32,21 @@ type used_slots =
     all_value_slots : Value_slot.Set.t
   }
 
-let[@inline] value_slot_is_used ~used_value_slots v =
-  if Compilation_unit.is_current (Value_slot.get_compilation_unit v)
-  then Value_slot.Set.mem v used_value_slots
-  else true
-
 let[@inline] function_slot_is_used ~used_function_slots v =
   if Compilation_unit.is_current (Function_slot.get_compilation_unit v)
   then Function_slot.Set.mem v used_function_slots
   else true
 
+let[@inline] unboxed_slot_is_used ~used_unboxed_slots v =
+  if Compilation_unit.is_current (Value_slot.get_compilation_unit v)
+  then Value_slot.Set.mem v used_unboxed_slots
+  else true
+
+let[@inline] value_slot_is_used ~used_value_slots v =
+  if Compilation_unit.is_current (Value_slot.get_compilation_unit v)
+  then Value_slot.Set.mem v used_value_slots
+  else true
+
 (* Compute offsets of the runtime memory layout of sets of closures. These
    offsets are computed in words, not in bytes.
 
@@ -69,6 +74,15 @@ let[@inline] function_slot_is_used ~used_function_slots v =
  * | last function slot   |
  * |                      |
  * |----------------------|
+ * | unboxed slot 0       |
+ * |----------------------|
+ * | unboxed slot 1       |
+ * |----------------------|
+ * .                      .
+ * .                      .
+ * |----------------------|
+ * | last unboxed slot    |
+ * |----------------------|
  * | value slot 0  size=1 | <- start of the environment part of the block
  * |----------------------|
  * | value slot 1         |
@@ -82,13 +96,16 @@ let[@inline] function_slot_is_used ~used_function_slots v =
 (* However, that ideal layout may not be possible in certain circumstances, as
    there may be arbitrary holes between slots (i.e. unused words in the block).
 
-   All function slots must occur before all value slots, since the offset to the
-   start of the environment is recorded in the arity field of each function
-   slot. *)
+   Due to the representation above, all function slots must occur before all
+   unboxed slots, which themselves must be before all value slots. *)
 
 module Layout = struct
   type slot =
-    | Value_slot of Value_slot.t
+    | Value_slot of
+        { size : words;
+          is_scanned : bool;
+          value_slot : Value_slot.t
+        }
     | Infix_header
     | Function_slot of
         { size : words;
@@ -103,7 +120,9 @@ module Layout = struct
     }
 
   let print_slot fmt = function
-    | Value_slot v -> Format.fprintf fmt "value_slot %a" Value_slot.print v
+    | Value_slot { size; is_scanned; value_slot } ->
+      Format.fprintf fmt "value_slot(%d,%b) %a" size is_scanned Value_slot.print
+        value_slot
     | Infix_header -> Format.fprintf fmt "infix_header"
     | Function_slot { size; function_slot; last_function_slot } ->
       Format.fprintf fmt "function_slot%s(%d) %a"
@@ -136,8 +155,10 @@ module Layout = struct
       (fun value_slot _ acc ->
         match EO.value_slot_offset env value_slot with
         | Some Dead_value_slot -> acc
-        | Some (Live_value_slot { offset }) ->
-          Numeric_types.Int.Map.add offset (Value_slot value_slot) acc
+        | Some (Live_value_slot { offset; is_scanned; size }) ->
+          Numeric_types.Int.Map.add offset
+            (Value_slot { value_slot; is_scanned; size })
+            acc
         | None ->
           Misc.fatal_errorf "No value slot offset for %a" Value_slot.print
             value_slot)
@@ -167,20 +188,28 @@ module Layout = struct
         (offset, slot) :: (offset - 1, Infix_header) :: acc_slots
       in
       startenv, acc_slots
-    | Value_slot _ ->
+    | Value_slot { is_scanned; _ } ->
       let startenv, acc_slots =
-        match startenv, acc_slots with
-        | Some i, _ ->
+        match startenv, acc_slots, is_scanned with
+        | Some i, _, _ ->
+          assert is_scanned;
           assert (i < offset);
           startenv, acc_slots
-        | None, (o, Function_slot s) :: r ->
-          ( Some offset,
+        | None, (o, Function_slot s) :: r, _ ->
+          ( (if is_scanned then Some offset else None),
             (o, Function_slot { s with last_function_slot = true }) :: r )
-        | None, [] -> Misc.fatal_errorf "Set of closures with no closure slot"
-        | None, (_, ((Value_slot _ | Infix_header) as slot)) :: _ ->
+        | None, [], _ ->
+          Misc.fatal_errorf "Set of closures with no closure slot"
+        | None, _, false -> None, acc_slots
+        | None, (_, Value_slot { is_scanned = false; _ }) :: _, true ->
+          Some offset, acc_slots
+        | ( None,
+            (_, ((Value_slot { is_scanned = true; _ } | Infix_header) as slot))
+            :: _,
+            true ) ->
           Misc.fatal_errorf
-            "Expected a function slot right before the first value slot, but \
-             found %a"
+            "Expected a function slot or a non-scanned value slot right before \
+             the first value slot, but found %a"
             print_slot slot
       in
       let acc_slots = (offset, slot) :: acc_slots in
@@ -207,11 +236,13 @@ module Layout = struct
       | Some i, _ -> i, false
       | None, [] -> 0, true (* will raise a fatal_error later *)
       | None, (offset, Function_slot { size; _ }) :: _ -> offset + size, true
+      | None, (offset, Value_slot { is_scanned = false; size; _ }) :: _ ->
+        offset + size, false
       | None, (_, Infix_header) :: _ ->
         (* Cannot happen because a infix header is *always* preceded by a
            function slot (because the slot list is reversed) *)
         assert false
-      | None, (_, Value_slot _) :: _ ->
+      | None, (_, Value_slot { is_scanned = true; _ }) :: _ ->
         (* Cannot happen because if there is a value slot in the acc, then
            startenv_opt should be Some _ *)
         assert false
@@ -275,13 +306,16 @@ end = struct
 
   type value_slot = Value
 
+  type unboxed_slot = Unboxed
+
   type function_slot = Function
 
   (* silence warning 37 (unused constructor) *)
-  let _ = Value, Function
+  let _ = Value, Unboxed, Function
 
   type _ slot_desc =
     | Function_slot : Function_slot.t -> function_slot slot_desc
+    | Unboxed_slot : Value_slot.t -> unboxed_slot slot_desc
     | Value_slot : Value_slot.t -> value_slot slot_desc
 
   (* This module helps to distinguish between the two different notions of
@@ -322,14 +356,14 @@ end = struct
       let offset =
         match slot with
         | Function_slot _ -> first_offset_used_including_header + 1
-        | Value_slot _ -> first_offset_used_including_header
+        | Unboxed_slot _ | Value_slot _ -> first_offset_used_including_header
       in
       Offset offset
 
     let range_used_by (type a) (slot : a slot_desc) (Offset pos) ~slot_size =
       match slot with
       | Function_slot _ -> pos - 1, pos + slot_size
-      | Value_slot _ -> pos, pos + slot_size
+      | Unboxed_slot _ | Value_slot _ -> pos, pos + slot_size
 
     let add_slot_to_exported_offsets (type a) offsets (slot : a slot_desc)
         (Offset pos) ~slot_size =
@@ -339,8 +373,17 @@ end = struct
           EO.Live_function_slot { offset = pos; size = slot_size }
         in
         EO.add_function_slot_offset offsets function_slot info
+      | Unboxed_slot unboxed_slot ->
+        let (info : EO.value_slot_info) =
+          EO.Live_value_slot
+            { offset = pos; is_scanned = false; size = slot_size }
+        in
+        EO.add_value_slot_offset offsets unboxed_slot info
       | Value_slot value_slot ->
-        let (info : EO.value_slot_info) = EO.Live_value_slot { offset = pos } in
+        let (info : EO.value_slot_info) =
+          EO.Live_value_slot
+            { offset = pos; is_scanned = true; size = slot_size }
+        in
         EO.add_value_slot_offset offsets value_slot info
   end
 
@@ -356,11 +399,17 @@ end = struct
       (* metadata used for priorities *)
       num_value_slots : int;
       num_function_slots : int;
-      (* Info about start of environment *)
-      mutable first_slot_used_by_value_slots : words;
+      (* Info about transitions between different types of slots *)
       mutable first_slot_after_function_slots : words;
-      (* invariant : first_slot_after_function_slots <=
-         first_slot_used_by_calue_slots *)
+      mutable first_slot_used_by_unboxed_slots : words;
+      mutable first_slot_after_unboxed_slots : words;
+      mutable first_slot_used_by_value_slots : words;
+      (* invariants :
+       * first_slot_after_function_slots <= first_slot_used_by_unboxed_slots
+       * first_slot_after_function_slots <= first_slot_after_unboxed_slots
+       * first_slot_after_unboxed_slots <= first_slot_used_by_value_slots
+       * first_slot_after_function_slots <= first_slot_used_by_value_slots
+       *)
       mutable allocated_slots : any_slot Numeric_types.Int.Map.t
           (* map indexed by the offset of the first word used by a slot
              (including its infix header if it exists). *)
@@ -383,9 +432,11 @@ end = struct
   type state =
     { mutable used_offsets : EO.t;
       mutable function_slots : function_slot slot Function_slot.Map.t;
+      mutable unboxed_slots : unboxed_slot slot Value_slot.Map.t;
       mutable value_slots : value_slot slot Value_slot.Map.t;
       mutable sets_of_closures : set_of_closures list;
       mutable function_slots_to_assign : function_slot slot list;
+      mutable unboxed_slots_to_assign : unboxed_slot slot list;
       mutable value_slots_to_assign : value_slot slot list
     }
 
@@ -409,6 +460,8 @@ end = struct
         num_value_slots;
         num_function_slots;
         first_slot_after_function_slots = 0;
+        first_slot_used_by_unboxed_slots = max_int;
+        first_slot_after_unboxed_slots = 0;
         first_slot_used_by_value_slots = max_int;
         allocated_slots = Numeric_types.Int.Map.empty
       }
@@ -416,9 +469,11 @@ end = struct
   let create_initial_state () =
     { used_offsets = EO.empty;
       function_slots = Function_slot.Map.empty;
+      unboxed_slots = Value_slot.Map.empty;
       value_slots = Value_slot.Map.empty;
       sets_of_closures = [];
       function_slots_to_assign = [];
+      unboxed_slots_to_assign = [];
       value_slots_to_assign = []
     }
 
@@ -431,7 +486,8 @@ end = struct
   let print_desc (type a) fmt (slot_desc : a slot_desc) =
     match slot_desc with
     | Function_slot c -> Format.fprintf fmt "%a" Function_slot.print c
-    | Value_slot v -> Format.fprintf fmt "%a" Value_slot.print v
+    | Unboxed_slot v | Value_slot v ->
+      Format.fprintf fmt "%a" Value_slot.print v
 
   let print_slot_pos fmt = function
     | Assigned offset -> Format.fprintf fmt "%a" Exported_offset.print offset
@@ -459,12 +515,16 @@ end = struct
     Format.fprintf fmt
       "@[<v 2>%d:@ \
          @[<v>first_slot_after_function_slots: %d;@ \
+              first_slot_used_by_unboxed_slots: %d;@ \
+              first_slot_after_unboxed_slots: %d;@ \
               first_slot_used_by_value_slots: %d;@ \
               allocated: @[<v>%a@]\
           @]\
         @]"
       s.id
       s.first_slot_after_function_slots
+      s.first_slot_used_by_unboxed_slots
+      s.first_slot_after_unboxed_slots
       s.first_slot_used_by_value_slots
       print_any_slot_map s.allocated_slots
 
@@ -472,15 +532,17 @@ end = struct
     List.iter (function s -> Format.fprintf fmt "%a@ " print_set s) l
 
   let [@ocamlformat "disable"] print fmt {
-      used_offsets = _; function_slots = _; value_slots = _;
-      sets_of_closures; function_slots_to_assign; value_slots_to_assign; } =
+      used_offsets = _; function_slots = _; unboxed_slots = _; value_slots = _;
+      sets_of_closures; function_slots_to_assign; unboxed_slots_to_assign; value_slots_to_assign; } =
     Format.fprintf fmt
       "@[<hov 1>(@,\
           (function slots to assign@ @[<hov>%a@])@ \
+          (unboxed slots to assign@ @[<hov>%a@])@ \
           (value slots to assign@ @[<hov>%a@])\
           (sets of closures@ @[<hov>%a@])@,\
        )@]"
       print_slot_list function_slots_to_assign
+      print_slot_list unboxed_slots_to_assign
       print_slot_list value_slots_to_assign
       print_sets sets_of_closures
   [@@warning "-32"]
@@ -493,22 +555,36 @@ end = struct
     | Assigned offset -> (
       match slot.desc with
       | Value_slot _ ->
+        if slot.size <> 1
+        then
+          Misc.fatal_errorf "Value slot has size %d, which is not 1." slot.size;
         let start, _ =
           Exported_offset.range_used_by slot.desc offset ~slot_size:1
         in
         set.first_slot_used_by_value_slots
-          <- min set.first_slot_used_by_value_slots start
+          <- min set.first_slot_used_by_value_slots start;
+        set.first_slot_used_by_unboxed_slots
+          <- min set.first_slot_used_by_unboxed_slots start
+      | Unboxed_slot _ ->
+        let start, last =
+          Exported_offset.range_used_by slot.desc offset ~slot_size:slot.size
+        in
+        set.first_slot_used_by_unboxed_slots
+          <- min set.first_slot_used_by_unboxed_slots start;
+        set.first_slot_after_unboxed_slots
+          <- max set.first_slot_after_unboxed_slots last
       | Function_slot _ ->
         let _, last =
           Exported_offset.range_used_by slot.desc offset ~slot_size:slot.size
         in
         set.first_slot_after_function_slots
-          <- max set.first_slot_after_function_slots last));
-    if set.first_slot_used_by_value_slots < set.first_slot_after_function_slots
-    then
-      Misc.fatal_errorf
-        "Set of closures invariant (all function slots before all value slots) \
-         is broken"
+          <- max set.first_slot_after_function_slots last;
+        set.first_slot_after_unboxed_slots
+          <- max set.first_slot_after_unboxed_slots last));
+    if set.first_slot_used_by_value_slots < set.first_slot_after_unboxed_slots
+       || set.first_slot_used_by_unboxed_slots
+          < set.first_slot_after_function_slots
+    then Misc.fatal_errorf "Set of closures invariant (slot ordering) is broken"
 
   (* Slots *)
 
@@ -546,7 +622,7 @@ end = struct
         let (info : EO.function_slot_info) = EO.Dead_function_slot in
         state.used_offsets
           <- EO.add_function_slot_offset state.used_offsets function_slot info
-      | Value_slot v ->
+      | Unboxed_slot v | Value_slot v ->
         let (info : EO.value_slot_info) = EO.Dead_value_slot in
         state.used_offsets <- EO.add_value_slot_offset state.used_offsets v info
       )
@@ -561,6 +637,8 @@ end = struct
     match slot.desc with
     | Function_slot _ ->
       state.function_slots_to_assign <- slot :: state.function_slots_to_assign
+    | Unboxed_slot _ ->
+      state.unboxed_slots_to_assign <- slot :: state.unboxed_slots_to_assign
     | Value_slot _ ->
       state.value_slots_to_assign <- slot :: state.value_slots_to_assign
 
@@ -573,6 +651,11 @@ end = struct
     slot.lowest_num_slots_in_sets
       <- min slot.lowest_num_slots_in_sets set.num_function_slots
 
+  let update_metadata_for_unboxed_slot set slot =
+    slot.occurrences <- slot.occurrences + 1;
+    slot.lowest_num_slots_in_sets
+      <- min slot.lowest_num_slots_in_sets set.num_value_slots
+
   let update_metadata_for_value_slot set slot =
     slot.occurrences <- slot.occurrences + 1;
     slot.lowest_num_slots_in_sets
@@ -611,6 +694,12 @@ end = struct
     state.function_slots
       <- Function_slot.Map.add function_slot slot state.function_slots
 
+  let use_unboxed_slot_info state var info =
+    state.used_offsets <- EO.add_value_slot_offset state.used_offsets var info
+
+  let add_unboxed_slot state var slot =
+    state.unboxed_slots <- Value_slot.Map.add var slot state.unboxed_slots
+
   let use_value_slot_info state var info =
     state.used_offsets <- EO.add_value_slot_offset state.used_offsets var info
 
@@ -620,6 +709,9 @@ end = struct
   let find_function_slot state closure =
     Function_slot.Map.find_opt closure state.function_slots
 
+  let find_unboxed_slot state var =
+    Value_slot.Map.find_opt var state.unboxed_slots
+
   let find_value_slot state var = Value_slot.Map.find_opt var state.value_slots
 
   (* Create slots (and create the cross-referencing). *)
@@ -670,6 +762,43 @@ end = struct
         add_allocated_slot_to_set s set;
         s
 
+  let create_unboxed_slot set state value_slot size =
+    if Compilation_unit.is_current (Value_slot.get_compilation_unit value_slot)
+    then (
+      let s = create_slot ~size (Unboxed_slot value_slot) Unassigned in
+      add_unboxed_slot state value_slot s;
+      add_unallocated_slot_to_set state s set;
+      s)
+    else
+      (* Same as the comments for the function_slots *)
+      let imported_offsets = EO.imported_offsets () in
+      match EO.value_slot_offset imported_offsets value_slot with
+      | None ->
+        (* See comment for the function_slot *)
+        Misc.fatal_errorf
+          "Could not find the offset for value slot %a from another \
+           compilation unit (because of -opaque, or missing cmx)."
+          Value_slot.print value_slot
+      | Some Dead_value_slot ->
+        Misc.fatal_errorf
+          "The value slot %a has been removed by its original compilation \
+           unit, it should not occur in a set of closures in this compilation \
+           unit."
+          Value_slot.print value_slot
+      | Some (Live_value_slot { offset; is_scanned; size = sz } as info) ->
+        if is_scanned || sz <> size
+        then
+          Misc.fatal_errorf
+            "The unboxed slot %a existed but was not unboxed or of a different \
+             size in the original compilation unit, this should not happen."
+            Value_slot.print value_slot;
+        let offset = Exported_offset.from_exported_offset offset in
+        let s = create_slot ~size (Unboxed_slot value_slot) (Assigned offset) in
+        use_unboxed_slot_info state value_slot info;
+        add_unboxed_slot state value_slot s;
+        add_allocated_slot_to_set s set;
+        s
+
   let create_value_slot set state value_slot =
     if Compilation_unit.is_current (Value_slot.get_compilation_unit value_slot)
     then (
@@ -693,7 +822,13 @@ end = struct
            unit, it should not occur in a set of closures in this compilation \
            unit."
           Value_slot.print value_slot
-      | Some (Live_value_slot { offset } as info) ->
+      | Some (Live_value_slot { offset; is_scanned; size = sz } as info) ->
+        if (not is_scanned) || sz <> 1
+        then
+          Misc.fatal_errorf
+            "The value slot %a existed but was unboxed or of a different size \
+             in the original compilation unit, this should not happen."
+            Value_slot.print value_slot;
         let offset = Exported_offset.from_exported_offset offset in
         let s = create_slot ~size:1 (Value_slot value_slot) (Assigned offset) in
         use_value_slot_info state value_slot info;
@@ -729,13 +864,38 @@ end = struct
       closure_map;
     (* Fill value slot slots *)
     Value_slot.Map.iter
-      (fun value_slot _ ->
-        let s =
-          match Value_slot.Map.find_opt value_slot state.value_slots with
-          | None -> create_value_slot set state value_slot
-          | Some s -> s
+      (fun value_slot (_, kind) ->
+        let size, is_unboxed =
+          match Flambda_kind.With_subkind.kind kind with
+          | Region | Rec_info ->
+            Misc.fatal_errorf "Value slot %a has Region or Rec_info kind"
+              Value_slot.print value_slot
+          | Naked_number _ ->
+            1, true
+            (* flambda only supports 64-bits for now, so naked numbers can only
+               be of size 1 *)
+          | Value -> (
+            match[@ocaml.warning "-4"]
+              Flambda_kind.With_subkind.subkind kind
+            with
+            | Tagged_immediate -> 1, true
+            | _ -> 1, false)
         in
-        update_metadata_for_value_slot set s)
+        if is_unboxed
+        then
+          let s =
+            match Value_slot.Map.find_opt value_slot state.unboxed_slots with
+            | None -> create_unboxed_slot set state value_slot size
+            | Some s -> s
+          in
+          update_metadata_for_unboxed_slot set s
+        else
+          let s =
+            match Value_slot.Map.find_opt value_slot state.value_slots with
+            | None -> create_value_slot set state value_slot
+            | Some s -> s
+          in
+          update_metadata_for_value_slot set s)
       env_map
 
   (* Find the first space available to fit a given slot.
@@ -759,16 +919,17 @@ end = struct
     let needed_space =
       match slot.desc with
       | Function_slot _ -> slot.size + 1 (* header word *)
-      | Value_slot _ -> slot.size
+      | Unboxed_slot _ | Value_slot _ -> slot.size
     in
     (* Ensure that for value slots, we are after all function slots. *)
     let curr =
       match slot.desc with
       | Function_slot _ -> start
-      | Value_slot _ ->
+      | Unboxed_slot _ ->
         (* first_slot_after_function_slots is always >=0, thus ensuring we do
            not place a value slot at offset -1 *)
         max start set.first_slot_after_function_slots
+      | Value_slot _ -> max start set.first_slot_after_unboxed_slots
     in
     (* Adjust a starting position to not point in the middle of a block.
        Additionally, ensure the value slot slots are put after the function
@@ -851,6 +1012,19 @@ end = struct
             (* else mark_slot_as_removed state slot *))
       function_slots_to_assign
 
+  let assign_unboxed_slot_offsets ~used_unboxed_slots state =
+    let unboxed_slots_to_assign =
+      List.sort compare_priority state.unboxed_slots_to_assign
+    in
+    state.unboxed_slots_to_assign <- [];
+    List.iter
+      (function
+        | { desc = Unboxed_slot v; _ } as slot ->
+          if unboxed_slot_is_used ~used_unboxed_slots v
+          then assign_slot_offset state slot
+          else mark_slot_as_removed state slot)
+      unboxed_slots_to_assign
+
   let assign_value_slot_offsets ~used_value_slots state =
     let value_slots_to_assign =
       List.sort compare_priority state.value_slots_to_assign
@@ -912,28 +1086,42 @@ end = struct
         (fun value_slot ->
           if Compilation_unit.is_current
                (Value_slot.get_compilation_unit value_slot)
-          then (
+          then
             (* a value slot appears in a set of closures iff it has a slot *)
-            match find_value_slot state value_slot with
-            | Some _ -> true
-            | None ->
+            match
+              ( find_value_slot state value_slot,
+                find_unboxed_slot state value_slot )
+            with
+            | None, None ->
               state.used_offsets
                 <- EO.add_value_slot_offset state.used_offsets value_slot
                      Dead_value_slot;
-              false)
+              false
+            | _ -> true
           else true)
         value_slots_in_normal_projections
     in
-    live_function_slots, live_value_slots
+    let live_value_slots, live_unboxed_slots =
+      Value_slot.Set.partition
+        (fun value_slot -> Option.is_some (find_value_slot state value_slot))
+        live_value_slots
+    in
+    live_function_slots, live_unboxed_slots, live_value_slots
 
   (* Transform an internal accumulator state for slots into an actual mapping
      that assigns offsets. *)
   let finalize ~used_slots state =
     add_used_imported_offsets ~used_slots state;
-    let used_function_slots, used_value_slots = live_slots state used_slots in
+    let used_function_slots, used_unboxed_slots, used_value_slots =
+      live_slots state used_slots
+    in
     assign_function_slot_offsets ~used_function_slots state;
+    assign_unboxed_slot_offsets ~used_unboxed_slots state;
     assign_value_slot_offsets ~used_value_slots state;
-    { used_value_slots; exported_offsets = state.used_offsets }
+    { used_value_slots =
+        Value_slot.Set.union used_value_slots used_unboxed_slots;
+      exported_offsets = state.used_offsets
+    }
 end
 
 type t = Set_of_closures.t list
diff --git a/middle_end/flambda2/simplify_shared/slot_offsets.mli b/middle_end/flambda2/simplify_shared/slot_offsets.mli
index c7556619ece..9a0a6182ba0 100644
--- a/middle_end/flambda2/simplify_shared/slot_offsets.mli
+++ b/middle_end/flambda2/simplify_shared/slot_offsets.mli
@@ -70,6 +70,8 @@ val finalize_offsets :
   t ->
   result
 
+type words = int
+
 (** {2 Offsets & Layouts} *)
 module Layout : sig
   (**)
@@ -78,10 +80,14 @@ module Layout : sig
       layout slot can take up more than one word of memory (this is the case for
       closures, which can take either 2 or 3 words depending on arity). *)
   type slot = private
-    | Value_slot of Value_slot.t
+    | Value_slot of
+        { size : words;
+          is_scanned : bool;
+          value_slot : Value_slot.t
+        }
     | Infix_header
     | Function_slot of
-        { size : int;
+        { size : words;
           function_slot : Function_slot.t;
           last_function_slot : bool
         }
@@ -90,9 +96,9 @@ module Layout : sig
   (** Alias for complete layouts. The list is sorted according to offsets (in
       increasing order). *)
   type t = private
-    { startenv : int;
+    { startenv : words;
       empty_env : bool;
-      slots : (int * slot) list
+      slots : (words * slot) list
     }
 
   (** Order the given function slots and env vars into a list of layout slots
diff --git a/middle_end/flambda2/term_basics/symbol_projection.ml b/middle_end/flambda2/term_basics/symbol_projection.ml
index 2d11ae9b547..8f77c60b983 100644
--- a/middle_end/flambda2/term_basics/symbol_projection.ml
+++ b/middle_end/flambda2/term_basics/symbol_projection.ml
@@ -17,19 +17,23 @@ module Projection = struct
     | Block_load of { index : Targetint_31_63.t }
     | Project_value_slot of
         { project_from : Function_slot.t;
-          value_slot : Value_slot.t
+          value_slot : Value_slot.t;
+          kind : Flambda_kind.With_subkind.t
         }
 
   let block_load ~index = Block_load { index }
 
-  let project_value_slot project_from value_slot =
-    Project_value_slot { project_from; value_slot }
+  let project_value_slot project_from value_slot kind =
+    Project_value_slot { project_from; value_slot; kind }
 
   let hash t =
     match t with
     | Block_load { index } -> Targetint_31_63.hash index
-    | Project_value_slot { project_from; value_slot } ->
-      Hashtbl.hash (Function_slot.hash project_from, Value_slot.hash value_slot)
+    | Project_value_slot { project_from; value_slot; kind } ->
+      Hashtbl.hash
+        ( Function_slot.hash project_from,
+          Value_slot.hash value_slot,
+          Flambda_kind.With_subkind.hash kind )
 
   let [@ocamlformat "disable"] print ppf t =
     match t with
@@ -38,24 +42,36 @@ module Projection = struct
           @[<hov 1>(index@ %a)@]\
           )@]"
         Targetint_31_63.print index
-    | Project_value_slot { project_from; value_slot; } ->
+    | Project_value_slot { project_from; value_slot; kind } ->
       Format.fprintf ppf "@[<hov 1>(Project_value_slot@ \
           @[<hov 1>(project_from@ %a)@]@ \
-          @[<hov 1>(var@ %a)@]\
+          @[<hov 1>(var@ %a)@]@ \
+          @[<hov 1>(kind@ %a)@]\
           )@]"
         Function_slot.print project_from
         Value_slot.print value_slot
+        Flambda_kind.With_subkind.print kind
 
   let compare t1 t2 =
     match t1, t2 with
     | Block_load { index = index1 }, Block_load { index = index2 } ->
       Targetint_31_63.compare index1 index2
     | ( Project_value_slot
-          { project_from = project_from1; value_slot = value_slot1 },
+          { project_from = project_from1;
+            value_slot = value_slot1;
+            kind = kind1
+          },
         Project_value_slot
-          { project_from = project_from2; value_slot = value_slot2 } ) ->
+          { project_from = project_from2;
+            value_slot = value_slot2;
+            kind = kind2
+          } ) ->
       let c = Function_slot.compare project_from1 project_from2 in
-      if c <> 0 then c else Value_slot.compare value_slot1 value_slot2
+      if c <> 0
+      then c
+      else
+        let c = Value_slot.compare value_slot1 value_slot2 in
+        if c <> 0 then c else Flambda_kind.With_subkind.compare kind1 kind2
     | Block_load _, Project_value_slot _ -> -1
     | Project_value_slot _, Block_load _ -> 1
 end
@@ -97,7 +113,7 @@ let free_names { symbol; projection } =
   let free_names = Name_occurrences.singleton_symbol symbol Name_mode.normal in
   match projection with
   | Block_load _ -> free_names
-  | Project_value_slot { project_from; value_slot } ->
+  | Project_value_slot { project_from; value_slot; kind = _ } ->
     Name_occurrences.add_function_slot_in_projection
       (Name_occurrences.add_value_slot_in_projection free_names value_slot
          Name_mode.normal)
diff --git a/middle_end/flambda2/term_basics/symbol_projection.mli b/middle_end/flambda2/term_basics/symbol_projection.mli
index 1659b18ba39..43bf206a574 100644
--- a/middle_end/flambda2/term_basics/symbol_projection.mli
+++ b/middle_end/flambda2/term_basics/symbol_projection.mli
@@ -17,12 +17,14 @@ module Projection : sig
     | Block_load of { index : Targetint_31_63.t }
     | Project_value_slot of
         { project_from : Function_slot.t;
-          value_slot : Value_slot.t
+          value_slot : Value_slot.t;
+          kind : Flambda_kind.With_subkind.t
         }
 
   val block_load : index:Targetint_31_63.t -> t
 
-  val project_value_slot : Function_slot.t -> Value_slot.t -> t
+  val project_value_slot :
+    Function_slot.t -> Value_slot.t -> Flambda_kind.With_subkind.t -> t
 end
 
 type t
diff --git a/middle_end/flambda2/terms/flambda_primitive.ml b/middle_end/flambda2/terms/flambda_primitive.ml
index f6648b54cc0..e3c65354a0a 100644
--- a/middle_end/flambda2/terms/flambda_primitive.ml
+++ b/middle_end/flambda2/terms/flambda_primitive.ml
@@ -663,7 +663,8 @@ type unary_primitive =
       }
   | Project_value_slot of
       { project_from : Function_slot.t;
-        value_slot : Value_slot.t
+        value_slot : Value_slot.t;
+        kind : Flambda_kind.With_subkind.t
       }
   | Is_boxed_float
   | Is_flat_float_array
@@ -782,11 +783,21 @@ let compare_unary_primitive p1 p2 =
     let c = Function_slot.compare move_from1 move_from2 in
     if c <> 0 then c else Function_slot.compare move_to1 move_to2
   | ( Project_value_slot
-        { project_from = function_slot1; value_slot = value_slot1 },
+        { project_from = function_slot1;
+          value_slot = value_slot1;
+          kind = kind1
+        },
       Project_value_slot
-        { project_from = function_slot2; value_slot = value_slot2 } ) ->
+        { project_from = function_slot2;
+          value_slot = value_slot2;
+          kind = kind2
+        } ) ->
     let c = Function_slot.compare function_slot1 function_slot2 in
-    if c <> 0 then c else Value_slot.compare value_slot1 value_slot2
+    if c <> 0
+    then c
+    else
+      let c = Value_slot.compare value_slot1 value_slot2 in
+      if c <> 0 then c else K.With_subkind.compare kind1 kind2
   | ( Opaque_identity { middle_end_only = middle_end_only1 },
       Opaque_identity { middle_end_only = middle_end_only2 } ) ->
     Bool.compare middle_end_only1 middle_end_only2
@@ -840,9 +851,10 @@ let print_unary_primitive ppf p =
   | Project_function_slot { move_from; move_to } ->
     Format.fprintf ppf "@[(Project_function_slot@ (%a \u{2192} %a))@]"
       Function_slot.print move_from Function_slot.print move_to
-  | Project_value_slot { project_from; value_slot } ->
-    Format.fprintf ppf "@[(Project_value_slot@ (%a@ %a))@]" Function_slot.print
-      project_from Value_slot.print value_slot
+  | Project_value_slot { project_from; value_slot; kind } ->
+    Format.fprintf ppf "@[(Project_value_slot@ (%a@ %a@ %a))@]"
+      Function_slot.print project_from Value_slot.print value_slot
+      K.With_subkind.print kind
   | Is_boxed_float -> fprintf ppf "Is_boxed_float"
   | Is_flat_float_array -> fprintf ppf "Is_flat_float_array"
   | Begin_try_region -> Format.pp_print_string ppf "Begin_try_region"
@@ -1012,7 +1024,7 @@ let free_names_unary_primitive p =
       (Name_occurrences.add_function_slot_in_projection Name_occurrences.empty
          move_to Name_mode.normal)
       move_from Name_mode.normal
-  | Project_value_slot { value_slot; project_from } ->
+  | Project_value_slot { value_slot; project_from; kind = _ } ->
     Name_occurrences.add_function_slot_in_projection
       (Name_occurrences.add_value_slot_in_projection Name_occurrences.empty
          value_slot Name_mode.normal)
diff --git a/middle_end/flambda2/terms/flambda_primitive.mli b/middle_end/flambda2/terms/flambda_primitive.mli
index 6c018cf660b..85b0c3c9d97 100644
--- a/middle_end/flambda2/terms/flambda_primitive.mli
+++ b/middle_end/flambda2/terms/flambda_primitive.mli
@@ -281,7 +281,8 @@ type unary_primitive =
           closures. *)
   | Project_value_slot of
       { project_from : Function_slot.t;
-        value_slot : Value_slot.t
+        value_slot : Value_slot.t;
+        kind : Flambda_kind.With_subkind.t
       }
       (** Project a value slot from a set of closures -- in other words, read an
           entry from the closure environment (the captured variables). *)
diff --git a/middle_end/flambda2/terms/set_of_closures.ml b/middle_end/flambda2/terms/set_of_closures.ml
index ccfb77d376a..a21f330920c 100644
--- a/middle_end/flambda2/terms/set_of_closures.ml
+++ b/middle_end/flambda2/terms/set_of_closures.ml
@@ -16,13 +16,18 @@
 
 type t =
   { function_decls : Function_declarations.t;
-    value_slots : Simple.t Value_slot.Map.t;
+    value_slots : (Simple.t * Flambda_kind.With_subkind.t) Value_slot.Map.t;
     alloc_mode : Alloc_mode.For_allocations.t
   }
 
+let print_value_slot ppf (simple, kind) =
+  Format.fprintf ppf "@[(%a @<1>\u{2237} %a)@]" Simple.print simple
+    Flambda_kind.With_subkind.print kind
+
 let [@ocamlformat "disable"] print ppf
       { function_decls;
-        value_slots;alloc_mode;
+        value_slots;
+        alloc_mode;
       } =
   Format.fprintf ppf "@[<hov 1>(%tset_of_closures%t@ \
       @[<hov 1>(function_decls@ %a)@]@ \
@@ -32,7 +37,7 @@ let [@ocamlformat "disable"] print ppf
     Flambda_colours.prim_constructive
     Flambda_colours.pop
     (Function_declarations.print) function_decls
-    (Value_slot.Map.print Simple.print) value_slots
+    (Value_slot.Map.print print_value_slot) value_slots
     Alloc_mode.For_allocations.print alloc_mode
 
 include Container_types.Make (struct
@@ -55,7 +60,13 @@ include Container_types.Make (struct
     if c <> 0
     then c
     else
-      let c = Value_slot.Map.compare Simple.compare value_slots1 value_slots2 in
+      let compare_value_slot (simple1, kind1) (simple2, kind2) =
+        let c = Simple.compare simple1 simple2 in
+        if c <> 0 then c else Flambda_kind.With_subkind.compare kind1 kind2
+      in
+      let c =
+        Value_slot.Map.compare compare_value_slot value_slots1 value_slots2
+      in
       if c <> 0
       then c
       else Alloc_mode.For_allocations.compare alloc_mode1 alloc_mode2
@@ -100,12 +111,12 @@ let [@ocamlformat "disable"] print ppf
       Flambda_colours.pop
       Alloc_mode.For_allocations.print alloc_mode
       Function_declarations.print function_decls
-      (Value_slot.Map.print Simple.print) value_slots
+      (Value_slot.Map.print print_value_slot) value_slots
 
 let free_names { function_decls; value_slots; alloc_mode = _ } =
   let free_names_of_value_slots =
     Value_slot.Map.fold
-      (fun value_slot simple free_names ->
+      (fun value_slot (simple, _kind) free_names ->
         Name_occurrences.union free_names
           (Name_occurrences.add_value_slot_in_declaration
              (Simple.free_names simple) value_slot Name_mode.normal))
@@ -124,12 +135,12 @@ let apply_renaming ({ function_decls; value_slots; alloc_mode } as t) renaming =
   let changed = ref false in
   let value_slots' =
     Value_slot.Map.filter_map
-      (fun var simple ->
+      (fun var (simple, kind) ->
         if Renaming.value_slot_is_used renaming var
         then (
           let simple' = Simple.apply_renaming simple renaming in
           if not (simple == simple') then changed := true;
-          Some simple')
+          Some (simple', kind))
         else (
           changed := true;
           None))
@@ -151,7 +162,8 @@ let ids_for_export { function_decls; value_slots; alloc_mode } =
   in
   Ids_for_export.union
     (Value_slot.Map.fold
-       (fun _value_slot simple ids -> Ids_for_export.add_simple ids simple)
+       (fun _value_slot (simple, _kind) ids ->
+         Ids_for_export.add_simple ids simple)
        value_slots function_decls_ids)
     (Alloc_mode.For_allocations.ids_for_export alloc_mode)
 
diff --git a/middle_end/flambda2/terms/set_of_closures.mli b/middle_end/flambda2/terms/set_of_closures.mli
index 82ec53e221a..8ba9da8ea73 100644
--- a/middle_end/flambda2/terms/set_of_closures.mli
+++ b/middle_end/flambda2/terms/set_of_closures.mli
@@ -25,7 +25,7 @@ val is_empty : t -> bool
 (** Create a set of closures given the code for its functions and the closure
     variables. *)
 val create :
-  value_slots:Simple.t Value_slot.Map.t ->
+  value_slots:(Simple.t * Flambda_kind.With_subkind.t) Value_slot.Map.t ->
   Alloc_mode.For_allocations.t ->
   Function_declarations.t ->
   t
@@ -34,7 +34,7 @@ val create :
 val function_decls : t -> Function_declarations.t
 
 (** The values of each value slot (the environment, or captured variables). *)
-val value_slots : t -> Simple.t Value_slot.Map.t
+val value_slots : t -> (Simple.t * Flambda_kind.With_subkind.t) Value_slot.Map.t
 
 (** Returns true iff the given set of closures has no value slots. *)
 val is_closed : t -> bool
diff --git a/middle_end/flambda2/to_cmm/to_cmm_primitive.ml b/middle_end/flambda2/to_cmm/to_cmm_primitive.ml
index a5d05a6a780..64119a5289d 100644
--- a/middle_end/flambda2/to_cmm/to_cmm_primitive.ml
+++ b/middle_end/flambda2/to_cmm/to_cmm_primitive.ml
@@ -585,11 +585,11 @@ let unary_primitive env res dbg f arg =
       let message = dead_slots_msg dbg [c1; c2] [] in
       let expr, res = C.invalid res ~message in
       None, res, expr)
-  | Project_value_slot { project_from; value_slot } -> (
+  | Project_value_slot { project_from; value_slot; kind = _ } -> (
     match
       value_slot_offset env value_slot, function_slot_offset env project_from
     with
-    | Live_value_slot { offset }, Live_function_slot { offset = base; _ } ->
+    | Live_value_slot { offset; _ }, Live_function_slot { offset = base; _ } ->
       None, res, C.get_field_gen Asttypes.Immutable arg (offset - base) dbg
     | Dead_value_slot, Live_function_slot _ ->
       let message = dead_slots_msg dbg [] [value_slot] in
diff --git a/middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml b/middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml
index e9a7930920a..d69a49d1882 100644
--- a/middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml
+++ b/middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml
@@ -90,7 +90,7 @@ end) : sig
     Code_id.t Function_slot.Map.t ->
     Debuginfo.t ->
     startenv:int ->
-    Simple.t Value_slot.Map.t ->
+    (Simple.t * Flambda_kind.With_subkind.t) Value_slot.Map.t ->
     Env.t ->
     To_cmm_result.t ->
     Ece.t ->
@@ -110,8 +110,17 @@ end = struct
     | Infix_header ->
       let field = P.infix_header ~function_slot_offset:(slot_offset + 1) ~dbg in
       field :: acc, slot_offset + 1, env, res, Ece.pure, updates
-    | Value_slot v ->
-      let simple = Value_slot.Map.find v value_slots in
+    | Value_slot { value_slot; is_scanned; size = _ } ->
+      let simple, kind = Value_slot.Map.find value_slot value_slots in
+      if (not
+            (Flambda_kind.equal
+               (Flambda_kind.With_subkind.kind kind)
+               Flambda_kind.value))
+         && is_scanned
+      then
+        Misc.fatal_errorf
+          "Value slot %a not of kind Value (%a) but is visible by GC"
+          Simple.print simple Debuginfo.print_compact dbg;
       let contents, env, res, eff = P.simple ~dbg env res simple in
       let env, res, fields, updates =
         match contents with
diff --git a/middle_end/flambda2/types/grammar/type_grammar.ml b/middle_end/flambda2/types/grammar/type_grammar.ml
index deed8b0336e..b2072f6a708 100644
--- a/middle_end/flambda2/types/grammar/type_grammar.ml
+++ b/middle_end/flambda2/types/grammar/type_grammar.ml
@@ -159,7 +159,7 @@ and closures_entry =
 
 (* Products are a set of constraints: each new field reduces the concrete set.
    The empty product is top. There is no bottom. All components must be of the
-   same kind.
+   same kind except for [value_slot_indexed_product].
 
    { 1 => Unknown; 2 => V } is equal to { 2 => V } *)
 and function_slot_indexed_product =
@@ -2226,18 +2226,19 @@ module Product = struct
     type t = function_slot_indexed_product
 
     let create function_slot_components_by_index =
-      if Flambda_features.check_invariants ()
-      then
-        Function_slot.Map.iter
-          (fun _ ty ->
+      let function_slot_components_by_index =
+        Function_slot.Map.map
+          (fun ty ->
             if not (K.equal (kind ty) K.value)
             then
               Misc.fatal_errorf
                 "Function-slot-indexed products can only hold types of kind \
                  [Value]:@ %a"
                 (Function_slot.Map.print print)
-                function_slot_components_by_index)
-          function_slot_components_by_index;
+                function_slot_components_by_index
+            else ty)
+          function_slot_components_by_index
+      in
       { function_slot_components_by_index }
 
     let top = { function_slot_components_by_index = Function_slot.Map.empty }
@@ -2251,18 +2252,6 @@ module Product = struct
     type t = value_slot_indexed_product
 
     let create value_slot_components_by_index =
-      if Flambda_features.check_invariants ()
-      then
-        Value_slot.Map.iter
-          (fun _ ty ->
-            if not (K.equal (kind ty) K.value)
-            then
-              Misc.fatal_errorf
-                "Value-slot-indexed products can only hold types of kind \
-                 [Value]:@ %a"
-                (Value_slot.Map.print print)
-                value_slot_components_by_index)
-          value_slot_components_by_index;
       { value_slot_components_by_index }
 
     let top = { value_slot_components_by_index = Value_slot.Map.empty }
diff --git a/middle_end/printclambda.ml b/middle_end/printclambda.ml
index df4b9ab29f2..a5e99d7dbec 100644
--- a/middle_end/printclambda.ml
+++ b/middle_end/printclambda.ml
@@ -137,12 +137,13 @@ and lam ppf = function
       let lams ppf largs =
         List.iter (fun l -> fprintf ppf "@ %a" lam l) largs in
       fprintf ppf "@[<2>(%a@ %a%a)@]" apply_kind kind lam lfun lams largs
-  | Uclosure(clos, fv) ->
+  | Uclosure { functions ; not_scanned_slots ; scanned_slots } ->
       let funs ppf =
         List.iter (fprintf ppf "@ @[<2>%a@]" one_fun) in
       let lams ppf =
         List.iter (fprintf ppf "@ %a" lam) in
-      fprintf ppf "@[<2>(closure@ %a %a)@]" funs clos lams fv
+      fprintf ppf "@[<2>(closure@ %a (%a) %a)@]" funs functions
+        lams not_scanned_slots lams scanned_slots
   | Uoffset(l,i) -> fprintf ppf "@[<2>(offset %a %d)@]" lam l i
   | Ulet(mut, kind, id, arg, body) ->
       let rec letbody ul = match ul with
diff --git a/ocaml/asmcomp/cmm_helpers.ml b/ocaml/asmcomp/cmm_helpers.ml
index 8ea58ec42ef..f0fb7855cac 100644
--- a/ocaml/asmcomp/cmm_helpers.ml
+++ b/ocaml/asmcomp/cmm_helpers.ml
@@ -93,7 +93,7 @@ let closure_info ~arity ~startenv ~is_last =
       (shift_left
           (Bool.to_int is_last |> Nativeint.of_int)
           (pos_arity_in_closinfo - 1))
-        (add (shift_left (of_int startenv) 1) 1n)))
+      (add (shift_left (of_int startenv) 1) 1n)))
 
 let alloc_float_header mode dbg =
   match mode with
diff --git a/ocaml/runtime/caml/mlvalues.h b/ocaml/runtime/caml/mlvalues.h
index e1d5cd84113..139f3fd842d 100644
--- a/ocaml/runtime/caml/mlvalues.h
+++ b/ocaml/runtime/caml/mlvalues.h
@@ -253,6 +253,7 @@ CAMLextern value caml_get_public_method (value obj, value tag);
    closure to the scannable part of the environment.
    The non-scannable part of the environment lives between the end of the
    last closure and the start of the scannable environment within the block. */
+/* CR ncourant: it might be cleaner to use a packed struct here */
 #ifdef ARCH_SIXTYFOUR
 #define Arity_closinfo(info) ((intnat)(info) >> 56)
 #define Start_env_closinfo(info) (((uintnat)(info) << 9) >> 10)