Key existential constructors by identifier

Codex review on #9080: the constructor of each existential was recorded by
its name, but the counter that makes names unique is reset for each
binding, so a nested module's `$a` could overwrite the constructor of an
outer `$a`. It is recorded by the identifier's stamp now.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Kbf3gLMawVgtmiKy3TMBc3
Claude-Session: https://claude.ai/code/session_01Kr4cjoUi2f5VpMvE6wT9bo
Signed-off-by: Christoph Knittel <ck@cca.io>

Author: cknitt

compiler/ml/ctype.ml

@@ -932,12 +932,15 @@ let new_declaration newtype manifest =
     type_inlined_types = [];
   }
 
-(* The constructor binding each existential type named by
-   [instance_constructor], for explaining an escaping one. *)
+(* The constructor binding each existential type created by
+   [instance_constructor], by the stamp of its identifier, for explaining an
+   escaping one. Names are not unique: their counter is reset per binding. *)
 let existential_constructors_key =
   Request_local.new_key (fun () -> Hashtbl.create 8)
-let existential_constructor name =
-  Hashtbl.find_opt (Domain.DLS.get existential_constructors_key) name
+let existential_constructor id =
+  Hashtbl.find_opt
+    (Domain.DLS.get existential_constructors_key)
+    (Ident.binding_time id)
 
 let instance_constructor ?in_pattern cstr =
   with_copy_session (fun () ->
@@ -953,11 +956,11 @@ let instance_constructor ?in_pattern cstr =
             | {desc = Tvar (Some name)} -> "$" ^ name
             | _ -> "$" ^ cstr.cstr_name
           in
-          let name = get_new_abstract_name name in
+          let id = Ident.create (get_new_abstract_name name) in
           Hashtbl.replace
             (Domain.DLS.get existential_constructors_key)
-            name cstr.cstr_name;
-          let path = Path.Pident (Ident.create name) in
+            (Ident.binding_time id) cstr.cstr_name;
+          let path = Path.Pident id in
           let new_env = Env.add_local_type path decl !env in
           env := new_env;
           let to_unify = newty (Tconstr (path, [], ref Mnil)) in

compiler/ml/ctype.mli

@@ -172,9 +172,9 @@ val instance_constructor :
   type_expr list * type_expr
 (* Same, for a constructor *)
 
-val existential_constructor : string -> string option
-(* The constructor that binds the existential type of this name, given to it
-   by [instance_constructor] in the current request *)
+val existential_constructor : Ident.t -> string option
+(* The constructor that binds this existential type, created by
+   [instance_constructor] in the current request *)
 
 val instance_parameterized_type :
   ?keep_names:bool -> type_expr list -> type_expr -> type_expr list * type_expr

compiler/ml/printtyp.ml

@@ -1303,7 +1303,7 @@ let rec mismatch = function
 let escape_explanation ppf p =
   match p with
   | Pident id -> (
-    match Ctype.existential_constructor (Ident.name id) with
+    match Ctype.existential_constructor id with
     | Some constructor ->
       fprintf ppf
         "@,\

tests/build_tests/super_errors/expected/gadt_existential_nested_binding.res.expected

@@ -0,0 +1,14 @@
+
+  We've found a bug for you!
+  /.../fixtures/gadt_existential_nested_binding.res:12:5
+
+  10 ┆     }
+  11 ┆   }
+  12 ┆   x
+  13 ┆ | Second(_) => assert(false)
+  14 ┆ }
+
+  This has type: $a
+  But it's expected to have type: 'a
+  $a is an existential type bound by the constructor First.
+  It is only known in the scope of the pattern that matches First.

tests/build_tests/super_errors/fixtures/gadt_existential_nested_binding.res

@@ -0,0 +1,14 @@
+type rec any = First('a): any | Second('a): any
+
+let get = (v, w) =>
+  switch v {
+  | First(x) =>
+    module M = {
+      let inner = switch w {
+      | Second(y) => ignore(y)
+      | First(_) => ()
+      }
+    }
+    x
+  | Second(_) => assert(false)
+  }