diff --git a/ocaml/typing/ctype.ml b/ocaml/typing/ctype.ml
index abd43765575..7dba0c09ad8 100644
--- a/ocaml/typing/ctype.ml
+++ b/ocaml/typing/ctype.ml
@@ -2521,18 +2521,30 @@ let unexpanded_diff ~got ~expected =
 
 (**** Unification ****)
 
-(* Return whether [t0] occurs in [ty]. Objects are also traversed. *)
+let rec deep_occur_rec t0 ty =
+  if get_level ty >= get_level t0 && try_mark_node ty then begin
+    if eq_type ty t0 then raise Occur;
+    iter_type_expr (deep_occur_rec t0) ty
+  end
+
+(* Return whether [t0] occurs in any type in [tyl]. Objects are also traversed. *)
+let deep_occur_list t0 tyl =
+  try
+    List.iter (deep_occur_rec t0) tyl;
+    List.iter unmark_type tyl;
+    false
+  with Occur ->
+    List.iter unmark_type tyl;
+    true
+
 let deep_occur t0 ty =
-  let rec occur_rec ty =
-    if get_level ty >= get_level t0 && try_mark_node ty then begin
-      if eq_type ty t0 then raise Occur;
-      iter_type_expr occur_rec ty
-    end
-  in
   try
-    occur_rec ty; unmark_type ty; false
+    deep_occur_rec t0 ty;
+    unmark_type ty;
+    false
   with Occur ->
-    unmark_type ty; true
+    unmark_type ty;
+    true
 
 let gadt_equations_level = ref None
 
@@ -5280,7 +5292,7 @@ let rec build_subtype env (visited : transient_expr list)
           (* Fix PR#4505: do not set ty to Tvar when it appears in tl1,
              as this occurrence might break the occur check.
              XXX not clear whether this correct anyway... *)
-          if List.exists (deep_occur ty) tl1 then raise Not_found;
+          if deep_occur_list ty tl1 then raise Not_found;
           set_type_desc ty
             (Tvar { name = None;
                     layout = Layout.value
@@ -5838,7 +5850,7 @@ let rec normalize_type_rec visited ty =
         begin match !nm with
         | None -> ()
         | Some (n, v :: l) ->
-            if deep_occur ty (newgenty (Ttuple l)) then
+            if deep_occur_list ty l then
               (* The abbreviation may be hiding something, so remove it *)
               set_name nm None
             else
diff --git a/ocaml/typing/ctype.mli b/ocaml/typing/ctype.mli
index 6accc6f72f3..b12ec0d4e3f 100644
--- a/ocaml/typing/ctype.mli
+++ b/ocaml/typing/ctype.mli
@@ -264,7 +264,11 @@ val filter_method: Env.t -> string -> type_expr -> type_expr
         (* A special case of unification (with {m : 'a; 'b}).  Raises
            [Filter_method_failed] instead of [Unify]. *)
 val occur_in: Env.t -> type_expr -> type_expr -> bool
+val deep_occur_list: type_expr -> type_expr list -> bool
+        (* Check whether a type occurs structurally within any type from
+           a list of types. *)
 val deep_occur: type_expr -> type_expr -> bool
+        (* Check whether a type occurs structurally within another. *)
 val moregeneral: Env.t -> bool -> type_expr -> type_expr -> unit
         (* Check if the first type scheme is more general than the second. *)
 val is_moregeneral: Env.t -> bool -> type_expr -> type_expr -> bool
diff --git a/ocaml/typing/printtyp.ml b/ocaml/typing/printtyp.ml
index 8573fc63499..ad824741ffd 100644
--- a/ocaml/typing/printtyp.ml
+++ b/ocaml/typing/printtyp.ml
@@ -1693,7 +1693,7 @@ let rec prepare_class_type params = function
       let row = Btype.self_type_row cty in
       if List.memq (proxy row) !visited_objects
       || not (List.for_all is_Tvar params)
-      || List.exists (deep_occur row) tyl
+      || deep_occur_list row tyl
       then prepare_class_type params cty
       else List.iter prepare_type tyl
   | Cty_signature sign ->