Interdire les references Foo.x lorsqu'on compile foo.ml ou foo.mli (PR#3100, 3304, 3457)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6998 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

driver/compile.ml

@@ -33,7 +33,7 @@ let init_path () =
   let exp_dirs =
     List.map (expand_directory Config.standard_library) dirs in
   load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ());
-  Env.reset_cache()
+  Env.reset_cache ()
 
 (* Return the initial environment in which compilation proceeds. *)
 
@@ -51,9 +51,10 @@ let initial_env () =
 (* Compile a .mli file *)
 
 let interface ppf sourcefile outputprefix =
-  init_path();
+  init_path ();
   let modulename =
     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
+  Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
   try
     let ast =
@@ -80,9 +81,10 @@ let print_if ppf flag printer arg =
 let (++) x f = f x
 
 let implementation ppf sourcefile outputprefix =
-  init_path();
+  init_path ();
   let modulename =
     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
+  Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
   let env = initial_env() in
   if !Clflags.print_types then begin

driver/optcompile.ml

@@ -32,7 +32,7 @@ let init_path () =
   let exp_dirs =
     List.map (expand_directory Config.standard_library) dirs in
   load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ());
-  Env.reset_cache()
+  Env.reset_cache ()
 
 (* Return the initial environment in which compilation proceeds. *)
 
@@ -48,9 +48,10 @@ let initial_env () =
 (* Compile a .mli file *)
 
 let interface ppf sourcefile outputprefix =
-  init_path();
+  init_path ();
   let modulename =
     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
+  Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
   try
     let ast =
@@ -78,9 +79,10 @@ let (++) x f = f x
 let (+++) (x, y) f = (x, f y)
 
 let implementation ppf sourcefile outputprefix =
-  init_path();
+  init_path ();
   let modulename =
     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
+  Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
   let env = initial_env() in
   Compilenv.reset modulename;

ocamldoc/odoc_analyse.ml

@@ -29,7 +29,7 @@ open Typedtree
 let init_path () =
   load_path :=
     "" :: List.rev (Config.standard_library :: !Clflags.include_dirs);
-  Env.reset_cache()
+  Env.reset_cache ()
 
 (** Return the initial environment in which compilation proceeds. *)
 let initial_env () =
@@ -105,10 +105,10 @@ let (++) x f = f x
 (** Analysis of an implementation file. Returns (Some typedtree) if
    no error occured, else None and an error message is printed.*)
 let process_implementation_file ppf sourcefile =
-
-  init_path();
+  init_path ();
   let prefixname = Filename.chop_extension sourcefile in
   let modulename = String.capitalize(Filename.basename prefixname) in
+  Env.set_unit_name modulename;
   let inputfile = preprocess sourcefile in
   let env = initial_env () in
   try
@@ -132,7 +132,10 @@ let process_implementation_file ppf sourcefile =
 (** Analysis of an interface file. Returns (Some signature) if
    no error occured, else None and an error message is printed.*)
 let process_interface_file ppf sourcefile =
-  init_path();
+  init_path ();
+  let prefixname = Filename.chop_extension sourcefile in
+  let modulename = String.capitalize(Filename.basename prefixname) in
+  Env.set_unit_name modulename;
   let inputfile = preprocess sourcefile in
   let ast = parse_file inputfile Parse.interface ast_intf_magic_number in
   let sg = Typemod.transl_signature (initial_env()) ast in

typing/env.ml

@@ -115,6 +115,11 @@ let check_modtype_inclusion =
   ref ((fun env mty1 mty2 -> assert false) :
           t -> module_type -> module_type -> unit)
 
+(* The name of the compilation unit currently compiled.
+   "" if outside a compilation unit. *)
+
+let current_unit = ref ""
+
 (* Persistent structure descriptions *)
 
 type pers_struct =
@@ -177,10 +182,14 @@ let find_pers_struct name =
   with Not_found ->
     read_pers_struct name (find_in_path_uncap !load_path (name ^ ".cmi"))
 
-let reset_cache() =
+let reset_cache () =
+  current_unit := "";
   Hashtbl.clear persistent_structures;
   Consistbl.clear crc_units
 
+let set_unit_name name =
+  current_unit := name
+
 (* Lookup by identifier *)
 
 let rec find_module_descr path env =
@@ -277,6 +286,7 @@ let rec lookup_module_descr lid env =
       begin try
         Ident.find_name s env.components
       with Not_found ->
+        if s = !current_unit then raise Not_found;
         let ps = find_pers_struct s in
         (Pident(Ident.create_persistent s), ps.ps_comps)
       end
@@ -306,6 +316,7 @@ and lookup_module lid env =
       begin try
         Ident.find_name s env.modules
       with Not_found ->
+        if s = !current_unit then raise Not_found;
         let ps = find_pers_struct s in
         (Pident(Ident.create_persistent s), Tmty_signature ps.ps_sig)
       end

typing/env.mli

@@ -76,11 +76,12 @@ val enter_modtype: string -> modtype_declaration -> t -> Ident.t * t
 val enter_class: string -> class_declaration -> t -> Ident.t * t
 val enter_cltype: string -> cltype_declaration -> t -> Ident.t * t
 
-(* Reset the cache of in-core module interfaces.
-   To be called in particular when load_path changes. *)
-
+(* Initialize the cache of in-core module interfaces. *)
 val reset_cache: unit -> unit
 
+(* Remember the name of the current compilation unit. *)
+val set_unit_name: string -> unit
+
 (* Read, save a signature to/from a file *)
 
 val read_signature: string -> string -> signature