add locally created types to Env.local_constraints

typing/ctype.ml

@@ -1117,8 +1117,8 @@ let instance_constructor ?in_pattern cstr =
             {desc = Tvar (Some name)} -> "$" ^ cstr.cstr_name ^ "_'" ^ name
           | _ -> "$" ^ cstr.cstr_name
         in
-        let (id, new_env) =
-          Env.enter_type (get_new_abstract_name name) decl !env in
+        let id = Ident.create (get_new_abstract_name name) in
+        let new_env = Env.add_local_type id decl !env in
         env := new_env;
         let to_unify = newty (Tconstr (Path.Pident id,[],ref Mnil)) in
         let tv = copy existential in
@@ -1885,8 +1885,8 @@ let reify env t =
   let create_fresh_constr lev name =
     let decl = new_declaration (Some (newtype_level, newtype_level)) None in
     let name = match name with Some s -> "$'"^s | _ -> "$" in
-    let name = get_new_abstract_name name in
-    let (id, new_env) = Env.enter_type name decl !env in
+    let id = Ident.create (get_new_abstract_name name) in
+    let new_env = Env.add_local_type id decl !env in
     let t = newty2 lev (Tconstr (Path.Pident id,[],ref Mnil))  in
     env := new_env;
     t

typing/env.ml

@@ -1681,6 +1681,10 @@ and add_cltype id ty env =
 let add_module ?arg id mty env =
   add_module_declaration ?arg id (md mty) env
 
+let add_local_type id info env =
+  { env with
+    local_constraints = PathMap.add (Pident id) info env.local_constraints }
+
 let add_local_constraint id info elv env =
   match info with
     {type_manifest = Some _; type_newtype_level = Some (lv, _)} ->
@@ -1688,11 +1692,10 @@ let add_local_constraint id info elv env =
       (* let env =
         add_type ~check:false
           id {info with type_newtype_level = Some (lv, elv)} env in *)
-      let info = {info with type_newtype_level = Some (lv, elv)} in
-      { env with
-        local_constraints = PathMap.add (Pident id) info env.local_constraints }
+      add_local_type id  {info with type_newtype_level = Some (lv, elv)}  env
   | _ -> assert false
 
+
 (* Insertion of bindings by name *)
 
 let enter store_fun name data env =

typing/env.mli

@@ -134,6 +134,7 @@ val add_modtype: Ident.t -> modtype_declaration -> t -> t
 val add_class: Ident.t -> class_declaration -> t -> t
 val add_cltype: Ident.t -> class_type_declaration -> t -> t
 val add_local_constraint: Ident.t -> type_declaration -> int -> t -> t
+val add_local_type: Ident.t -> type_declaration -> t -> t
 
 (* Insertion of all fields of a signature. *)