Re-check Tpackage scope escapes after normalising paths (#9715)

Rewrite check_scope_escape using proper marking and unmarking

This uses the Btype.snapshot/backtrack mechanism, to ensure that we
always undo marking on types from the environment and to avoid a
`try ... with ...` construction for each recursive call.

Changes

@@ -366,6 +366,9 @@ Working version
 - #9688: Expose the main entrypoint in compilerlibs
   (Stephen Dolan, review by Nicolás Ojeda Bär, Greta Yorsh and David Allsopp)
 
+- #9715: recheck scope escapes after normalising paths
+  (Matthew Ryan, review by Gabriel Scherer and Thomas Refis)
+
 - #9778: Fix printing for bindings where polymorphic type annotations and
   attributes are present.
   (Matthew Ryan, review by Nicolás Ojeda Bär)

typing/ctype.ml

@@ -812,34 +812,45 @@ let rec normalize_package_path env p =
           normalize_package_path env (Path.Pdot (p1', s))
       | _ -> p
 
-let check_scope_escape env level ty =
-  let rec loop ty =
-    let ty = repr ty in
-    if ty.level >= lowest_level then begin
-      ty.level <- pivot_level - ty.level;
-      if level < ty.scope then
-        raise(Trace.scope_escape ty);
-      begin match ty.desc with
-      | Tconstr (p, _, _) when level < Path.scope p ->
-          begin match !forward_try_expand_once env ty with
-          | ty' -> aux ty'
-          | exception Cannot_expand ->
-              raise Trace.(Unify [escape (Constructor p)])
-          end
-      | Tpackage (p, nl, tl) when level < Path.scope p ->
-          let p' = normalize_package_path env p in
-          if Path.same p p' then raise Trace.(Unify [escape (Module_type p)]);
-          aux { ty with desc = Tpackage (p', nl, tl) }
-      | _ ->
-        iter_type_expr loop ty
-      end;
-    end
-  and aux ty =
-    loop ty;
-    unmark_type ty
+let rec check_scope_escape env level ty =
+  let mark ty =
+    (* Mark visited types with [ty.level < lowest_level]. *)
+    set_level ty (pivot_level - ty.level)
   in
-  try aux ty;
+  let ty = repr ty in
+  (* If the type hasn't been marked, check it. Otherwise, we have already
+     checked it.
+  *)
+  if ty.level >= lowest_level then begin
+    if level < ty.scope then
+      raise(Trace.scope_escape ty);
+    begin match ty.desc with
+    | Tconstr (p, _, _) when level < Path.scope p ->
+        begin match !forward_try_expand_once env ty with
+        | ty' ->
+            mark ty;
+            check_scope_escape env level ty'
+        | exception Cannot_expand ->
+            raise Trace.(Unify [escape (Constructor p)])
+        end
+    | Tpackage (p, nl, tl) when level < Path.scope p ->
+        let p' = normalize_package_path env p in
+        if Path.same p p' then raise Trace.(Unify [escape (Module_type p)]);
+        let orig_level = ty.level in
+        mark ty;
+        check_scope_escape env level
+          (Btype.newty2 orig_level (Tpackage (p', nl, tl)))
+    | _ ->
+      mark ty;
+      iter_type_expr (check_scope_escape env level) ty
+    end;
+  end
+
+let check_scope_escape env level ty =
+  let snap = snapshot () in
+  try check_scope_escape env level ty; backtrack snap
   with Unify [Trace.Escape x] ->
+    backtrack snap;
     raise Trace.(Unify[Escape { x with context = Some ty }])
 
 let update_scope scope ty =