split Env.initial, and propagate real initial_env

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/safe-string@14682 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

18 files changed, 49 insertions, 38 deletions

diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml
index a8fcfe7896..63ed21c89d 100644
--- a/asmcomp/asmpackager.ml
+++ b/asmcomp/asmpackager.ml
@@ -161,7 +161,7 @@ let package_object_files ppf files targetcmx
 
 (* The entry point *)
 
-let package_files ppf files targetcmx =
+let package_files ppf initial_env files targetcmx =
   let files =
     List.map
       (fun f ->
@@ -177,7 +177,8 @@ let package_files ppf files targetcmx =
   (* Set the name of the current compunit *)
   Compilenv.reset ?packname:!Clflags.for_package targetname;
   try
-    let coercion = Typemod.package_units files targetcmi targetname in
+    let coercion =
+      Typemod.package_units initial_env files targetcmi targetname in
     package_object_files ppf files targetcmx targetobj targetname coercion
   with x ->
     remove_file targetcmx; remove_file targetobj;
diff --git a/asmcomp/asmpackager.mli b/asmcomp/asmpackager.mli
index 65272b7ed7..4d47f5c283 100644
--- a/asmcomp/asmpackager.mli
+++ b/asmcomp/asmpackager.mli
@@ -13,7 +13,7 @@
 (* "Package" a set of .cmx/.o files into one .cmx/.o file having the
    original compilation units as sub-modules. *)
 
-val package_files: Format.formatter -> string list -> string -> unit
+val package_files: Format.formatter -> Env.t -> string list -> string -> unit
 
 type error =
     Illegal_renaming of string * string * string
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
index 847275217c..0ec05244bb 100644
--- a/bytecomp/bytepackager.ml
+++ b/bytecomp/bytepackager.ml
@@ -250,7 +250,7 @@ let package_object_files ppf files targetfile targetname coercion =
 
 (* The entry point *)
 
-let package_files ppf files targetfile =
+let package_files ppf initial_env files targetfile =
     let files =
     List.map
         (fun f ->
@@ -261,11 +261,12 @@ let package_files ppf files targetfile =
     let targetcmi = prefix ^ ".cmi" in
     let targetname = String.capitalize(Filename.basename prefix) in
     try
-      let coercion = Typemod.package_units files targetcmi targetname in
-    let ret = package_object_files ppf files targetfile targetname coercion in
-    ret
-  with x ->
-    remove_file targetfile; raise x
+      let coercion =
+        Typemod.package_units initial_env files targetcmi targetname in
+      let ret = package_object_files ppf files targetfile targetname coercion in
+      ret
+    with x ->
+      remove_file targetfile; raise x
 
 (* Error report *)
 
diff --git a/bytecomp/bytepackager.mli b/bytecomp/bytepackager.mli
index 04de0726a2..64e100f585 100644
--- a/bytecomp/bytepackager.mli
+++ b/bytecomp/bytepackager.mli
@@ -13,7 +13,7 @@
 (* "Package" a set of .cmo files into one .cmo file having the
    original compilation units as sub-modules. *)
 
-val package_files: Format.formatter -> string list -> string -> unit
+val package_files: Format.formatter -> Env.t -> string list -> string -> unit
 
 type error =
     Forward_reference of string * Ident.t
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml
index c57518afb3..02233d0eca 100644
--- a/bytecomp/matching.ml
+++ b/bytecomp/matching.ml
@@ -1484,7 +1484,7 @@ let get_mod_field modname field =
   lazy (
     try
       let mod_ident = Ident.create_persistent modname in
-      let env = Env.open_pers_signature modname Env.initial in
+      let env = Env.open_pers_signature modname Env.initial_safe_string in
       let p = try
         match Env.lookup_value (Longident.Lident field) env with
         | (Path.Pdot(_,_,i), _) -> i
diff --git a/driver/compmisc.ml b/driver/compmisc.ml
index 3d47df23f5..b97ba6c74e 100644
--- a/driver/compmisc.ml
+++ b/driver/compmisc.ml
@@ -48,7 +48,8 @@ let open_implicit_module m env =
 let initial_env () =
   Ident.reinit();
   let initial =
-    if !Clflags.unsafe_string then Env.initial_unsafe_string else Env.initial
+    if !Clflags.unsafe_string then Env.initial_unsafe_string
+    else Env.initial_safe_string
   in
   let env =
     if !Clflags.nopervasives then initial else
diff --git a/driver/main.ml b/driver/main.ml
index 423793efb5..44df1208be 100644
--- a/driver/main.ml
+++ b/driver/main.ml
@@ -162,7 +162,8 @@ let main () =
       Compmisc.init_path false;
       let extracted_output = extract_output !output_name in
       let revd = get_objfiles () in
-      Bytepackager.package_files ppf revd (extracted_output);
+      Bytepackager.package_files ppf (Compmisc.initial_env ())
+        revd (extracted_output);
       Warnings.check_fatal ();
     end
     else if not !compile_only && !objfiles <> [] then begin
diff --git a/driver/optmain.ml b/driver/optmain.ml
index 9e2a2fc259..fceac7a5d7 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -174,7 +174,8 @@ let main () =
     else if !make_package then begin
       Compmisc.init_path true;
       let target = extract_output !output_name in
-      Asmpackager.package_files ppf (get_objfiles ()) target;
+      Asmpackager.package_files ppf (Compmisc.initial_env ())
+        (get_objfiles ()) target;
       Warnings.check_fatal ();
     end
     else if !shared then begin
diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml
index 98f73617df..294ca95c5b 100644
--- a/ocamldoc/odoc_analyse.ml
+++ b/ocamldoc/odoc_analyse.ml
@@ -33,10 +33,13 @@ let init_path () =
 
 (** Return the initial environment in which compilation proceeds. *)
 let initial_env () =
+  let initial =
+    if !Clflags.unsafe_string then Env.initial_unsafe_string
+    else Env.initial_safe_string
+  in
   try
-    if !Clflags.nopervasives
-    then Env.initial
-    else Env.open_pers_signature "Pervasives" Env.initial
+    if !Clflags.nopervasives then initial else
+    Env.open_pers_signature "Pervasives" initial
   with Not_found ->
     fatal_error "cannot open pervasives.cmi"
 
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 06905326ee..513649b3f7 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -242,7 +242,7 @@ let in_current_module = function
 
 let in_pervasives p =
   in_current_module p &&
-  try ignore (Env.find_type p Env.initial); true
+  try ignore (Env.find_type p Env.initial_safe_string); true
   with Not_found -> false
 
 let is_datatype decl=
diff --git a/typing/env.ml b/typing/env.ml
index 1fffb5beb8..948ef60c47 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -1700,7 +1700,7 @@ and fold_cltypes f =
 
 
 (* Make the initial environment *)
-let (initial, initial_unsafe_string) =
+let (initial_safe_string, initial_unsafe_string) =
   Predef.build_initial_env
     (add_type ~check:false)
     (add_exception ~check:false)
diff --git a/typing/env.mli b/typing/env.mli
index badd0bc5f3..f5ef302b3c 100644
--- a/typing/env.mli
+++ b/typing/env.mli
@@ -29,7 +29,7 @@ type summary =
 type t
 
 val empty: t
-val initial: t
+val initial_safe_string: t
 val initial_unsafe_string: t
 val diff: t -> t -> Ident.t list
 
diff --git a/typing/includemod.ml b/typing/includemod.ml
index af0feb2ecf..54aca4a7c4 100644
--- a/typing/includemod.ml
+++ b/typing/includemod.ml
@@ -401,9 +401,9 @@ let _ = Env.check_modtype_inclusion := check_modtype_inclusion
 (* Check that an implementation of a compilation unit meets its
    interface. *)
 
-let compunit impl_name impl_sig intf_name intf_sig =
+let compunit env impl_name impl_sig intf_name intf_sig =
   try
-    signatures Env.initial [] Subst.identity impl_sig intf_sig
+    signatures env [] Subst.identity impl_sig intf_sig
   with Error reasons ->
     raise(Error(([], Env.empty,Interface_mismatch(impl_name, intf_name))
                 :: reasons))
diff --git a/typing/includemod.mli b/typing/includemod.mli
index 2e00bb0246..b3801ccd3d 100644
--- a/typing/includemod.mli
+++ b/typing/includemod.mli
@@ -18,7 +18,8 @@ open Format
 
 val modtypes: Env.t -> module_type -> module_type -> module_coercion
 val signatures: Env.t -> signature -> signature -> module_coercion
-val compunit: string -> signature -> string -> signature -> module_coercion
+val compunit:
+      Env.t -> string -> signature -> string -> signature -> module_coercion
 val type_declarations:
       Env.t -> Ident.t -> type_declaration -> type_declaration -> unit
 
diff --git a/typing/typecore.ml b/typing/typecore.ml
index e8cd8cddd0..1f9a689b23 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -257,14 +257,14 @@ let mkexp exp_desc exp_type exp_loc exp_env =
   { exp_desc; exp_type; exp_loc; exp_env; exp_extra = []; exp_attributes = [] }
 
 let option_none ty loc =
-  let lid = Longident.Lident "None" in
-  let cnone = Env.lookup_constructor lid Env.initial in
-  mkexp (Texp_construct(mknoloc lid, cnone, []))
-    ty loc Env.initial
+  let lid = Longident.Lident "None"
+  and env = Env.initial_safe_string in
+  let cnone = Env.lookup_constructor lid env in
+  mkexp (Texp_construct(mknoloc lid, cnone, [])) ty loc env
 
 let option_some texp =
   let lid = Longident.Lident "Some" in
-  let csome = Env.lookup_constructor lid Env.initial in
+  let csome = Env.lookup_constructor lid Env.initial_safe_string in
   mkexp ( Texp_construct(mknoloc lid , csome, [texp]) )
     (type_option texp.exp_type) texp.exp_loc texp.exp_env
 
diff --git a/typing/typemod.ml b/typing/typemod.ml
index feee30b28d..51171ff649 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -1544,7 +1544,8 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
           raise(Error(Location.in_file sourcefile, Env.empty,
                       Interface_not_compiled sourceintf)) in
       let dclsig = Env.read_signature modulename intf_file in
-      let coercion = Includemod.compunit sourcefile sg intf_file dclsig in
+      let coercion =
+        Includemod.compunit initial_env sourcefile sg intf_file dclsig in
       Typecore.force_delayed_checks ();
       (* It is important to run these checks after the inclusion test above,
          so that value declarations which are not used internally but exported
@@ -1556,7 +1557,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
       check_nongen_schemes finalenv str.str_items;
       normalize_signature finalenv simple_sg;
       let coercion =
-        Includemod.compunit sourcefile sg
+        Includemod.compunit initial_env sourcefile sg
                             "(inferred signature)" simple_sg in
       Typecore.force_delayed_checks ();
       (* See comment above. Here the target signature contains all
@@ -1601,7 +1602,7 @@ let rec package_signatures subst = function
                  Trec_not) ::
       package_signatures (Subst.add_module oldid (Pident newid) subst) rem
 
-let package_units objfiles cmifile modulename =
+let package_units initial_env objfiles cmifile modulename =
   (* Read the signatures of the units *)
   let units =
     List.map
@@ -1610,7 +1611,7 @@ let package_units objfiles cmifile modulename =
          let modname = String.capitalize(Filename.basename pref) in
          let sg = Env.read_signature modname (pref ^ ".cmi") in
          if Filename.check_suffix f ".cmi" &&
-            not(Mtype.no_code_needed_sig Env.initial sg)
+            not(Mtype.no_code_needed_sig Env.initial_safe_string sg)
          then raise(Error(Location.none, Env.empty,
                           Implementation_is_required f));
          (modname, Env.read_signature modname (pref ^ ".cmi")))
@@ -1628,8 +1629,8 @@ let package_units objfiles cmifile modulename =
     end;
     let dclsig = Env.read_signature modulename cmifile in
     Cmt_format.save_cmt  (prefix ^ ".cmt") modulename
-      (Cmt_format.Packed (sg, objfiles)) None Env.initial None ;
-    Includemod.compunit "(obtained by packing)" sg mlifile dclsig
+      (Cmt_format.Packed (sg, objfiles)) None initial_env  None ;
+    Includemod.compunit initial_env "(obtained by packing)" sg mlifile dclsig
   end else begin
     (* Determine imports *)
     let unit_names = List.map fst units in
@@ -1643,7 +1644,7 @@ let package_units objfiles cmifile modulename =
         Env.save_signature_with_imports sg modulename
           (prefix ^ ".cmi") imports in
       Cmt_format.save_cmt (prefix ^ ".cmt")  modulename
-        (Cmt_format.Packed (sg, objfiles)) None Env.initial (Some sg)
+        (Cmt_format.Packed (sg, objfiles)) None initial_env (Some sg)
     end;
     Tcoerce_none
   end
diff --git a/typing/typemod.mli b/typing/typemod.mli
index 051a283609..a6d5713eee 100644
--- a/typing/typemod.mli
+++ b/typing/typemod.mli
@@ -33,11 +33,12 @@ val check_nongen_schemes:
 
 val simplify_signature: signature -> signature
 
-val save_signature : string -> Typedtree.signature -> string -> string ->
+val save_signature:
+  string -> Typedtree.signature -> string -> string ->
   Env.t -> Types.signature_item list -> unit
 
 val package_units:
-        string list -> string -> string -> Typedtree.module_coercion
+  Env.t -> string list -> string -> string -> Typedtree.module_coercion
 
 type error =
     Cannot_apply of module_type
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index b219c814a8..bdfdf0a789 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -126,7 +126,7 @@ let find_component lookup make_error env loc lid =
   try
     match lid with
     | Longident.Ldot (Longident.Lident "*predef*", s) ->
-        lookup (Longident.Lident s) Env.initial
+        lookup (Longident.Lident s) Env.initial_safe_string
     | _ -> lookup lid env
   with Not_found ->
     narrow_unbound_lid_error env loc lid make_error