diff --git a/changes/type-expr-accessors.internal.md b/changes/type-expr-accessors.internal.md
new file mode 100644
index 0000000000..fac0868758
--- /dev/null
+++ b/changes/type-expr-accessors.internal.md
@@ -0,0 +1 @@
+- Read and update type nodes in `Btype` and `Ctype` through accessors, a first step towards an abstract `type_expr`.
diff --git a/compiler/ml/btype.ml b/compiler/ml/btype.ml
index 90a09c42a1..d9abb37145 100644
--- a/compiler/ml/btype.ml
+++ b/compiler/ml/btype.ml
@@ -41,20 +41,23 @@ let pivot_level = (2 * lowest_level) - 1
 let newty2 level desc =
   let state = Compiler_request_state.current () in
   state.type_node_id <- state.type_node_id + 1;
-  {desc; level; id = state.type_node_id}
+  Transient_expr.create desc ~level ~id:state.type_node_id
 let newgenty desc = newty2 generic_level desc
 let newgenvar () = newgenty (Tvar None)
 
 (**** Check some types ****)
 
-let is_Tvar = function
-  | {desc = Tvar _} -> true
+let is_Tvar ty =
+  match get_desc ty with
+  | Tvar _ -> true
   | _ -> false
-let is_Tunivar = function
-  | {desc = Tunivar _} -> true
+let is_Tunivar ty =
+  match get_desc ty with
+  | Tunivar _ -> true
   | _ -> false
-let is_Tconstr = function
-  | {desc = Tconstr _} -> true
+let is_Tconstr ty =
+  match get_desc ty with
+  | Tconstr _ -> true
   | _ -> false
 
 let default_mty = function
@@ -96,16 +99,17 @@ let log_change ch =
 
 (**** Representative of a type ****)
 
-let rec repr_link compress t d = function
-  | {desc = Tlink t' as d'} -> repr_link true t d' t'
-  | t' ->
+let rec repr_link compress t d t' =
+  match get_desc t' with
+  | Tlink t'' as d' -> repr_link true t d' t''
+  | _ ->
     if compress then (
-      log_change (Ccompress (t, t.desc, d));
-      t.desc <- d);
+      log_change (Ccompress (t, get_desc t, d));
+      Transient_expr.set_desc t d);
     t'
 
 let repr t =
-  match t.desc with
+  match get_desc t with
   | Tlink t' as d -> repr_link false t d t'
   | _ -> t
 
@@ -124,7 +128,7 @@ let rec rev_concat l ll =
   | l' :: ll -> rev_concat (l' @ l) ll
 
 let rec row_repr_aux ll row =
-  match (repr row.row_more).desc with
+  match get_desc (repr row.row_more) with
   | Tvariant row' ->
     let f = row.row_fields in
     row_repr_aux (if f = [] then ll else f :: ll) row'
@@ -139,22 +143,23 @@ let rec row_field tag row =
     | (tag', f) :: fields ->
       if tag = tag' then row_field_repr f else find fields
     | [] -> (
-      match repr row.row_more with
-      | {desc = Tvariant row'} -> row_field tag row'
+      match get_desc (repr row.row_more) with
+      | Tvariant row' -> row_field tag row'
       | _ -> Rabsent)
   in
   find row.row_fields
 
 let rec row_more row =
-  match repr row.row_more with
-  | {desc = Tvariant row'} -> row_more row'
-  | ty -> ty
+  let ty = repr row.row_more in
+  match get_desc ty with
+  | Tvariant row' -> row_more row'
+  | _ -> ty
 
 let row_fixed row =
   let row = row_repr row in
   row.row_fixed
   ||
-  match (repr row.row_more).desc with
+  match get_desc (repr row.row_more) with
   | Tvar _ | Tnil -> false
   | Tunivar _ | Tconstr _ -> true
   | _ -> assert false
@@ -181,11 +186,11 @@ let hash_variant s =
 
 let proxy ty =
   let ty0 = repr ty in
-  match ty0.desc with
+  match get_desc ty0 with
   | Tvariant row when not (static_row row) -> row_more row
   | Tobject ty ->
     let rec proxy_obj ty =
-      match ty.desc with
+      match get_desc ty with
       | Tfield {rest = ty} | Tlink ty -> proxy_obj ty
       | Tvar _ | Tunivar _ | Tconstr _ -> ty
       | Tnil -> ty0
@@ -197,11 +202,11 @@ let proxy ty =
 (**** Utilities for fixed row private types ****)
 
 let row_of_type t =
-  match (repr t).desc with
+  match get_desc (repr t) with
   | Tobject t ->
     let rec get_row t =
       let t = repr t in
-      match t.desc with
+      match get_desc t with
       | Tfield {rest = t} -> get_row t
       | _ -> t
     in
@@ -216,7 +221,7 @@ let is_row_name s =
   if l < 4 then false else String.sub s (l - 4) 4 = "#row"
 
 let is_constr_row ~allow_ident t =
-  match t.desc with
+  match get_desc t with
   | Tconstr (Path.Pident id, _, _) when allow_ident ->
     is_row_name (Ident.name id)
   | Tconstr (Path.Pdot (_, s, _), _, _) -> is_row_name s
@@ -234,14 +239,14 @@ let rec iter_row f row =
       | Reither (_, tl, _, _) -> List.iter f tl
       | _ -> ())
     row.row_fields;
-  match (repr row.row_more).desc with
+  match get_desc (repr row.row_more) with
   | Tvariant row -> iter_row f row
   | Tvar _ | Tunivar _ | Tsubst _ | Tconstr _ | Tnil ->
     Misc.may (fun (_, l) -> List.iter f l) row.row_name
   | _ -> assert false
 
 let iter_type_expr f ty =
-  match ty.desc with
+  match get_desc ty with
   | Tvar _ -> ()
   | Tarrow (params, ret) ->
     List.iter (fun {typ} -> f typ) params;
@@ -336,7 +341,7 @@ let type_iterators =
   and it_type_kind it kind = iter_type_expr_kind (it.it_type_expr it) kind
   and it_do_type_expr it ty =
     iter_type_expr (it.it_type_expr it) ty;
-    match ty.desc with
+    match get_desc ty with
     | Tconstr (p, _, _) | Tpackage (p, _, _) -> it.it_path p
     | Tvariant row -> may (fun (p, _) -> it.it_path p) (row_repr row).row_name
     | _ -> ()
@@ -387,7 +392,7 @@ let copy_row f fixed row keep more =
 (* Since univars may be used as row variables, we need to do some
    encoding during substitution *)
 let rec norm_univar ty =
-  match ty.desc with
+  match get_desc ty with
   | Tunivar _ | Tsubst _ -> ty
   | Tlink ty -> norm_univar ty
   | Ttuple (ty :: _) -> norm_univar ty
@@ -442,7 +447,9 @@ let end_type_copy_session () =
   let type_copy_sessions = Domain.DLS.get type_copy_sessions in
   match !type_copy_sessions with
   | session :: rest ->
-    List.iter (fun (ty, desc) -> ty.desc <- desc) session.saved_desc;
+    List.iter
+      (fun (ty, desc) -> Transient_expr.set_desc ty desc)
+      session.saved_desc;
     List.iter (fun (r, v) -> r := v) session.saved_mutabilities;
     type_copy_sessions := rest
   | [] -> assert false
@@ -479,13 +486,13 @@ let row_terminator_generic rest =
   in
   let rec go t =
     let t = repr t in
-    match Hashtbl.find_opt copy_policy_memo t.id with
+    match Hashtbl.find_opt copy_policy_memo (get_id t) with
     | Some b -> b
     | None ->
       let b =
-        match t.desc with
+        match get_desc t with
         | Tfield {rest} -> go rest
-        | Tvar _ -> t.level = generic_level
+        | Tvar _ -> get_level t = generic_level
         | Tsubst t' ->
           (* Already copied in this session: follow the copy; its fresh
              terminator is generic exactly when the row is being
@@ -493,7 +500,7 @@ let row_terminator_generic rest =
           go t'
         | _ -> false
       in
-      Hashtbl.add copy_policy_memo t.id b;
+      Hashtbl.add copy_policy_memo (get_id t) b;
       b
   in
   go rest
@@ -524,7 +531,7 @@ let rec copy_type_desc ?(keep_names = false) ?(fresh_mutability = false) f =
     in
     Tfield {f_ with mutability; typ = f f_.typ; rest = f f_.rest}
   | Tnil -> Tnil
-  | Tlink ty -> copy_type_desc ~keep_names ~fresh_mutability f ty.desc
+  | Tlink ty -> copy_type_desc ~keep_names ~fresh_mutability f (get_desc ty)
   | Tsubst _ -> assert false
   | Tunivar _ as ty -> ty (* always keep the name *)
   | Tpoly (ty, tyl) ->
@@ -554,18 +561,19 @@ let with_copy_session f =
 (* Mark a type. *)
 let rec mark_type ty =
   let ty = repr ty in
-  if ty.level >= lowest_level then (
-    ty.level <- pivot_level - ty.level;
+  if get_level ty >= lowest_level then (
+    Transient_expr.set_level ty (pivot_level - get_level ty);
     iter_type_expr mark_type ty)
 
 let mark_type_node ty =
   let ty = repr ty in
-  if ty.level >= lowest_level then ty.level <- pivot_level - ty.level
+  if get_level ty >= lowest_level then
+    Transient_expr.set_level ty (pivot_level - get_level ty)
 
 let type_iterators =
   let it_type_expr it ty =
     let ty = repr ty in
-    if ty.level >= lowest_level then (
+    if get_level ty >= lowest_level then (
       mark_type_node ty;
       it.it_do_type_expr it ty)
   in
@@ -574,8 +582,8 @@ let type_iterators =
 (* Remove marks from a type. *)
 let rec unmark_type ty =
   let ty = repr ty in
-  if ty.level < lowest_level then (
-    ty.level <- pivot_level - ty.level;
+  if get_level ty < lowest_level then (
+    Transient_expr.set_level ty (pivot_level - get_level ty);
     iter_type_expr unmark_type ty)
 
 let unmark_iterators =
@@ -690,9 +698,9 @@ let rec label_assoc x (args : sargs) =
 (**********************************)
 
 let undo_change = function
-  | Ctype (ty, desc) -> ty.desc <- desc
-  | Ccompress (ty, desc, _) -> ty.desc <- desc
-  | Clevel (ty, level) -> ty.level <- level
+  | Ctype (ty, desc) -> Transient_expr.set_desc ty desc
+  | Ccompress (ty, desc, _) -> Transient_expr.set_desc ty desc
+  | Clevel (ty, level) -> Transient_expr.set_level ty level
   | Crow (r, v) -> r := v
   | Cmutability (r, v) -> r := v
   | Cuniv (r, v) -> r := v
@@ -701,34 +709,34 @@ let undo_change = function
 type snapshot = changes ref * int
 
 let log_type ty =
-  if ty.id <= (Compiler_request_state.current ()).type_node_last_snapshot then
-    log_change (Ctype (ty, ty.desc))
+  if get_id ty <= (Compiler_request_state.current ()).type_node_last_snapshot
+  then log_change (Ctype (ty, get_desc ty))
 let link_type ty ty' =
   log_type ty;
-  let desc = ty.desc in
-  ty.desc <- Tlink ty';
+  let desc = get_desc ty in
+  Transient_expr.set_desc ty (Tlink ty');
   (* Name is a user-supplied name for this unification variable (obtained
    * through a type annotation for instance). *)
-  match (desc, ty'.desc) with
+  match (desc, get_desc ty') with
   | Tvar name, Tvar name' -> (
     match (name, name') with
     | Some _, None ->
       log_type ty';
-      ty'.desc <- Tvar name
+      Transient_expr.set_desc ty' (Tvar name)
     | None, Some _ -> ()
     | Some _, Some _ ->
-      if ty.level < ty'.level then (
+      if get_level ty < get_level ty' then (
         log_type ty';
-        ty'.desc <- Tvar name)
+        Transient_expr.set_desc ty' (Tvar name))
     | None, None -> ())
   | _ -> ()
 
 (* ; assert (check_memorized_abbrevs ()) *)
 (*  ; check_expans [] ty' *)
 let set_level ty level =
-  if ty.id <= (Compiler_request_state.current ()).type_node_last_snapshot then
-    log_change (Clevel (ty, ty.level));
-  ty.level <- level
+  if get_id ty <= (Compiler_request_state.current ()).type_node_last_snapshot
+  then log_change (Clevel (ty, get_level ty));
+  Transient_expr.set_level ty level
 let set_univar rty ty =
   log_change (Cuniv (rty, !rty));
   rty := Some ty
@@ -790,8 +798,8 @@ let undo_compress (changes, _old) =
     List.iter
       (fun r ->
         match !r with
-        | Change (Ccompress (ty, desc, d), next) when ty.desc == d ->
-          ty.desc <- desc;
+        | Change (Ccompress (ty, desc, d), next) when get_desc ty == d ->
+          Transient_expr.set_desc ty desc;
           r := !next
         | _ -> ())
       log
diff --git a/compiler/ml/ctype.ml b/compiler/ml/ctype.ml
index 7b86f96de7..929311f34a 100644
--- a/compiler/ml/ctype.ml
+++ b/compiler/ml/ctype.ml
@@ -228,7 +228,7 @@ let repr = repr
 module Type_pairs = Hashtbl.Make (struct
   type t = type_expr * type_expr
   let equal (t1, t1') (t2, t2') = t1 == t2 && t1' == t2'
-  let hash (t, t') = t.id + (93 * t'.id)
+  let hash (t, t') = get_id t + (93 * get_id t')
 end)
 
 (**** unification mode ****)
@@ -307,14 +307,14 @@ type fields = field_info list
 (**** Object field manipulation. ****)
 
 let object_fields ty =
-  match (repr ty).desc with
+  match get_desc (repr ty) with
   | Tobject fields -> fields
   | _ -> assert false
 
 let flatten_fields (ty : Types.type_expr) : fields * _ =
   let rec flatten (l : fields) ty =
     let ty = repr ty in
-    match ty.desc with
+    match get_desc ty with
     | Tfield {name; mutability; typ; rest} ->
       flatten ({f_name = name; f_mut = mutability; f_typ = typ} :: l) rest
     | _ -> (l, ty)
@@ -345,18 +345,18 @@ let associate_fields (fields1 : fields) (fields2 : fields) : _ * fields * fields
 (* +++ The abbreviation should eventually be expanded *)
 let rec object_row ty =
   let ty = repr ty in
-  match ty.desc with
+  match get_desc ty with
   | Tobject t -> object_row t
   | Tfield {rest = t} -> object_row t
   | _ -> ty
 
 let object_row_is_structurally_open ty =
-  match (object_row ty).desc with
+  match get_desc (object_row ty) with
   | Tvar _ | Tunivar _ | Tconstr _ -> true
   | _ -> false
 
 let concrete_object ty =
-  match (object_row ty).desc with
+  match get_desc (object_row ty) with
   | Tvar _ -> false
   | _ -> true
 
@@ -407,9 +407,9 @@ let free_variables_ref () = Domain.DLS.get free_variables_ref_key
 
 let rec free_vars_rec real ty =
   let ty = repr ty in
-  if ty.level >= lowest_level then (
-    ty.level <- pivot_level - ty.level;
-    match ty.desc with
+  if get_level ty >= lowest_level then (
+    Transient_expr.set_level ty (pivot_level - get_level ty);
+    match get_desc ty with
     | Tvar _ -> free_variables_ref () := (ty, real) :: !(free_variables_ref ())
     | Tobject ty -> free_vars_rec false ty
     | Tfield {typ = ty1; rest = ty2} ->
@@ -508,9 +508,9 @@ let duplicate_type ty = Subst.type_expr Subst.identity ty
 *)
 let rec generalize ty =
   let ty = repr ty in
-  if ty.level > !(current_level ()) && ty.level <> generic_level then (
+  if get_level ty > !(current_level ()) && get_level ty <> generic_level then (
     set_level ty generic_level;
-    (match ty.desc with
+    (match get_desc ty with
     | Tconstr (_, _, abbrev) -> iter_abbrev generalize !abbrev
     | _ -> ());
     iter_type_expr generalize ty)
@@ -523,12 +523,12 @@ let generalize ty =
 
 let rec generalize_structure var_level ty =
   let ty = repr ty in
-  if ty.level <> generic_level then
-    if is_Tvar ty && ty.level > var_level then set_level ty var_level
+  if get_level ty <> generic_level then
+    if is_Tvar ty && get_level ty > var_level then set_level ty var_level
     else if
-      ty.level > !(current_level ())
+      get_level ty > !(current_level ())
       &&
-      match ty.desc with
+      match get_desc ty with
       | Tconstr (p, _, abbrev) ->
         (not (is_object_type p))
         &&
@@ -559,7 +559,7 @@ let forward_try_expand_once =
       module M = struct type t let _ = (x : t list ref) end
     (without this constraint, the type system would actually be unsound.)
 *)
-let get_level env p =
+let get_path_level env p =
   try
     match (Env.find_type p env).type_newtype_level with
     | None -> Path.binding_time p
@@ -583,12 +583,12 @@ let rec normalize_package_path env p =
 
 let rec update_level env level expand ty =
   let ty = repr ty in
-  if ty.level > level then (
+  if get_level ty > level then (
     (match Env.gadt_instance_level env ty with
     | Some lv -> if level < lv then raise (Unify [(ty, newvar2 level)])
     | None -> ());
-    match ty.desc with
-    | Tconstr (p, _tl, _abbrev) when level < get_level env p -> (
+    match get_desc ty with
+    | Tconstr (p, _tl, _abbrev) when level < get_path_level env p -> (
       (* Try first to replace an abbreviation by its expansion. *)
       try
         (* if is_newtype env p then raise Cannot_expand; *)
@@ -596,8 +596,8 @@ let rec update_level env level expand ty =
         update_level env level expand ty
       with Cannot_expand ->
         (* +++ Levels should be restored... *)
-        (* Format.printf "update_level: %i < %i@." level (get_level env p); *)
-        if level < get_level env p then raise (Unify [(ty, newvar2 level)]);
+        (* Format.printf "update_level: %i < %i@." level (get_path_level env p); *)
+        if level < get_path_level env p then raise (Unify [(ty, newvar2 level)]);
         iter_type_expr (update_level env level expand) ty)
     | Tconstr (_, _ :: _, _) when expand -> (
       try
@@ -610,14 +610,14 @@ let rec update_level env level expand ty =
       let p' = normalize_package_path env p in
       if Path.same p p' then raise (Unify [(ty, newvar2 level)]);
       log_type ty;
-      ty.desc <- Tpackage (p', nl, tl);
+      Transient_expr.set_desc ty (Tpackage (p', nl, tl));
       update_level env level expand ty
     | Tvariant row ->
       let row = row_repr row in
       (match row.row_name with
-      | Some (p, _tl) when level < get_level env p ->
+      | Some (p, _tl) when level < get_path_level env p ->
         log_type ty;
-        ty.desc <- Tvariant {row with row_name = None}
+        Transient_expr.set_desc ty (Tvariant {row with row_name = None})
       | _ -> ());
       set_level ty level;
       iter_type_expr (update_level env level expand) ty
@@ -630,7 +630,7 @@ let rec update_level env level expand ty =
    to avoid combinatorial blow-up *)
 let update_level env level ty =
   let ty = repr ty in
-  if ty.level > level then (
+  if get_level ty > level then (
     let snap = snapshot () in
     try update_level env level false ty
     with Unify _ ->
@@ -641,10 +641,10 @@ let update_level env level ty =
 
 let rec generalize_expansive env var_level visited ty =
   let ty = repr ty in
-  if ty.level = generic_level || ty.level <= var_level then ()
-  else if not (Hashtbl.mem visited ty.id) then (
-    Hashtbl.add visited ty.id ();
-    match ty.desc with
+  if get_level ty = generic_level || get_level ty <= var_level then ()
+  else if not (Hashtbl.mem visited (get_id ty)) then (
+    Hashtbl.add visited (get_id ty) ();
+    match get_desc ty with
     | Tconstr (path, tyl, abbrev) ->
       let variance =
         try (Env.find_type path env).type_variance
@@ -695,7 +695,7 @@ let compute_univars ty =
   inv_type inverted [] ty;
   let node_univars = Type_hash.create 17 in
   let rec add_univar univ inv =
-    match inv.inv_type.desc with
+    match get_desc inv.inv_type with
     | Tpoly (_ty, tl) when List.memq univ (List.map repr tl) -> ()
     | _ -> (
       try
@@ -744,26 +744,26 @@ let abbreviations () = Domain.DLS.get abbreviations_key
 let rec copy ?env ?partial ?keep_names ty =
   let copy = copy ?env ?partial ?keep_names in
   let ty = repr ty in
-  match ty.desc with
+  match get_desc ty with
   | Tsubst ty -> ty
   | _ ->
-    if ty.level <> generic_level && partial = None then ty
+    if get_level ty <> generic_level && partial = None then ty
     else
       (* We only forget types that are non generic and do not contain
          free univars *)
       let forget =
-        if ty.level = generic_level then generic_level
+        if get_level ty = generic_level then generic_level
         else
           match partial with
           | None -> assert false
           | Some (free_univars, keep) ->
             if Type_set.is_empty (free_univars ty) then
-              if keep then ty.level else !(current_level ())
+              if keep then get_level ty else !(current_level ())
             else generic_level
       in
       if forget <> generic_level then newty2 forget (Tvar None)
       else
-        let desc = ty.desc in
+        let desc = get_desc ty in
         save_desc ty desc;
         let t = newvar () in
         (* Stub *)
@@ -773,8 +773,8 @@ let rec copy ?env ?partial ?keep_names ty =
           | Some lv -> Env.add_gadt_instances env lv [t]
           | None -> ())
         | _ -> ());
-        ty.desc <- Tsubst t;
-        t.desc <-
+        Transient_expr.set_desc ty (Tsubst t);
+        Transient_expr.set_desc t
           (match desc with
           | Tconstr (p, tl, _) -> (
             let abbrevs = proper_abbrevs p tl !(abbreviations ()) in
@@ -802,30 +802,40 @@ let rec copy ?env ?partial ?keep_names ty =
             let more = repr row.row_more in
             (* We must substitute in a subtle way *)
             (* Tsubst takes a tuple containing the row var and the variant *)
-            match more.desc with
-            | Tsubst {desc = Ttuple [_; ty2]} ->
+            let already_copied copied =
+              match get_desc copied with
+              | Ttuple [_; _] -> true
+              | _ -> false
+            in
+            match get_desc more with
+            | Tsubst copied when already_copied copied ->
+              let ty2 =
+                match get_desc copied with
+                | Ttuple [_; ty2] -> ty2
+                | _ -> assert false
+              in
               (* This variant type has been already copied *)
-              ty.desc <- Tsubst ty2;
+              Transient_expr.set_desc ty (Tsubst ty2);
               (* avoid Tlink in the new type *)
               Tlink ty2
             | _ ->
               (* If the row variable is not generic, we must keep it *)
-              let keep = more.level <> generic_level in
+              let keep = get_level more <> generic_level in
               let more' =
-                match more.desc with
+                match get_desc more with
                 | Tsubst ty -> ty
                 | Tconstr _ | Tnil ->
-                  if keep then save_desc more more.desc;
+                  if keep then save_desc more (get_desc more);
                   copy more
                 | Tvar _ | Tunivar _ ->
-                  save_desc more more.desc;
-                  if keep then more else newty more.desc
+                  save_desc more (get_desc more);
+                  if keep then more else newty (get_desc more)
                 | _ -> assert false
               in
               let row =
-                match repr more' with
+                match get_desc (repr more') with
                 (* PR#6163 *)
-                | {desc = Tconstr _} when not row.row_fixed ->
+                | Tconstr _ when not row.row_fixed ->
                   {row with row_fixed = true}
                 | _ -> row
               in
@@ -834,10 +844,10 @@ let rec copy ?env ?partial ?keep_names ty =
                 match partial with
                 | Some (free_univars, false) ->
                   let more' =
-                    if more.id != more'.id then more'
+                    if get_id more != get_id more' then more'
                     else
                       let lv =
-                        if keep then more.level else !(current_level ())
+                        if keep then get_level more else !(current_level ())
                       in
                       newty2 lv (Tvar None)
                   in
@@ -863,7 +873,8 @@ let rec copy ?env ?partial ?keep_names ty =
                 | _ -> (more', row)
               in
               (* Register new type first for recursion *)
-              more.desc <- Tsubst (newgenty (Ttuple [more'; t]));
+              Transient_expr.set_desc more
+                (Tsubst (newgenty (Ttuple [more'; t])));
               (* Return a new copy *)
               Tvariant (copy_row copy true row keep more'))
           | Tobject ty1 when partial <> None -> Tobject (copy ty1)
@@ -958,8 +969,8 @@ let instance_constructor ?in_pattern cstr =
           (* [$a] for the variable ['a], numbered when the name is taken,
              so that distinct existentials print differently *)
           let name =
-            match repr existential with
-            | {desc = Tvar (Some name)} -> "$" ^ name
+            match get_desc (repr existential) with
+            | Tvar (Some name) -> "$" ^ name
             | _ -> "$" ^ cstr.cstr_name
           in
           let id = Ident.create (get_new_abstract_name name) in
@@ -1034,10 +1045,11 @@ let rec copy_sep fixed free bound visited ty =
   let ty = repr ty in
   let univars = free ty in
   if Type_set.is_empty univars then (
-    if ty.level <> generic_level then ty
+    if get_level ty <> generic_level then ty
     else
       let t = newvar () in
-      delayed_copy () := lazy (t.desc <- Tlink (copy ty)) :: !(delayed_copy ());
+      delayed_copy () :=
+        lazy (Transient_expr.set_desc t (Tlink (copy ty))) :: !(delayed_copy ());
       t)
   else
     try
@@ -1049,40 +1061,40 @@ let rec copy_sep fixed free bound visited ty =
       let t = newvar () in
       (* Stub *)
       let visited =
-        match ty.desc with
+        match get_desc ty with
         | Tarrow _ | Ttuple _ | Tvariant _ | Tconstr _ | Tobject _ | Tpackage _
           ->
           (ty, (t, bound)) :: visited
         | _ -> visited
       in
       let copy_rec = copy_sep fixed free bound visited in
-      t.desc <-
-        (match ty.desc with
+      Transient_expr.set_desc t
+        (match get_desc ty with
         | Tvariant row0 ->
           let row = row_repr row0 in
           let more = repr row.row_more in
           (* We shall really check the level on the row variable *)
-          let keep = is_Tvar more && more.level <> generic_level in
+          let keep = is_Tvar more && get_level more <> generic_level in
           let more' = copy_rec more in
           let fixed' = fixed && is_Tvar (repr more') in
           let row = copy_row copy_rec fixed' row keep more' in
           Tvariant row
         | Tpoly (t1, tl) ->
           let tl = List.map repr tl in
-          let tl' = List.map (fun t -> newty t.desc) tl in
+          let tl' = List.map (fun t -> newty (get_desc t)) tl in
           let bound = tl @ bound in
           let visited =
             List.map2 (fun ty t -> (ty, (t, bound))) tl tl' @ visited
           in
           Tpoly (copy_sep fixed free bound visited t1, tl')
-        | _ -> copy_type_desc copy_rec ty.desc);
+        | _ -> copy_type_desc copy_rec (get_desc ty));
       t
 
 let instance_poly ?(keep_names = false) ~fixed univars sch =
   with_copy_session (fun () ->
       let univars = List.map repr univars in
       let copy_var ty =
-        match ty.desc with
+        match get_desc ty with
         | Tunivar name -> if keep_names then newty (Tvar name) else newvar ()
         | _ -> assert false
       in
@@ -1098,8 +1110,8 @@ let instance_label fixed lbl =
   with_copy_session (fun () ->
       let ty_res = copy lbl.lbl_res in
       let vars, ty_arg =
-        match repr lbl.lbl_arg with
-        | {desc = Tpoly (ty, tl)} -> instance_poly ~fixed tl ty
+        match get_desc (repr lbl.lbl_arg) with
+        | Tpoly (ty, tl) -> instance_poly ~fixed tl ty
         | _ -> ([], copy lbl.lbl_arg)
       in
       (vars, ty_arg, ty_res))
@@ -1119,10 +1131,12 @@ let subst env level priv abbrev ty params args body =
     (* Stub *)
     (match ty with
     | None -> ()
-    | Some ({desc = Tconstr (path, tl, _)} as ty) ->
-      let abbrev = proper_abbrevs path tl abbrev in
-      memorize_abbrev abbrev priv path ty body0
-    | _ -> assert false);
+    | Some ty -> (
+      match get_desc ty with
+      | Tconstr (path, tl, _) ->
+        let abbrev = proper_abbrevs path tl abbrev in
+        memorize_abbrev abbrev priv path ty body0
+      | _ -> assert false));
     abbreviations () := abbrev;
     let params', body' = instance_parameterized_type params body in
     abbreviations () := ref Mnil;
@@ -1186,8 +1200,9 @@ let check_abbrev_env env =
 *)
 let expand_abbrev_gen kind find_type_expansion env ty =
   check_abbrev_env env;
-  match ty with
-  | {desc = Tconstr (path, args, abbrev); level} -> (
+  let level = get_level ty in
+  match get_desc ty with
+  | Tconstr (path, args, abbrev) -> (
     let lookup_abbrev = proper_abbrevs path args abbrev in
     match find_expans kind path !lookup_abbrev with
     | Some ty' ->
@@ -1251,7 +1266,7 @@ let safe_abbrev env ty =
    May raise Unify, if a recursion was hidden in the type. *)
 let try_expand_once env ty =
   let ty = repr ty in
-  match ty.desc with
+  match get_desc ty with
   | Tconstr _ -> repr (expand_abbrev env ty)
   | _ -> raise Cannot_expand
 
@@ -1289,7 +1304,7 @@ let _ = forward_try_expand_once := try_expand_safe
 
 let rec extract_concrete_typedecl env ty =
   let ty = repr ty in
-  match ty.desc with
+  match get_desc ty with
   | Tconstr (p, _, _) ->
     let decl = Env.find_type p env in
     if decl.type_kind <> Type_abstract then (p, p, decl)
@@ -1312,7 +1327,7 @@ let expand_abbrev_opt = expand_abbrev_gen Private Env.find_type_expansion_opt
 
 let try_expand_once_opt env ty =
   let ty = repr ty in
-  match ty.desc with
+  match get_desc ty with
   | Tconstr _ -> repr (expand_abbrev_opt env ty)
   | _ -> raise Cannot_expand
 
@@ -1331,8 +1346,9 @@ let expand_head_opt env ty =
 (* Make sure that the type parameters of the type constructor [ty]
    respect the type constraints *)
 let enforce_constraints env ty =
-  match ty with
-  | {desc = Tconstr (path, args, _abbrev); level} -> (
+  let level = get_level ty in
+  match get_desc ty with
+  | Tconstr (path, args, _abbrev) -> (
     try
       let decl = Env.find_type path env in
       ignore
@@ -1353,7 +1369,7 @@ let full_expand env ty = repr (expand_head env ty)
 let generic_abbrev env path =
   try
     let _, body, _ = Env.find_type_expansion path env in
-    (repr body).level = generic_level
+    get_level (repr body) = generic_level
   with Not_found -> false
 
 let generic_private_abbrev env path =
@@ -1364,7 +1380,7 @@ let generic_private_abbrev env path =
      type_private = Private;
      type_manifest = Some body;
     } ->
-      (repr body).level = generic_level
+      get_level (repr body) = generic_level
     | _ -> false
   with Not_found -> false
 
@@ -1380,11 +1396,12 @@ let is_contractive env p =
 
 exception Occur
 
-let rec occur_rec env allow_recursive visited ty0 = function
-  | {desc = Tlink ty} -> occur_rec env allow_recursive visited ty0 ty
-  | ty -> (
+let rec occur_rec env allow_recursive visited ty0 ty =
+  match get_desc ty with
+  | Tlink ty -> occur_rec env allow_recursive visited ty0 ty
+  | _ -> (
     if ty == ty0 then raise Occur;
-    match ty.desc with
+    match get_desc ty with
     | Tconstr (p, _tl, _abbrev) -> (
       if allow_recursive && is_contractive env p then ()
       else
@@ -1446,7 +1463,7 @@ let occur_in env ty0 t =
 let rec local_non_recursive_abbrev strict visited env p ty =
   let ty = repr ty in
   if not (List.memq ty visited) then
-    match ty.desc with
+    match get_desc ty with
     | Tconstr (p', args, _abbrev) -> (
       if Path.same p p' then raise Occur;
       if (not strict) && is_contractive env p' then ()
@@ -1508,10 +1525,10 @@ let occur_univar env ty =
   let rec occur_rec bound ty =
     let ty = repr ty in
     if
-      ty.level >= lowest_level
+      get_level ty >= lowest_level
       &&
       if Type_set.is_empty bound then (
-        ty.level <- pivot_level - ty.level;
+        Transient_expr.set_level ty (pivot_level - get_level ty);
         true)
       else
         try
@@ -1524,7 +1541,7 @@ let occur_univar env ty =
           visited := Type_map.add ty bound !visited;
           true
     then
-      match ty.desc with
+      match get_desc ty with
       | Tunivar _ ->
         if not (Type_set.mem ty bound) then raise (Unify [(ty, newgenvar ())])
       | Tpoly (ty, tyl) ->
@@ -1574,7 +1591,7 @@ let univars_escape env univar_pairs vl ty =
     if Type_set.mem t !visited then ()
     else (
       visited := Type_set.add t !visited;
-      match t.desc with
+      match get_desc t with
       | Tpoly (t, tl) ->
         if List.exists (fun t -> Type_set.mem (repr t) family) tl then ()
         else occur t
@@ -1661,9 +1678,9 @@ let mkvariant fields closed =
 let deep_occur t0 ty =
   let rec occur_rec ty =
     let ty = repr ty in
-    if ty.level >= lowest_level then (
+    if get_level ty >= lowest_level then (
       if ty == t0 then raise Occur;
-      ty.level <- pivot_level - ty.level;
+      Transient_expr.set_level ty (pivot_level - get_level ty);
       iter_type_expr occur_rec ty)
   in
   try
@@ -1730,26 +1747,27 @@ let reify env t =
     if Type_set.mem ty !visited then ()
     else (
       visited := Type_set.add ty !visited;
-      match ty.desc with
+      match get_desc ty with
       | Tvar o ->
-        let t = create_fresh_constr ty.level o in
+        let t = create_fresh_constr (get_level ty) o in
         link_type ty t;
-        if ty.level < newtype_level then raise (Unify [(t, newvar2 ty.level)])
+        if get_level ty < newtype_level then
+          raise (Unify [(t, newvar2 (get_level ty))])
       | Tvariant r ->
         let r = row_repr r in
         (if not (static_row r) then
            if r.row_fixed then iterator (row_more r)
            else
              let m = r.row_more in
-             match m.desc with
+             match get_desc m with
              | Tvar o ->
-               let t = create_fresh_constr m.level o in
+               let t = create_fresh_constr (get_level m) o in
                let row =
                  {r with row_fields = []; row_fixed = true; row_more = t}
                in
-               link_type m (newty2 m.level (Tvariant row));
-               if m.level < newtype_level then
-                 raise (Unify [(t, newvar2 m.level)])
+               link_type m (newty2 (get_level m) (Tvariant row));
+               if get_level m < newtype_level then
+                 raise (Unify [(t, newvar2 (get_level m))])
              | _ -> assert false);
         iter_row iterator r
       | Tconstr (p, _, _) when is_object_type p ->
@@ -1785,7 +1803,7 @@ let compatible_paths p1 p2 = Path.same p1 p2
 (* Check for datatypes carefully; see PR#6348 *)
 let rec expands_to_datatype env ty =
   let ty = repr ty in
-  match ty.desc with
+  match get_desc ty with
   | Tconstr (p, _, _) -> (
     try
       is_datatype (Env.find_type p env)
@@ -1808,7 +1826,7 @@ let rec mcomp type_pairs env t1 t2 =
     let t2 = repr t2 in
     if t1 == t2 then ()
     else
-      match (t1.desc, t2.desc) with
+      match (get_desc t1, get_desc t2) with
       | Tvar _, _ | _, Tvar _ -> ()
       | Tconstr (p1, [], _), Tconstr (p2, [], _) when Path.same p1 p2 -> ()
       | _ -> (
@@ -1821,7 +1839,7 @@ let rec mcomp type_pairs env t1 t2 =
           try Type_pairs.find type_pairs (t1', t2')
           with Not_found -> (
             Type_pairs.add type_pairs (t1', t2') ();
-            match (t1'.desc, t2'.desc) with
+            match (get_desc t1', get_desc t2') with
             | Tvar _, Tvar _ -> assert false
             | Tarrow (params1, ret1), Tarrow (params2, ret2)
               when List.length params1 = List.length params2
@@ -1874,8 +1892,8 @@ and mcomp_fields type_pairs env ty1 ty2 =
   let pairs, miss1, miss2 = associate_fields fields1 fields2 in
   mcomp type_pairs env rest1 rest2;
   if
-    (miss1 <> [] && (object_row ty2).desc = Tnil)
-    || (miss2 <> [] && (object_row ty1).desc = Tnil)
+    (miss1 <> [] && get_desc (object_row ty2) = Tnil)
+    || (miss2 <> [] && get_desc (object_row ty1) = Tnil)
   then raise (Unify []);
   List.iter (fun (f1, f2) -> mcomp type_pairs env f1.f_typ f2.f_typ) pairs
 
@@ -2001,7 +2019,7 @@ let add_gadt_equation env source destination =
 let unify_eq_set_key = Request_local.new_key (fun () -> Type_pairs.create 11)
 let unify_eq_set () = Domain.DLS.get unify_eq_set_key
 
-let order_type_pair t1 t2 = if t1.id <= t2.id then (t1, t2) else (t2, t1)
+let order_type_pair t1 t2 = if get_id t1 <= get_id t2 then (t1, t2) else (t2, t1)
 
 let add_type_equality t1 t2 =
   Type_pairs.add (unify_eq_set ()) (order_type_pair t1 t2) ()
@@ -2116,11 +2134,11 @@ let unify1_var env t1 t2 =
   assert (is_Tvar t1);
   occur env t1 t2;
   occur_univar env t2;
-  let d1 = t1.desc in
+  let d1 = get_desc t1 in
   link_type t1 t2;
-  try update_level env t1.level t2
+  try update_level env (get_level t1) t2
   with Unify _ as e ->
-    t1.desc <- d1;
+    Transient_expr.set_desc t1 d1;
     raise e
 
 let rec unify (env : Env.t ref) t1 t2 =
@@ -2135,14 +2153,14 @@ let rec unify (env : Env.t ref) t1 t2 =
 
       try
         type_changed () := true;
-        (match (t1.desc, t2.desc) with
+        (match (get_desc t1, get_desc t2) with
         | Tvar _, Tconstr _ when deep_occur t1 t2 -> unify2 env t1 t2
         | Tconstr _, Tvar _ when deep_occur t2 t1 -> unify2 env t1 t2
         | Tvar _, _ -> unify1_var !env t1 t2
         | _, Tvar _ -> unify1_var !env t2 t1
         | Tunivar _, Tunivar _ ->
           unify_univar t1 t2 !(current_univar_pairs ());
-          update_level !env t1.level t2;
+          update_level !env (get_level t1) t2;
           link_type t1 t2
         | Tconstr (p1, [], a1), Tconstr (p2, [], a2)
           when Path.same p1 p2
@@ -2152,7 +2170,7 @@ let rec unify (env : Env.t ref) t1 t2 =
                && not
                     (has_cached_expansion p1 !a1 || has_cached_expansion p2 !a2)
           ->
-          update_level !env t1.level t2;
+          update_level !env (get_level t1) t2;
           link_type t1 t2
         | Tconstr (p1, [], _), Tconstr (p2, [], _)
           when Env.has_local_constraints !env
@@ -2179,7 +2197,7 @@ and unify2 env t1 t2 =
   ignore (expand_head_unif !env t2);
   let t1' = expand_head_unif !env t1 in
   let t2' = expand_head_unif !env t2 in
-  let lv = Ext_pervasives.min_int t1'.level t2'.level in
+  let lv = Ext_pervasives.min_int (get_level t1') (get_level t2') in
   update_level !env lv t2;
   update_level !env lv t1;
   if unify_eq t1' t2' then ()
@@ -2204,7 +2222,7 @@ and unify2 env t1 t2 =
 and unify3 env t1 t1' t2 t2' =
   (* Third step: truly unification *)
   (* Assumes either [t1 == t1'] or [t2 != t2'] *)
-  let d1 = t1'.desc and d2 = t2'.desc in
+  let d1 = get_desc t1' and d2 = get_desc t2' in
   let create_recursion = t2 != t2' && deep_occur t1' t2 in
 
   match (d1, d2) with
@@ -2314,8 +2332,8 @@ and unify3 env t1 t1' t2 t2' =
         enter_poly !env (current_univar_pairs ()) t1 tl1 t2 tl2 (unify env)
       | Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2) -> (
         try
-          unify_package !env (unify_list env) t1.level p1 n1 tl1 t2.level p2 n2
-            tl2
+          unify_package !env (unify_list env) (get_level t1) p1 n1 tl1
+            (get_level t2) p2 n2 tl2
         with Not_found ->
           if !(umode ()) = Expression then raise (Unify []);
           List.iter (reify env) (tl1 @ tl2)
@@ -2325,7 +2343,7 @@ and unify3 env t1 t1' t2 t2' =
       (* XXX Commentaires + changer "create_recursion"
          ||| Comments + change "create_recursion" *)
       if create_recursion then
-        match t2.desc with
+        match get_desc t2 with
         | Tconstr (p, tl, abbrev) ->
           forget_abbrev abbrev p;
           let t2'' = expand_head_unif !env t2 in
@@ -2333,7 +2351,7 @@ and unify3 env t1 t1' t2 t2' =
             link_type (repr t2) (repr t2')
         | _ -> () (* t2 has already been expanded by update_level *)
     with Unify trace ->
-      t1'.desc <- d1;
+      Transient_expr.set_desc t1' d1;
       raise (Unify trace))
 
 and unify_list env tl1 tl2 =
@@ -2343,16 +2361,16 @@ and unify_list env tl1 tl2 =
 (* Build a fresh row variable for unification *)
 and make_rowvar level use1 rest1 use2 rest2 =
   let set_name ty name =
-    match ty.desc with
+    match get_desc ty with
     | Tvar None ->
       log_type ty;
-      ty.desc <- Tvar name
+      Transient_expr.set_desc ty (Tvar name)
     | _ -> ()
   in
   let name =
-    match (rest1.desc, rest2.desc) with
+    match (get_desc rest1, get_desc rest2) with
     | Tvar (Some _ as name1), Tvar (Some _ as name2) ->
-      if rest1.level <= rest2.level then name1 else name2
+      if get_level rest1 <= get_level rest2 then name1 else name2
     | Tvar (Some _ as name), _ ->
       if use2 then set_name rest2 name;
       name
@@ -2368,7 +2386,7 @@ and unify_fields env (ty1 : Types.type_expr) (ty2 : Types.type_expr) =
   let fields1, rest1 = flatten_fields ty1
   and fields2, rest2 = flatten_fields ty2 in
   let pairs, miss1, miss2 = associate_fields fields1 fields2 in
-  let l1 = (repr ty1).level and l2 = (repr ty2).level in
+  let l1 = get_level (repr ty1) and l2 = get_level (repr ty2) in
   (* Sample openness before unifying the row tails below. [unify_mutability]
      requires this pre-unification state because tail unification can close an
      open row before the matching fields are processed. *)
@@ -2378,7 +2396,7 @@ and unify_fields env (ty1 : Types.type_expr) (ty2 : Types.type_expr) =
       (Ext_pervasives.min_int l1 l2)
       (miss2 = []) rest1 (miss1 = []) rest2
   in
-  let d1 = rest1.desc and d2 = rest2.desc in
+  let d1 = get_desc rest1 and d2 = get_desc rest2 in
   try
     unify env (build_fields l1 miss1 va) rest2;
     unify env rest1 (build_fields l2 miss2 va);
@@ -2386,7 +2404,8 @@ and unify_fields env (ty1 : Types.type_expr) (ty2 : Types.type_expr) =
       (fun (f1, f2) ->
         unify_mutability ~open1 ~open2 f1 f2;
         try
-          if !(trace_gadt_instances ()) then update_level !env va.level f1.f_typ;
+          if !(trace_gadt_instances ()) then
+            update_level !env (get_level va) f1.f_typ;
           unify env f1.f_typ f2.f_typ
         with Unify trace ->
           raise
@@ -2411,9 +2430,9 @@ and unify_fields env (ty1 : Types.type_expr) (ty2 : Types.type_expr) =
       pairs
   with exn ->
     log_type rest1;
-    rest1.desc <- d1;
+    Transient_expr.set_desc rest1 d1;
     log_type rest2;
-    rest2.desc <- d2;
+    Transient_expr.set_desc rest2 d2;
     raise exn
 
 and unify_mutability ~open1 ~open2 f1 f2 =
@@ -2447,7 +2466,10 @@ and unify_row env row1 row2 =
     let more =
       if fixed1 then rm1
       else if fixed2 then rm2
-      else newty2 (Ext_pervasives.min_int rm1.level rm2.level) (Tvar None)
+      else
+        newty2
+          (Ext_pervasives.min_int (get_level rm1) (get_level rm2))
+          (Tvar None)
     in
     let fixed = fixed1 || fixed2
     and closed = row1.row_closed || row2.row_closed in
@@ -2505,19 +2527,19 @@ and unify_row env row1 row2 =
          raise (Unify [(if row == row1 then (t1, t2) else (t2, t1))]));
       (* The following test is not principal... should rather use Tnil *)
       let rm = row_more row in
-      (*if !(trace_gadt_instances ()) && rm.desc = Tnil then () else*)
+      (*if !(trace_gadt_instances ()) && (get_desc rm) = Tnil then () else*)
       if !(trace_gadt_instances ()) then
-        update_level !env rm.level (newgenty (Tvariant row));
+        update_level !env (get_level rm) (newgenty (Tvariant row));
       if row_fixed row then
         if more == rm then ()
         else if is_Tvar rm then link_type rm more
         else unify env rm more
       else
         let ty = newgenty (Tvariant {row0 with row_fields = rest}) in
-        update_level !env rm.level ty;
+        update_level !env (get_level rm) ty;
         link_type rm ty
     in
-    let md1 = rm1.desc and md2 = rm2.desc in
+    let md1 = get_desc rm1 and md2 = get_desc rm2 in
     try
       set_more row2 r1;
       set_more row1 r2;
@@ -2531,12 +2553,12 @@ and unify_row env row1 row2 =
         pairs;
       if static_row row1 then
         let rm = row_more row1 in
-        if is_Tvar rm then link_type rm (newty2 rm.level Tnil)
+        if is_Tvar rm then link_type rm (newty2 (get_level rm) Tnil)
     with exn ->
       log_type rm1;
-      rm1.desc <- md1;
+      Transient_expr.set_desc rm1 md1;
       log_type rm2;
-      rm2.desc <- md2;
+      Transient_expr.set_desc rm2 md2;
       raise exn
 
 and unify_row_field env fixed1 fixed2 more l f1 f2 =
@@ -2599,7 +2621,7 @@ and unify_row_field env fixed1 fixed2 more l f1 f2 =
               List.iter (unify env tu1) (tlu1 @ tlu2)
           | tu :: _, [] | [], tu :: _ -> occur_univar !env tu);
           (* Is this handling of levels really principal? *)
-          List.iter (update_level !env (repr more).level) (tl1' @ tl2');
+          List.iter (update_level !env (get_level (repr more))) (tl1' @ tl2');
           let e = ref None in
           let f1' = Reither (c1 || c2, tl1', m1 || m2, e)
           and f2' = Reither (c1 || c2, tl2', m1 || m2, e) in
@@ -2610,14 +2632,14 @@ and unify_row_field env fixed1 fixed2 more l f1 f2 =
     | Rabsent, Rabsent -> ()
     | Reither (false, tl, _, e1), Rpresent (Some t2) when not fixed1 -> (
       set_row_field e1 f2;
-      update_level !env (repr more).level t2;
+      update_level !env (get_level (repr more)) t2;
       try List.iter (fun t1 -> unify env t1 t2) tl
       with exn ->
         e1 := None;
         raise exn)
     | Rpresent (Some t1), Reither (false, tl, _, e2) when not fixed2 -> (
       set_row_field e2 f1;
-      update_level !env (repr more).level t1;
+      update_level !env (get_level (repr more)) t1;
       try List.iter (unify env t1) tl
       with exn ->
         e2 := None;
@@ -2652,13 +2674,13 @@ let unify_var env t1 t2 =
   let t1 = repr t1 and t2 = repr t2 in
   if t1 == t2 then ()
   else
-    match (t1.desc, t2.desc) with
+    match (get_desc t1, get_desc t2) with
     | Tvar _, Tconstr _ when deep_occur t1 t2 -> unify (ref env) t1 t2
     | Tvar _, _ -> (
       let reset_tracing = check_trace_gadt_instances env in
       try
         occur env t1 t2;
-        update_level env t1.level t2;
+        update_level env (get_level t1) t2;
         link_type t1 t2;
         reset_trace_gadt_instances reset_tracing
       with Unify trace ->
@@ -2687,9 +2709,9 @@ let expand_head_trace env t =
    Return the parameter types and the result type. *)
 let filter_arrow_n ~env t (labels : arg_label list) =
   let t = expand_head_trace env t in
-  match t.desc with
+  match get_desc t with
   | Tvar _ ->
-    let lv = t.level in
+    let lv = get_level t in
     let params = List.map (fun l -> {lbl = l; typ = newvar2 lv}) labels in
     let t2 = newvar2 lv in
     link_type t (newty2 lv (Tarrow (params, t2)));
@@ -2705,9 +2727,9 @@ let filter_arrow_n ~env t (labels : arg_label list) =
 (* Used by [filter_method]. *)
 let rec filter_method_field env name ty =
   let ty = expand_head_trace env ty in
-  match ty.desc with
+  match get_desc ty with
   | Tvar _ ->
-    let level = ty.level in
+    let level = get_level ty in
     let ty1 = newvar2 level and ty2 = newvar2 level in
     let ty' =
       newty2 level
@@ -2741,9 +2763,9 @@ let filter_object_field_for_write env name ty :
     (type_expr, object_field_write_error) Result.t =
   let rec write_field ~can_promote ty =
     let ty = expand_head_trace env ty in
-    match ty.desc with
+    match get_desc ty with
     | Tvar _ ->
-      let level = ty.level in
+      let level = get_level ty in
       let ty1 = newvar2 level and ty2 = newvar2 level in
       let ty' =
         newty2 level
@@ -2772,11 +2794,11 @@ let filter_object_field_for_write env name ty :
     | _ -> Error Owrite_missing
   in
   let ty = expand_head_trace env ty in
-  match ty.desc with
+  match get_desc ty with
   | Tvar _ ->
     let ty1 = newvar () in
     let ty' = newobj ty1 in
-    update_level env ty.level ty';
+    update_level env (get_level ty) ty';
     link_type ty ty';
     write_field ~can_promote:true ty1
   | Tobject f -> write_field ~can_promote:(is_Tvar (object_row ty)) f
@@ -2787,11 +2809,11 @@ let filter_object_field_for_write env name ty :
    rows cannot. This operation does not require or introduce write capability. *)
 let filter_method env name ty =
   let ty = expand_head_trace env ty in
-  match ty.desc with
+  match get_desc ty with
   | Tvar _ ->
     let ty1 = newvar () in
     let ty' = newobj ty1 in
-    update_level env ty.level ty';
+    update_level env (get_level ty) ty';
     link_type ty ty';
     filter_method_field env name ty1
   | Tobject f -> filter_method_field env name f
@@ -2800,10 +2822,10 @@ let filter_method env name ty =
 let moregen_occur env level ty =
   let rec occur ty =
     let ty = repr ty in
-    if ty.level > level then (
-      if is_Tvar ty && ty.level >= generic_level - 1 then raise Occur;
-      ty.level <- pivot_level - ty.level;
-      match ty.desc with
+    if get_level ty > level then (
+      if is_Tvar ty && get_level ty >= generic_level - 1 then raise Occur;
+      Transient_expr.set_level ty (pivot_level - get_level ty);
+      match get_desc ty with
       | Tvariant row when static_row row -> iter_row occur row
       | _ -> iter_type_expr occur ty)
   in
@@ -2818,8 +2840,8 @@ let moregen_occur env level ty =
   update_level env level ty
 
 let may_instantiate inst_nongen t1 =
-  if inst_nongen then t1.level <> generic_level - 1
-  else t1.level = generic_level
+  if inst_nongen then get_level t1 <> generic_level - 1
+  else get_level t1 = generic_level
 
 let rec moregen inst_nongen type_pairs env t1 t2 =
   if t1 == t2 then ()
@@ -2829,9 +2851,9 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
     if t1 == t2 then ()
     else
       try
-        match (t1.desc, t2.desc) with
+        match (get_desc t1, get_desc t2) with
         | Tvar _, _ when may_instantiate inst_nongen t1 ->
-          moregen_occur env t1.level t2;
+          moregen_occur env (get_level t1) t2;
           occur env t1 t2;
           link_type t1 t2
         | Tconstr (p1, [], _), Tconstr (p2, [], _) when Path.same p1 p2 -> ()
@@ -2845,9 +2867,9 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
             try Type_pairs.find type_pairs (t1', t2')
             with Not_found -> (
               Type_pairs.add type_pairs (t1', t2') ();
-              match (t1'.desc, t2'.desc) with
+              match (get_desc t1', get_desc t2') with
               | Tvar _, _ when may_instantiate inst_nongen t1' ->
-                moregen_occur env t1'.level t2;
+                moregen_occur env (get_level t1') t2;
                 link_type t1' t2
               | Tarrow (params1, ret1), Tarrow (params2, ret2)
                 when List.length params1 = List.length params2
@@ -2869,7 +2891,7 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
                 try
                   unify_package env
                     (moregen_list inst_nongen type_pairs env)
-                    t1'.level p1 n1 tl1 t2'.level p2 n2 tl2
+                    (get_level t1') p1 n1 tl1 (get_level t2') p2 n2 tl2
                 with Not_found -> raise (Unify []))
               | Tvariant row1, Tvariant row2 ->
                 moregen_row inst_nongen type_pairs env row1 row2
@@ -2899,7 +2921,7 @@ and moregen_fields inst_nongen type_pairs env ty1 ty2 =
   let pairs, miss1, miss2 = associate_fields fields1 fields2 in
   if miss1 <> [] then raise (Unify []);
   moregen inst_nongen type_pairs env rest1
-    (build_fields (repr ty2).level miss2 rest2);
+    (build_fields (get_level (repr ty2)) miss2 rest2);
   List.iter
     (fun (f1, f2) ->
       if mutability_repr f1.f_mut <> mutability_repr f2.f_mut then
@@ -2933,7 +2955,7 @@ and moregen_row inst_nongen type_pairs env row1 row2 =
   if rm1 == rm2 then ()
   else
     let may_inst =
-      (is_Tvar rm1 && may_instantiate inst_nongen rm1) || rm1.desc = Tnil
+      (is_Tvar rm1 && may_instantiate inst_nongen rm1) || get_desc rm1 = Tnil
     in
     let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
     let r1, r2 =
@@ -2943,7 +2965,7 @@ and moregen_row inst_nongen type_pairs env row1 row2 =
     in
     if r1 <> [] || (row1.row_closed && ((not row2.row_closed) || r2 <> [])) then
       raise (Unify []);
-    (match (rm1.desc, rm2.desc) with
+    (match (get_desc rm1, get_desc rm2) with
     | Tunivar _, Tunivar _ -> unify_univar rm1 rm2 !(current_univar_pairs ())
     | Tunivar _, _ | _, Tunivar _ -> raise (Unify [])
     | _ when static_row row1 -> ()
@@ -2951,7 +2973,7 @@ and moregen_row inst_nongen type_pairs env row1 row2 =
       let ext =
         newgenty (Tvariant {row2 with row_fields = r2; row_name = None})
       in
-      moregen_occur env rm1.level ext;
+      moregen_occur env (get_level rm1) ext;
       link_type rm1 ext
     | Tconstr _, Tconstr _ -> moregen inst_nongen type_pairs env rm1 rm2
     | _ -> raise (Unify []));
@@ -3028,19 +3050,19 @@ let moregeneral env inst_nongen pat_sch subj_sch =
 
 let rec rigidify_rec vars ty =
   let ty = repr ty in
-  if ty.level >= lowest_level then (
-    ty.level <- pivot_level - ty.level;
-    match ty.desc with
+  if get_level ty >= lowest_level then (
+    Transient_expr.set_level ty (pivot_level - get_level ty);
+    match get_desc ty with
     | Tvar _ -> if not (List.memq ty !vars) then vars := ty :: !vars
     | Tvariant row ->
       let row = row_repr row in
       let more = repr row.row_more in
       (if is_Tvar more && not (row_fixed row) then
-         let more' = newty2 more.level more.desc in
+         let more' = newty2 (get_level more) (get_desc more) in
          let row' =
            {row with row_fixed = true; row_fields = []; row_more = more'}
          in
-         link_type more (newty2 ty.level (Tvariant row')));
+         link_type more (newty2 (get_level ty) (Tvariant row')));
       iter_row (rigidify_rec vars) row;
       (* only consider the row variable if the variant is not static *)
       if not (static_row row) then rigidify_rec vars (row_more row)
@@ -3090,8 +3112,9 @@ let expand_head_rigid env ty =
 let normalize_subst subst =
   if
     List.exists
-      (function
-        | {desc = Tlink _}, _ | _, {desc = Tlink _} -> true
+      (fun (t1, t2) ->
+        match (get_desc t1, get_desc t2) with
+        | Tlink _, _ | _, Tlink _ -> true
         | _ -> false)
       !subst
   then subst := List.map (fun (t1, t2) -> (repr t1, repr t2)) !subst
@@ -3104,7 +3127,7 @@ let rec eqtype rename type_pairs subst env t1 t2 =
     if t1 == t2 then ()
     else
       try
-        match (t1.desc, t2.desc) with
+        match (get_desc t1, get_desc t2) with
         | Tvar _, Tvar _ when rename -> (
           try
             normalize_subst subst;
@@ -3123,7 +3146,7 @@ let rec eqtype rename type_pairs subst env t1 t2 =
             try Type_pairs.find type_pairs (t1', t2')
             with Not_found -> (
               Type_pairs.add type_pairs (t1', t2') ();
-              match (t1'.desc, t2'.desc) with
+              match (get_desc t1', get_desc t2') with
               | Tvar _, Tvar _ when rename -> (
                 try
                   normalize_subst subst;
@@ -3152,7 +3175,7 @@ let rec eqtype rename type_pairs subst env t1 t2 =
                 try
                   unify_package env
                     (eqtype_list rename type_pairs subst env)
-                    t1'.level p1 n1 tl1 t2'.level p2 n2 tl2
+                    (get_level t1') p1 n1 tl1 (get_level t2') p2 n2 tl2
                 with Not_found -> raise (Unify []))
               | Tvariant row1, Tvariant row2 ->
                 eqtype_row rename type_pairs subst env row1 row2
@@ -3188,8 +3211,8 @@ and eqtype_fields rename type_pairs subst env ty1 ty2 : unit =
   if same_row then ()
   else
     (* Try expansion, needed when called from Includecore.type_manifest *)
-    match expand_head_rigid env rest2 with
-    | {desc = Tobject ty2} -> eqtype_fields rename type_pairs subst env ty1 ty2
+    match get_desc (expand_head_rigid env rest2) with
+    | Tobject ty2 -> eqtype_fields rename type_pairs subst env ty1 ty2
     | _ ->
       let pairs, miss1, miss2 = associate_fields fields1 fields2 in
       eqtype rename type_pairs subst env rest1 rest2;
@@ -3223,8 +3246,8 @@ and eqtype_fields rename type_pairs subst env ty1 ty2 : unit =
 
 and eqtype_row rename type_pairs subst env row1 row2 =
   (* Try expansion, needed when called from Includecore.type_manifest *)
-  match expand_head_rigid env (row_more row2) with
-  | {desc = Tvariant row2} -> eqtype_row rename type_pairs subst env row1 row2
+  match get_desc (expand_head_rigid env (row_more row2)) with
+  | Tvariant row2 -> eqtype_row rename type_pairs subst env row1 row2
   | _ ->
     let row1 = row_repr row1 and row2 = row_repr row2 in
     let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
@@ -3306,8 +3329,10 @@ let collect l = List.fold_left (fun c1 (_, c2) -> max c1 c2) Unchanged l
 
 let rec filter_visited = function
   | [] -> []
-  | {desc = Tobject _ | Tvariant _} :: _ as l -> l
-  | _ :: l -> filter_visited l
+  | t :: rest as l -> (
+    match get_desc t with
+    | Tobject _ | Tvariant _ -> l
+    | _ -> filter_visited rest)
 
 let memq_warn t visited =
   if List.memq t visited then (
@@ -3329,7 +3354,7 @@ let has_constr_row' env t = has_constr_row (expand_abbrev env t)
 
 let rec build_subtype env visited loops posi level t =
   let t = repr t in
-  match t.desc with
+  match get_desc t with
   | Tvar _ ->
     if posi then
       try
@@ -3553,7 +3578,7 @@ let rec subtype_rec env trace t1 t2 cstrs =
       cstrs
     with Not_found -> (
       Type_pairs.add (subtypes ()) (t1, t2) ();
-      match (t1.desc, t2.desc) with
+      match (get_desc t1, get_desc t2) with
       | Tvar _, _ | _, Tvar _ ->
         (trace, t1, t2, !(current_univar_pairs ()), None) :: cstrs
       | Tarrow (params1, ret1), Tarrow (params2, ret2)
@@ -3594,8 +3619,8 @@ let rec subtype_rec env trace t1 t2 cstrs =
                   then cstrs
                   else
                     ( trace,
-                      newty2 t1.level (Ttuple [t1]),
-                      newty2 t2.level (Ttuple [t2]),
+                      newty2 (get_level t1) (Ttuple [t1]),
+                      newty2 (get_level t2) (Ttuple [t2]),
                       !(current_univar_pairs ()),
                       None )
                     :: cstrs
@@ -3975,9 +4000,10 @@ let rec subtype_rec env trace t1 t2 cstrs =
           (trace, t1, t2, !(current_univar_pairs ()), None) :: cstrs)
       | Tpackage (p1, nl1, tl1), Tpackage (p2, nl2, tl2) -> (
         try
-          let ntl1 = complete_type_list env nl2 t1.level (Mty_ident p1) nl1 tl1
+          let ntl1 =
+            complete_type_list env nl2 (get_level t1) (Mty_ident p1) nl1 tl1
           and ntl2 =
-            complete_type_list env nl1 t2.level (Mty_ident p2) nl2 tl2
+            complete_type_list env nl1 (get_level t2) (Mty_ident p2) nl2 tl2
               ~allow_absent:true
           in
           let cstrs' =
@@ -4015,12 +4041,12 @@ and subtype_fields env trace ty1 ty2 cstrs =
   let fields2, rest2 = flatten_fields ty2 in
   let pairs, miss1, miss2 = associate_fields fields1 fields2 in
   let cstrs =
-    if rest2.desc = Tnil then cstrs
+    if get_desc rest2 = Tnil then cstrs
     else if miss1 = [] then
       subtype_rec env ((rest1, rest2) :: trace) rest1 rest2 cstrs
     else
       ( trace,
-        build_fields (repr ty1).level miss1 rest1,
+        build_fields (get_level (repr ty1)) miss1 rest1,
         rest2,
         !(current_univar_pairs ()),
         None )
@@ -4031,7 +4057,7 @@ and subtype_fields env trace ty1 ty2 cstrs =
     else
       ( trace,
         rest1,
-        build_fields (repr ty2).level miss2 (newvar ()),
+        build_fields (get_level (repr ty2)) miss2 (newvar ()),
         !(current_univar_pairs ()),
         None )
       :: cstrs
@@ -4079,7 +4105,7 @@ and subtype_row env trace row1 row2 cstrs =
   let row1 = row_repr row1 and row2 = row_repr row2 in
   let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
   let more1 = repr row1.row_more and more2 = repr row2.row_more in
-  match (more1.desc, more2.desc) with
+  match (get_desc more1, get_desc more2) with
   | Tconstr (p1, _, _), Tconstr (p2, _, _) when Path.same p1 p2 ->
     subtype_rec env ((more1, more2) :: trace) more1 more2 cstrs
   | (Tvar _ | Tconstr _ | Tnil), (Tvar _ | Tconstr _ | Tnil)
@@ -4140,29 +4166,31 @@ let subtype env ty1 ty2 =
 (* Utility for printing. The resulting type is not used in computation. *)
 let rec unalias_object ty =
   let ty = repr ty in
-  match ty.desc with
-  | Tfield f -> newty2 ty.level (Tfield {f with rest = unalias_object f.rest})
-  | Tvar _ | Tnil -> newty2 ty.level ty.desc
+  match get_desc ty with
+  | Tfield f ->
+    newty2 (get_level ty) (Tfield {f with rest = unalias_object f.rest})
+  | Tvar _ | Tnil -> newty2 (get_level ty) (get_desc ty)
   | Tunivar _ -> ty
-  | Tconstr _ -> newvar2 ty.level
+  | Tconstr _ -> newvar2 (get_level ty)
   | _ -> assert false
 
 let unalias ty =
   let ty = repr ty in
-  match ty.desc with
+  match get_desc ty with
   | Tvar _ | Tunivar _ -> ty
   | Tvariant row ->
     let row = row_repr row in
     let more = row.row_more in
-    newty2 ty.level (Tvariant {row with row_more = newty2 more.level more.desc})
-  | Tobject ty -> newty2 ty.level (Tobject (unalias_object ty))
-  | _ -> newty2 ty.level ty.desc
+    newty2 (get_level ty)
+      (Tvariant {row with row_more = newty2 (get_level more) (get_desc more)})
+  | Tobject ty -> newty2 (get_level ty) (Tobject (unalias_object ty))
+  | _ -> newty2 (get_level ty) (get_desc ty)
 
 (* Check whether an abbreviation expands to itself. *)
 let cyclic_abbrev env id ty =
   let rec check_cycle seen ty =
     let ty = repr ty in
-    match ty.desc with
+    match get_desc ty with
     | Tconstr (p, _tl, _abbrev) -> (
       (match p with
         | Path.Pident p -> Ident.same p id
@@ -4186,8 +4214,8 @@ let rec closed_schema_rec env ty =
   if Type_set.mem ty !(visited ()) then ()
   else (
     visited () := Type_set.add ty !(visited ());
-    match ty.desc with
-    | Tvar _ when ty.level <> generic_level -> raise Non_closed0
+    match get_desc ty with
+    | Tvar _ when get_level ty <> generic_level -> raise Non_closed0
     | Tconstr _ -> (
       let old = !(visited ()) in
       try iter_type_expr (closed_schema_rec env) ty
@@ -4224,15 +4252,16 @@ let rec normalize_type_rec env visited ty =
     visited := Type_set.add ty !visited;
     let tm = row_of_type ty in
     (if (not (is_Tconstr ty)) && is_constr_row ~allow_ident:false tm then
-       match tm.desc with
+       match get_desc tm with
        (* PR#7348 *)
        | Tconstr (Path.Pdot (m, i, pos), tl, _abbrev) ->
          let i' = String.sub i 0 (String.length i - 4) in
          log_type ty;
-         ty.desc <- Tconstr (Path.Pdot (m, i', pos), tl, ref Mnil)
+         Transient_expr.set_desc ty
+           (Tconstr (Path.Pdot (m, i', pos), tl, ref Mnil))
        | _ -> assert false
      else
-       match ty.desc with
+       match get_desc ty with
        | Tvariant row ->
          let row = row_repr row in
          let fields =
@@ -4265,15 +4294,15 @@ let rec normalize_type_rec env visited ty =
              (Ext_list.filter fields (fun (_, fi) -> fi <> Rabsent))
          in
          log_type ty;
-         ty.desc <- Tvariant {row with row_fields = fields}
+         Transient_expr.set_desc ty (Tvariant {row with row_fields = fields})
        | Tobject fi ->
          let fi = repr fi in
-         if fi.level < lowest_level then ()
+         if get_level fi < lowest_level then ()
          else
            let fields, row = flatten_fields fi in
-           let fi' = build_fields fi.level fields row in
+           let fi' = build_fields (get_level fi) fields row in
            log_type ty;
-           fi.desc <- fi'.desc
+           Transient_expr.set_desc fi (get_desc fi')
        | _ -> ());
     iter_type_expr (normalize_type_rec env visited) ty)
 
@@ -4314,7 +4343,7 @@ let with_nondep_copy_session f =
         raise exn)
 
 let rec nondep_type_rec env id ty =
-  match ty.desc with
+  match get_desc ty with
   | Tvar _ | Tunivar _ -> ty
   | Tlink ty -> nondep_type_rec env id ty
   | _ -> (
@@ -4323,14 +4352,14 @@ let rec nondep_type_rec env id ty =
       let ty' = newgenvar () in
       (* Stub *)
       Type_hash.add (nondep_hash ()) ty ty';
-      ty'.desc <-
-        (match ty.desc with
+      Transient_expr.set_desc ty'
+        (match get_desc ty with
         | Tconstr (p, tl, _abbrev) ->
           if Path.isfree id p then
             try
               Tlink
                 (nondep_type_rec env id
-                   (expand_abbrev env (newty2 ty.level ty.desc)))
+                   (expand_abbrev env (newty2 (get_level ty) (get_desc ty))))
               (*
                  The [Tlink] is important. The expanded type may be a
                  variable, or may not be completely copied yet
@@ -4364,7 +4393,7 @@ let rec nondep_type_rec env id ty =
             | Some (p, _tl) when Path.isfree id p ->
               Tvariant {row with row_name = None}
             | _ -> Tvariant row))
-        | _ -> copy_type_desc (nondep_type_rec env id) ty.desc);
+        | _ -> copy_type_desc (nondep_type_rec env id) (get_desc ty));
       ty')
 
 let nondep_type env id ty =
@@ -4376,8 +4405,8 @@ let unroll_abbrev id tl ty =
   let ty = repr ty and path = Path.Pident id in
   if is_Tvar ty || List.exists (deep_occur ty) tl || is_object_type path then ty
   else
-    let ty' = newty2 ty.level ty.desc in
-    link_type ty (newty2 ty.level (Tconstr (path, tl, ref Mnil)));
+    let ty' = newty2 (get_level ty) (get_desc ty) in
+    link_type ty (newty2 (get_level ty) (Tconstr (path, tl, ref Mnil)));
     ty'
 
 (* Preserve sharing inside type declarations. *)
@@ -4426,7 +4455,7 @@ let nondep_extension_constructor env mid ext =
               (Tconstr (ext.ext_type_path, ext.ext_type_params, ref Mnil))
           in
           let ty' = nondep_type_rec env mid ty in
-          match (repr ty').desc with
+          match get_desc (repr ty') with
           | Tconstr (p, tl, _) -> (p, tl)
           | _ -> raise Not_found
         else
@@ -4453,14 +4482,14 @@ let nondep_extension_constructor env mid ext =
 let same_constr env t1 t2 =
   let t1 = expand_head env t1 in
   let t2 = expand_head env t2 in
-  match (t1.desc, t2.desc) with
+  match (get_desc t1, get_desc t2) with
   | Tconstr (p1, _, _), Tconstr (p2, _, _) -> Path.same p1 p2
   | _ -> false
 
 let () = Env.same_constr := same_constr
 
 let maybe_pointer_type env typ =
-  match (repr typ).desc with
+  match get_desc (repr typ) with
   | Tconstr (p, _args, _abbrev) -> (
     try
       let type_decl = Env.find_type p env in
@@ -4483,7 +4512,7 @@ let maybe_pointer_type env typ =
   | _ -> true
 
 let get_arity env typ =
-  match (expand_head env typ).desc with
+  match get_desc (expand_head env typ) with
   | Tarrow (params, _) -> Some (List.length params)
   | _ -> None
 
@@ -4497,7 +4526,7 @@ let rec get_unboxed_type_representation env ty fuel =
   if fuel < 0 then None
   else
     let ty = repr (expand_head_opt env ty) in
-    match ty.desc with
+    match get_desc ty with
     | Tconstr (p, args, _) -> (
       match Env.find_type p env with
       | exception Not_found -> Some ty
diff --git a/compiler/ml/types.ml b/compiler/ml/types.ml
index e466261ef3..e457df972d 100644
--- a/compiler/ml/types.ml
+++ b/compiler/ml/types.ml
@@ -68,10 +68,32 @@ and field_mutability =
   | Mutability_value of Asttypes.mutable_flag
   | Mutability_link of field_mutability ref
 
+(* The primitives below index the fields of [type_expr] by position: [desc] is
+   field 0 and [level] field 1. Reordering the record would make them read the
+   wrong field without a type error, so the check below fails as soon as the
+   compiler starts instead. *)
+external get_desc : type_expr -> type_desc = "%field0"
+external get_level : type_expr -> int = "%field1"
+let get_id t = t.id
+
+let () =
+  let t = {desc = Tnil; level = 12345; id = 0} in
+  if not (get_desc t == Tnil && get_level t = 12345) then
+    failwith "Types: get_desc and get_level don't match the type_expr fields"
+
+module Transient_expr = struct
+  let create desc ~level ~id = {desc; level; id}
+
+  external set_desc : type_expr -> type_desc -> unit = "%setfield0"
+
+  (* OCaml 5.0 has no [%setfield1]. *)
+  let set_level t level = t.level <- level
+end
+
 module Type_ops = struct
   type t = type_expr
-  let compare t1 t2 = t1.id - t2.id
-  let hash t = t.id
+  let compare t1 t2 = get_id t1 - get_id t2
+  let hash t = get_id t
   let equal t1 t2 = t1 == t2
 end
 
diff --git a/compiler/ml/types.mli b/compiler/ml/types.mli
index 6f5e80a7b2..555445ae52 100644
--- a/compiler/ml/types.mli
+++ b/compiler/ml/types.mli
@@ -179,6 +179,54 @@ and field_mutability =
   | Mutability_value of Asttypes.mutable_flag
   | Mutability_link of field_mutability ref
 
+(** {1 Access to type nodes}
+
+    Code reads the fields of a [type_expr] through these accessors and changes
+    them through the logged setters in [Btype] ([link_type], [set_level],
+    [log_type]). This follows upstream OCaml (4.14 and later), where
+    [type_expr] is abstract, and it separates the type checker from the
+    representation of type nodes, so that the representation can change
+    later, for example to an index into a per-request store.
+
+    The record above stays visible for now, so modules which still read its
+    fields directly keep compiling while they are converted. Making
+    [type_expr] abstract is the end state of this refactoring.
+
+    Unlike upstream's [get_desc], [get_desc] does not call [Btype.repr]: it
+    returns the node's own descriptor, which can be [Tlink]. Callers keep
+    calling [repr] first, so path compression and its trail entries happen
+    exactly where they did before.
+
+    [get_desc] and [get_level] are primitives, so they compile to the same
+    field loads as [ty.desc] and [ty.level], also in builds without
+    cross-module inlining. *)
+
+external get_desc : type_expr -> type_desc = "%field0"
+(** The node's descriptor, without following [Tlink]. *)
+
+external get_level : type_expr -> int = "%field1"
+
+val get_id : type_expr -> int
+(** The node's unique identifier, allocated by [Btype.newty2]. *)
+
+(** Creation and unlogged updates of type nodes. The setters change a field
+    without recording its old value on the backtracking trail. Their users are
+    [Btype] (node creation, the trail itself, copy sessions and marking), and
+    the parts of [Ctype] which either restore their own temporary changes
+    (copy marks, level marks, temporary links during unification) or call
+    [Btype.log_type] first, which records the old descriptor before a
+    persistent change. Other code uses the logged setters of [Btype].
+
+    Upstream OCaml's setters take a separate [transient_expr], obtained with
+    [Transient_expr.repr], so that they bypass the [repr] built into its
+    [get_desc]. There is no implicit [repr] here, so they take a [type_expr]. *)
+module Transient_expr : sig
+  val create : type_desc -> level:int -> id:int -> type_expr
+
+  external set_desc : type_expr -> type_desc -> unit = "%setfield0"
+  val set_level : type_expr -> int -> unit
+end
+
 module Type_ops : sig
   type t = type_expr
   val compare : t -> t -> int