flambda-backend: Generalize deep_occur to deep_occur_list (#1503)

* Generalize deep_occur to  deep_occur_list

* Factor out deep_occur_rec to avoid extra list cell

Author: rtjoa

typing/ctype.ml

@@ -2527,18 +2527,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
 
@@ -5286,7 +5298,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
@@ -5844,7 +5856,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

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

typing/printtyp.ml

@@ -1691,7 +1691,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 ->