bin-annot: improved 'read_cmt' tool. Abstract Env.t .4.00-with-binannot

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/4.00-with-binannot@12470 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

18 files changed, 157 insertions, 166 deletions

diff --git a/boot/myocamlbuild.boot b/boot/myocamlbuild.boot
index 56df6b8200..cbb279dd10 100755
--- a/boot/myocamlbuild.boot
+++ b/boot/myocamlbuild.boot
diff --git a/boot/ocamlc b/boot/ocamlc
index 622dde0c87..9579beb564 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index e73f73b488..fcc8554989 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/driver/compile.ml b/driver/compile.ml
index b2cbb1cbd5..5b79877478 100644
--- a/driver/compile.ml
+++ b/driver/compile.ml
@@ -84,16 +84,15 @@ let interface ppf sourcefile outputprefix =
     let ast =
       Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
     if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
-    let sg = Typemod.transl_signature initial_env ast in
+    let tsg = Typemod.transl_signature initial_env ast in
     if !Clflags.print_types then
       fprintf std_formatter "%a@." Printtyp.signature
-                                   (Typemod.simplify_signature sg.sig_type);
+                                   (Typemod.simplify_signature tsg.sig_type);
     Warnings.check_fatal ();
     if not !Clflags.print_types then begin
-      Env.save_signature sg.sig_type modulename
-        (outputprefix ^ ".cmi");
-      Typemod.save_signature modulename sg outputprefix sourcefile
-       initial_env (sg.sig_type, Env.imported_units()) ;
+      let sg = Env.save_signature tsg.sig_type modulename (outputprefix ^ ".cmi") in
+      Typemod.save_signature modulename tsg outputprefix sourcefile
+       initial_env sg ;
     end;
     Pparse.remove_preprocessed inputfile
   with e ->
@@ -124,10 +123,10 @@ let implementation ppf sourcefile outputprefix =
       ++ Typemod.type_implementation sourcefile outputprefix modulename env);
       Warnings.check_fatal ();
       Pparse.remove_preprocessed inputfile;
-      Stypes.dump (outputprefix ^ ".annot");
+      Stypes.dump (Some (outputprefix ^ ".annot"));
     with x ->
       Pparse.remove_preprocessed_if_ast inputfile;
-      Stypes.dump (outputprefix ^ ".annot");
+      Stypes.dump (Some (outputprefix ^ ".annot"));
       raise x
   end else begin
     let objfile = outputprefix ^ ".cmo" in
@@ -146,12 +145,12 @@ let implementation ppf sourcefile outputprefix =
       Warnings.check_fatal ();
       close_out oc;
       Pparse.remove_preprocessed inputfile;
-      Stypes.dump (outputprefix ^ ".annot");
+      Stypes.dump (Some (outputprefix ^ ".annot"));
     with x ->
       close_out oc;
       remove_file objfile;
       Pparse.remove_preprocessed_if_ast inputfile;
-      Stypes.dump (outputprefix ^ ".annot");
+      Stypes.dump (Some (outputprefix ^ ".annot"));
       raise x
   end
 
diff --git a/driver/optcompile.ml b/driver/optcompile.ml
index ff5b0e5917..3154ad1481 100644
--- a/driver/optcompile.ml
+++ b/driver/optcompile.ml
@@ -81,21 +81,20 @@ let interface ppf sourcefile outputprefix =
     let ast =
       Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
     if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
-    let sg = Typemod.transl_signature initial_env ast in
+    let tsg = Typemod.transl_signature initial_env ast in
     if !Clflags.print_types then
       fprintf std_formatter "%a@." Printtyp.signature
-                                   (Typemod.simplify_signature sg.sig_type);
+                                   (Typemod.simplify_signature tsg.sig_type);
     Warnings.check_fatal ();
     if not !Clflags.print_types then begin
-      Env.save_signature sg.sig_type modulename (outputprefix ^ ".cmi");
-      Typemod.save_signature modulename sg outputprefix sourcefile initial_env
-        (sg.sig_type, Env.imported_units()) ;
+      let sg = Env.save_signature tsg.sig_type modulename (outputprefix ^ ".cmi") in
+      Typemod.save_signature modulename tsg outputprefix sourcefile initial_env sg ;
     end;
     Pparse.remove_preprocessed inputfile;
-    Stypes.dump (outputprefix ^ ".annot");
+    Stypes.dump (Some (outputprefix ^ ".annot"))
   with e ->
     Pparse.remove_preprocessed_if_ast inputfile;
-    Stypes.dump (outputprefix ^ ".annot");
+    Stypes.dump (Some (outputprefix ^ ".annot"));
     raise e
 
 (* Compile a .ml file *)
@@ -137,12 +136,12 @@ let implementation ppf sourcefile outputprefix =
     end;
     Warnings.check_fatal ();
     Pparse.remove_preprocessed inputfile;
-    Stypes.dump (outputprefix ^ ".annot");
+    Stypes.dump (Some (outputprefix ^ ".annot"));
   with x ->
     remove_file objfile;
     remove_file cmxfile;
     Pparse.remove_preprocessed_if_ast inputfile;
-    Stypes.dump (outputprefix ^ ".annot");
+    Stypes.dump (Some (outputprefix ^ ".annot"));
     raise x
 
 let c_file name =
diff --git a/tools/cmt2annot.ml b/tools/cmt2annot.ml
index e969b47495..917ab2ffb1 100644
--- a/tools/cmt2annot.ml
+++ b/tools/cmt2annot.ml
@@ -242,33 +242,49 @@ in  *)
 
 module Iterator = MakeIterator(ForIterator)
 
-let gen_annot filename cmt =
+let gen_annot target_filename filename cmt =
   match cmt.Cmt_format.cmt_annots with
       Cmt_format.Implementation typedtree ->
         Iterator.iter_structure typedtree;
-        Stypes.dump (filename ^ ".annot") (*  ((Filename.chop_suffix filename ".cmt") ^ ".annot") *)
+        let target_filename = match target_filename with
+            None -> Some (filename ^ ".annot")
+          | Some "-" -> None
+          | Some filename -> target_filename
+        in
+        Stypes.dump target_filename
+    | Cmt_format.Interface _ ->
+      Printf.fprintf stderr "Cannot generate annotations for interface file\n%!";
+      exit 2
     | _ ->
       Printf.fprintf stderr "File was generated with an error\n%!";
       exit 2
 
 
 
-let gen_ml filename cmt =
-  match cmt.Cmt_format.cmt_annots with
-    | Cmt_format.Implementation typedtree ->
-      let filename = filename ^ ".ml" in
-      let oc = open_out filename in
-      let ppf = Format.formatter_of_out_channel oc in
-      Pprintast.print_structure ppf (Untypeast.untype_structure typedtree);
-      Format.pp_print_flush ppf ();
-      close_out oc;
-    | Cmt_format.Interface typedtree ->
-      let filename = filename ^ ".mli" in
-      let oc = open_out filename in
-      let ppf = Format.formatter_of_out_channel oc in
-      Pprintast.print_signature ppf (Untypeast.untype_signature typedtree);
-      Format.pp_print_flush ppf ();
-      close_out oc;
-    | _ ->
-      Printf.fprintf stderr "File was generated with an error\n%!";
-      exit 2
+let gen_ml target_filename filename cmt =
+  let (printer, ext) =
+    match cmt.Cmt_format.cmt_annots with
+      | Cmt_format.Implementation typedtree ->
+        (fun ppf -> Pprintast.print_structure ppf (Untypeast.untype_structure typedtree)), ".ml"
+      | Cmt_format.Interface typedtree ->
+        (fun ppf -> Pprintast.print_signature ppf (Untypeast.untype_signature typedtree)), ".mli"
+      | _ ->
+        Printf.fprintf stderr "File was generated with an error\n%!";
+        exit 2
+  in
+  let target_filename = match target_filename with
+      None -> Some (filename ^ ext)
+    | Some "-" -> None
+    | Some filename -> target_filename
+  in
+  let oc = match target_filename with
+      None -> None
+    | Some filename -> Some (open_out filename) in
+  let ppf = match oc with
+      None -> Format.std_formatter
+    | Some oc -> Format.formatter_of_out_channel oc in
+  printer ppf;
+  Format.pp_print_flush ppf ();
+  match oc with
+      None -> flush stdout
+    | Some oc -> close_out oc
diff --git a/tools/read_cmt.ml b/tools/read_cmt.ml
index 354fbbf336..dc795778ce 100644
--- a/tools/read_cmt.ml
+++ b/tools/read_cmt.ml
@@ -12,31 +12,67 @@
 
 let gen_annot = ref false
 let gen_ml = ref false
+let print_info_arg = ref false
+let target_filename = ref None
 
 let arg_list = [
+  "-o", Arg.String (fun s ->
+    target_filename := Some s
+  ), " FILE (or -) : dump to file FILE (or stdout)";
   "-annot", Arg.Set gen_annot, " : generate the corresponding .annot file";
-  "-src", Arg.Set gen_ml, " : generate the original source file (without comments)";
+  "-src", Arg.Set gen_ml, " : generate an equivalent of the original source file (without comments) from a .cmt or a .cmti file";
+  "-info", Arg.Set print_info_arg, " : print information on the file";
   ]
 
 let arg_usage = "read_cmt [OPTIONS] FILE.cmt : read FILE.cmt and print related information"
 
+let print_info cmt =
+  let open Cmt_format in
+      Printf.printf "module name: %s\n" cmt.cmt_modname;
+      begin match cmt.cmt_annots with
+          Packed (_, list) -> Printf.printf "pack: %s\n" (String.concat " " list)
+        | Implementation _ -> Printf.printf "kind: implementation\n"
+        | Interface _ -> Printf.printf "kind: interface\n"
+        | Partial_implementation _ -> Printf.printf "kind: implementation with errors\n"
+        | Partial_interface _ -> Printf.printf "kind: interface with errors\n"
+      end;
+      Printf.printf "command: %s\n" (String.concat " " (Array.to_list cmt.cmt_args));
+      begin match cmt.cmt_sourcefile with
+          None -> ()
+        | Some name ->
+          Printf.printf "sourcefile: %s\n" name;
+      end;
+      Printf.printf "build directory: %s\n" cmt.cmt_builddir;
+      List.iter (fun dir -> Printf.printf "load path: %s\n%!" dir) cmt.cmt_loadpath;
+      begin
+      match cmt.cmt_source_digest with
+          None -> ()
+        | Some digest -> Printf.printf "source digest: %s\n" (Digest.to_hex digest);
+      end;
+      begin
+      match cmt.cmt_interface_digest with
+          None -> ()
+        | Some digest -> Printf.printf "interface digest: %s\n" (Digest.to_hex digest);
+      end;
+      List.iter (fun (name, digest) ->
+        Printf.printf "import: %s %s\n" name (Digest.to_hex digest);
+      ) (List.sort compare cmt.cmt_imports);
+      Printf.printf "%!";
+      ()
+
 let _ =
   Clflags.annotations := true;
 
   Arg.parse arg_list  (fun filename ->
     if
       Filename.check_suffix filename ".cmt" ||
-      Filename.check_suffix filename ".cmti"
+        Filename.check_suffix filename ".cmti"
     then begin
-(*      init_path(); *)
+      (*      init_path(); *)
       let cmt = Cmt_format.read_cmt filename in
-      if !gen_annot then Cmt2annot.gen_annot filename cmt;
-      if !gen_ml then Cmt2annot.gen_ml filename cmt;
-      if not !gen_annot && not !gen_ml then begin
-        Printf.fprintf stderr "Error: You must at least specify -annot or -src\n%!";
-        Arg.usage arg_list arg_usage;
-        exit 2
-      end;
+      if !gen_annot then Cmt2annot.gen_annot !target_filename filename cmt;
+      if !gen_ml then Cmt2annot.gen_ml !target_filename filename cmt;
+      if !print_info_arg || not (!gen_ml || !gen_annot) then print_info cmt;
     end else begin
       Printf.fprintf stderr "Error: the file must have an extension in .cmt or .cmti.\n%!";
       Arg.usage arg_list arg_usage
diff --git a/typing/cmi_format.ml b/typing/cmi_format.ml
index 9defbd18b1..d4957ab7d3 100644
--- a/typing/cmi_format.ml
+++ b/typing/cmi_format.ml
@@ -63,6 +63,7 @@ let read_cmi filename =
       raise (Error e)
 
 let output_cmi filename oc cmi =
+(* beware: the provided signature must have been substituted for saving *)
   output_string oc Config.cmi_magic_number;
   output_value oc (cmi.cmi_name, cmi.cmi_sign);
   flush oc;
diff --git a/typing/cmt_format.ml b/typing/cmt_format.ml
index ab2b71f3dd..96da8acc81 100644
--- a/typing/cmt_format.ml
+++ b/typing/cmt_format.ml
@@ -47,16 +47,13 @@ type cmt_infos = {
   cmt_annots : binary_annots;
   cmt_comments : (string * Location.t) list;
   cmt_args : string array;
-  cmt_sourcefile : string;
+  cmt_sourcefile : string option;
   cmt_builddir : string;
   cmt_loadpath : string list;
-  cmt_packed : string list;
-  cmt_source_digest : string option;
+  cmt_source_digest : Digest.t option;
   cmt_initial_env : Env.t;
-(* TODO
-  cmt_crcs : (string * Digest.t) list;
-  cmt_flags : Env.pers_flags list;
-*)
+  cmt_imports : (string * Digest.t) list;
+  cmt_interface_digest : Digest.t option;
 }
 
 type error =
@@ -121,13 +118,14 @@ let add_saved_type b = saved_types := b :: !saved_types
 let get_saved_types () = !saved_types
 let set_saved_types l = saved_types := l
 
-let save_cmt modname filename binary_annots sourcefile packed_modules initial_env sg =
+let save_cmt filename modname binary_annots sourcefile initial_env sg =
   if !Clflags.binary_annotations && not !Clflags.print_types then begin
+    let imports = Env.imported_units () in
     let oc = open_out filename in
-    begin
+    let this_crc =
       match sg with
-          None -> ()
-        | Some (sg, imports) ->
+          None -> None
+        | Some (sg) ->
           let cmi =
                 {
                   cmi_name = modname;
@@ -137,25 +135,21 @@ let save_cmt modname filename binary_annots sourcefile packed_modules initial_en
                   cmi_crcs = imports;
                 }
           in
-          let _crc = output_cmi filename oc cmi in
-          () (* don't need this crc ? *)
-    end;
+          Some (output_cmi filename oc cmi)
+    in
     let source_digest = match sourcefile with Some f -> Some (Digest.file f) | None -> None in
     let cmt = {
       cmt_modname = modname;
       cmt_annots = binary_annots;
       cmt_comments = Lexer.comments ();
       cmt_args = Sys.argv;
-      cmt_sourcefile = (match sourcefile with Some f -> f | None -> filename);
+      cmt_sourcefile = sourcefile;
       cmt_builddir =  Sys.getcwd ();
       cmt_loadpath = !Config.load_path;
-      cmt_packed = packed_modules;
       cmt_source_digest = source_digest;
       cmt_initial_env = initial_env;
-(* TODO
-      cmt_crcs = crcs;
-      cmt_flags = [];
-*)
+      cmt_imports = List.sort compare imports;
+      cmt_interface_digest = this_crc;
     } in
     output_cmt oc cmt;
     close_out oc;
diff --git a/typing/cmt_format.mli b/typing/cmt_format.mli
index f896d92497..8a303e31a4 100644
--- a/typing/cmt_format.mli
+++ b/typing/cmt_format.mli
@@ -50,16 +50,13 @@ type cmt_infos = {
   cmt_annots : binary_annots;
   cmt_comments : (string * Location.t) list;
   cmt_args : string array;
-  cmt_sourcefile : string;
+  cmt_sourcefile : string option;
   cmt_builddir : string;
   cmt_loadpath : string list;
-  cmt_packed : string list;
   cmt_source_digest : string option;
   cmt_initial_env : Env.t;
-(* TODO
-  cmt_crcs : (string * Digest.t) list;
-  cmt_flags : Env.pers_flags list;
-*)
+  cmt_imports : (string * Digest.t) list;
+  cmt_interface_digest : Digest.t option;
 }
 
 type error =
@@ -80,11 +77,15 @@ val read : string -> Cmi_format.cmi_infos option * cmt_infos option
 val read_cmt : string -> cmt_infos
 val read_cmi : string -> Cmi_format.cmi_infos
 
-(** [save_cmt modname filename binary_annots sourcefile packed_modules initial_env sg]
+(** [save_cmt modname filename binary_annots sourcefile initial_env sg]
     writes a cmt(i) file.  *)
 val save_cmt :
-  string -> string -> binary_annots -> string option -> string list -> Env.t ->
-  (Types.signature_item list * (string * Digest.t) list) option ->
+  string ->  (* filename.cmt to generate *)
+  string ->  (* module name *)
+  binary_annots ->
+  string option ->  (* source file *)
+  Env.t -> (* initial env *)
+  Types.signature option -> (* if a .cmi was generated, the signature saved there *)
   unit
 
 (* Miscellaneous functions *)
diff --git a/typing/env.ml b/typing/env.ml
index ac221750bc..ad1d09c373 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -1194,7 +1194,8 @@ let save_signature_with_imports sg modname filename imports =
         ps_filename = filename;
         ps_flags = cmi.cmi_flags } in
     Hashtbl.add persistent_structures modname (Some ps);
-    Consistbl.set crc_units modname crc filename
+    Consistbl.set crc_units modname crc filename;
+    sg
   with exn ->
     close_out oc;
     remove_file filename;
diff --git a/typing/env.mli b/typing/env.mli
index 3dbf7092da..44d0491ed3 100644
--- a/typing/env.mli
+++ b/typing/env.mli
@@ -16,13 +16,6 @@
 
 open Types
 
-module EnvLazy : sig
-  type ('a,'b) t
-
-  val force : ('a -> 'b) -> ('a,'b) t -> 'b
-  val create : 'a -> ('a,'b) t
-end
-
 type summary =
     Env_empty
   | Env_value of summary * Ident.t * value_description
@@ -34,61 +27,7 @@ type summary =
   | Env_cltype of summary * Ident.t * class_type_declaration
   | Env_open of summary * Path.t
 
-module EnvTbl : sig
-  type 'a t
-
-  val find_same_not_using : Ident.t -> 'a t -> 'a
-  val keys : 'a t -> Ident.t list
-end
-
-type t = {
-  values: (Path.t * value_description) EnvTbl.t;
-  annotations: (Path.t * Annot.ident) EnvTbl.t;
-  constrs: (Path.t * constructor_description) EnvTbl.t;
-  labels: (Path.t * label_description) EnvTbl.t;
-  constrs_by_path: (Path.t * (constructor_description list)) EnvTbl.t;
-  types: (Path.t * type_declaration) EnvTbl.t;
-  modules: (Path.t * module_type) EnvTbl.t;
-  modtypes: (Path.t * modtype_declaration) EnvTbl.t;
-  components: (Path.t * module_components) EnvTbl.t;
-  classes: (Path.t * class_declaration) EnvTbl.t;
-  cltypes: (Path.t * class_type_declaration) EnvTbl.t;
-  summary: summary;
-  local_constraints: bool;
-  gadt_instances: (int * Btype.TypeSet.t ref) list;
-  in_signature: bool;
-}
-
-and module_components = (t * Subst.t * Path.t * Types.module_type,module_components_repr) EnvLazy.t
-
-and module_components_repr =
-    Structure_comps of structure_components
-  | Functor_comps of functor_components
-
-and structure_components = {
-  mutable comp_values: (string, (value_description * int)) Tbl.t;
-  mutable comp_annotations: (string, (Annot.ident * int)) Tbl.t;
-  mutable comp_constrs: (string, (constructor_description * int)) Tbl.t;
-  mutable comp_labels: (string, (label_description * int)) Tbl.t;
-  mutable comp_constrs_by_path:
-      (string, (constructor_description list * int)) Tbl.t;
-  mutable comp_types: (string, (type_declaration * int)) Tbl.t;
-  mutable comp_modules: (string, ( (Subst.t * Types.module_type,module_type) EnvLazy.t * int)) Tbl.t;
-  mutable comp_modtypes: (string, (modtype_declaration * int)) Tbl.t;
-  mutable comp_components: (string, (module_components * int)) Tbl.t;
-  mutable comp_classes: (string, (class_declaration * int)) Tbl.t;
-  mutable comp_cltypes: (string, (class_type_declaration * int)) Tbl.t
-}
-
-and functor_components = {
-  fcomp_param: Ident.t;                 (* Formal parameter *)
-  fcomp_arg: module_type;               (* Argument signature *)
-  fcomp_res: module_type;               (* Result signature *)
-  fcomp_env: t;     (* Environment in which the result signature makes sense *)
-  fcomp_subst: Subst.t;  (* Prefixing substitution for the result signature *)
-  fcomp_cache: (Path.t, module_components) Hashtbl.t  (* For memoization *)
-}
-
+type t
 
 val empty: t
 val initial: t
@@ -175,10 +114,10 @@ val set_unit_name: string -> unit
 
 val read_signature: string -> string -> signature
         (* Arguments: module name, file name. Results: signature. *)
-val save_signature: signature -> string -> string -> unit
+val save_signature: signature -> string -> string -> signature
         (* Arguments: signature, module name, file name. *)
 val save_signature_with_imports:
-            signature -> string -> string -> (string * Digest.t) list -> unit
+            signature -> string -> string -> (string * Digest.t) list -> signature
         (* Arguments: signature, module name, file name,
            imported units with their CRCs. *)
 
diff --git a/typing/stypes.ml b/typing/stypes.ml
index 1d2c0efde3..158062f21e 100644
--- a/typing/stypes.ml
+++ b/typing/stypes.ml
@@ -157,7 +157,10 @@ let get_info () =
 let dump filename =
   if !Clflags.annotations then begin
     let info = get_info () in
-    let pp = formatter_of_out_channel (open_out filename) in
+    let pp =
+      match filename with
+          None -> std_formatter
+        | Some filename -> formatter_of_out_channel (open_out filename) in
     sort_filter_phrases ();
     ignore (List.fold_left (print_info pp) Location.none info);
     phrases := [];
diff --git a/typing/stypes.mli b/typing/stypes.mli
index 02cccd800d..c51c45e252 100644
--- a/typing/stypes.mli
+++ b/typing/stypes.mli
@@ -29,7 +29,7 @@ type annotation =
 
 val record : annotation -> unit;;
 val record_phrase : Location.t -> unit;;
-val dump : string -> unit;;
+val dump : string option -> unit;;
 
 val get_location : annotation -> Location.t;;
 val get_info : unit -> annotation list;;
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 9fc0d24484..f2eca2602c 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -1237,7 +1237,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
       (* It is important to run these checks after the inclusion test above,
          so that value declarations which are not used internally but exported
          are not reported as being unused. *)
-      Cmt_format.save_cmt modulename (outputprefix ^ ".cmt") (Cmt_format.Implementation str) (Some sourcefile) [] initial_env None;
+      Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename (Cmt_format.Implementation str) (Some sourcefile) initial_env None;
       (str, coercion)
     end else begin
       check_nongen_schemes finalenv str.str_items;
@@ -1250,23 +1250,24 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
          the value being exported. We can still capture unused
          declarations like "let x = true;; let x = 1;;", because in this
          case, the inferred signature contains only the last declaration. *)
-        Cmt_format.save_cmt modulename (outputprefix ^ ".cmt") (Cmt_format.Implementation str)
-          (Some sourcefile) [] initial_env (Some (str.str_type, Env.imported_units()));
-      if not !Clflags.dont_write_files then
-        Env.save_signature simple_sg modulename (outputprefix ^ ".cmi");
+      if not !Clflags.dont_write_files then begin
+        let sg = Env.save_signature simple_sg modulename (outputprefix ^ ".cmi") in
+        Cmt_format.save_cmt  (outputprefix ^ ".cmt") modulename (Cmt_format.Implementation str)
+          (Some sourcefile) initial_env (Some sg);
+      end;
       (str, coercion)
     end
     end
   with e ->
-    Cmt_format.save_cmt modulename (outputprefix ^ ".cmt")
+    Cmt_format.save_cmt  (outputprefix ^ ".cmt") modulename
       (Cmt_format.Partial_implementation (Array.of_list (Cmt_format.get_saved_types ())))
-      (Some sourcefile) [] initial_env None;
+      (Some sourcefile) initial_env None;
     raise e
 
 
 let save_signature modname tsg outputprefix source_file initial_env cmi =
-  Cmt_format.save_cmt modname (outputprefix ^ ".cmti")
-    (Cmt_format.Interface tsg) (Some source_file) [] initial_env (Some cmi)
+  Cmt_format.save_cmt  (outputprefix ^ ".cmti") modname
+    (Cmt_format.Interface tsg) (Some source_file) initial_env (Some cmi)
 
 (* "Packaging" of several compilation units into one unit
    having them as sub-modules.  *)
@@ -1304,8 +1305,8 @@ let package_units objfiles cmifile modulename =
       raise(Error(Location.in_file mlifile, Interface_not_compiled mlifile))
     end;
     let dclsig = Env.read_signature modulename cmifile in
-    Cmt_format.save_cmt modulename (prefix ^ ".cmt")
-      (Cmt_format.Packed (sg, objfiles)) None objfiles Env.initial None ;
+    Cmt_format.save_cmt  (prefix ^ ".cmt") modulename
+      (Cmt_format.Packed (sg, objfiles)) None Env.initial None ;
     Includemod.compunit "(obtained by packing)" sg mlifile dclsig
   end else begin
     (* Determine imports *)
@@ -1315,10 +1316,11 @@ let package_units objfiles cmifile modulename =
         (fun (name, crc) -> not (List.mem name unit_names))
         (Env.imported_units()) in
     (* Write packaged signature *)
-    if not !Clflags.dont_write_files then
-      Env.save_signature_with_imports sg modulename (prefix ^ ".cmi") imports;
-    Cmt_format.save_cmt modulename (prefix ^ ".cmt")
-      (Cmt_format.Packed (sg, objfiles)) None objfiles Env.initial (Some (sg, imports));
+    if not !Clflags.dont_write_files then begin
+      let sg = 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)
+    end;
     Tcoerce_none
   end
 
diff --git a/typing/typemod.mli b/typing/typemod.mli
index 4ef73a859d..1d3b92ee39 100644
--- a/typing/typemod.mli
+++ b/typing/typemod.mli
@@ -33,7 +33,7 @@ val check_nongen_schemes:
 val simplify_signature: signature -> signature
 
 val save_signature : string -> Typedtree.signature -> string -> string ->
-  Env.t -> Types.signature_item list * (string * Digest.t) list -> unit
+  Env.t -> Types.signature_item list -> unit
 
 val package_units:
         string list -> string -> string -> Typedtree.module_coercion
diff --git a/utils/config.mlbuild b/utils/config.mlbuild
index a0aef83c9c..06fc7da2b5 100644
--- a/utils/config.mlbuild
+++ b/utils/config.mlbuild
@@ -67,8 +67,8 @@ and cmo_magic_number = "Caml1999O007"
 and cma_magic_number = "Caml1999A008"
 and cmx_magic_number = "Caml1999Y011"
 and cmxa_magic_number = "Caml1999Z010"
-and ast_impl_magic_number = "Caml1999M014"
-and ast_intf_magic_number = "Caml1999N013"
+and ast_impl_magic_number = "Caml1999M015"
+and ast_intf_magic_number = "Caml1999N014"
 and cmxs_magic_number = "Caml2007D001"
 and cmt_magic_number = "Caml2012T001"
 
diff --git a/utils/config.mlp b/utils/config.mlp
index 985c5999aa..f59243e95f 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -56,8 +56,8 @@ and cmo_magic_number = "Caml1999O007"
 and cma_magic_number = "Caml1999A008"
 and cmx_magic_number = "Caml1999Y011"
 and cmxa_magic_number = "Caml1999Z010"
-and ast_impl_magic_number = "Caml1999M014"
-and ast_intf_magic_number = "Caml1999N013"
+and ast_impl_magic_number = "Caml1999M015"
+and ast_intf_magic_number = "Caml1999N014"
 and cmxs_magic_number = "Caml2007D001"
 and cmt_magic_number = "Caml2012T001"