Bugfix for Ctype.nondep_type (#1059)

ocaml/testsuite/tests/typing-signatures/nondep_regression.ml

@@ -0,0 +1,17 @@
+(* TEST
+   * expect
+*)
+
+type 'a seq = 'a list
+
+module Make (A : sig type t end) = struct
+  type t = A.t seq
+end
+
+module H = Make (struct type t end)
+
+[%%expect{|
+type 'a seq = 'a list
+module Make : functor (A : sig type t end) -> sig type t = A.t seq end
+module H : sig type t end
+|}]

ocaml/typing/btype.ml

@@ -47,6 +47,7 @@ module TransientTypeHash = Hashtbl.Make(TransientTypeOps)
 module TypeHash = struct
   include TransientTypeHash
   let add hash = wrap_repr (add hash)
+  let remove hash = wrap_repr (remove hash)
   let find hash = wrap_repr (find hash)
   let iter f = TransientTypeHash.iter (wrap_type_expr f)
 end

ocaml/typing/btype.mli

@@ -40,6 +40,7 @@ end
 module TypeHash : sig
   include Hashtbl.S with type key = transient_expr
   val add: 'a t -> type_expr -> 'a -> unit
+  val remove : 'a t -> type_expr -> unit
   val find: 'a t -> type_expr -> 'a
   val iter: (type_expr -> 'a -> unit) -> 'a t -> unit
 end

ocaml/typing/ctype.ml

@@ -5420,7 +5420,7 @@ let rec nondep_type_rec ?(expand_private=false) env ids ty =
   with Not_found ->
     let ty' = newgenstub ~scope:(get_scope ty) in
     TypeHash.add nondep_hash ty ty';
-    let desc =
+    match
       match get_desc ty with
       | Tconstr(p, tl, _abbrev) as desc ->
           begin try
@@ -5481,9 +5481,13 @@ let rec nondep_type_rec ?(expand_private=false) env ids ty =
             | _ -> Tvariant row
           end
       | desc -> copy_type_desc (nondep_type_rec env ids) desc
-    in
-    Transient_expr.set_stub_desc ty' desc;
-    ty'
+    with
+    | desc ->
+      Transient_expr.set_stub_desc ty' desc;
+      ty'
+    | exception e ->
+      TypeHash.remove nondep_hash ty;
+      raise e
 
 let nondep_type env id ty =
   try