Debug

Author: voodoos

src/ocaml/typing/env.ml

@@ -2393,9 +2393,9 @@ let enter_value ?check name desc env =
   let env = store_value ?check id addr desc (Shape.leaf desc.val_uid) env in
   (id, env)
 
-let enter_type ~scope name info env =
+let enter_type ?(long_path = false) ~scope name info env =
   let id = Ident.create_scoped ~scope name in
-  let env = store_type ~check:true ~predef:false ~long_path:false
+  let env = store_type ~check:true ~predef:false ~long_path
     id info (Shape.leaf info.type_uid) env
   in
   (id, env)

src/ocaml/typing/env.mli

@@ -359,7 +359,9 @@ val remove_last_open: Path.t -> t -> t option
 val enter_value:
     ?check:(string -> Warnings.t) ->
     string -> value_description -> t -> Ident.t * t
-val enter_type: scope:int -> string -> type_declaration -> t -> Ident.t * t
+val enter_type:
+  ?long_path:bool -> scope:int ->
+  string -> type_declaration -> t -> Ident.t * t
 val enter_extension:
   scope:int -> rebind:bool -> string ->
   extension_constructor -> t -> Ident.t * t

src/ocaml/typing/typecore.ml

@@ -913,7 +913,8 @@ let solve_constructor_annotation
           new_local_type ~loc:name.loc Definition
             ~manifest_and_scope:(tv, Ident.lowest_scope) in
         let (id, new_env) =
-          Env.enter_type ~scope:expansion_scope name.txt decl !!penv in
+          (* These redundant types should not be added to the shortpath graph *)
+          Env.enter_type ~long_path:true ~scope:expansion_scope name.txt decl !!penv in
         Pattern_env.set_env penv new_env;
         ({name with txt = id}, (decl, tv)))
       name_list
@@ -951,7 +952,7 @@ let solve_constructor_annotation
             Tconstr(Path.Pident id, [], _) when List.mem_assoc id rem ->
               let decl, tv' = List.assoc id ids_decls in
               let env =
-                Env.add_type_long_path ~check:false id
+                Env.add_type ~check:false id
                   {decl with type_manifest = None} !!penv
               in
               Pattern_env.set_env penv env;
@@ -987,8 +988,7 @@ let solve_constructor_annotation
                             (Bind_non_locally_abstract, id, tv')));
         end;
         let env =
-          (* These redundant types should not be added to the shortpath graph *)
-          Env.add_type_long_path ~check:false id
+          Env.add_type ~check:false id
             {decl with type_manifest = Some (duplicate_type tv')} !!penv
         in
         Pattern_env.set_env penv env)