Deprecate -annot (#2141)

* Move driver code from Cmt2annot to Read_cmt
* Move cmt2annot.ml into typing/
* make depend
* Use standard error handling
* Move specific logic to read_cmt
* Do not pass full cmt record as argument
* Better locations
* Emit .annot files produced from cmt data
* Remove direct calls to Stypes
* Deprecate -annot
* Changes
* make depend
* Adapt doc
* make -C tools depend

18 files changed, 226 insertions, 266 deletions

diff --git a/.depend b/.depend
index e568b326b2..7f3c91fb2e 100644
--- a/.depend
+++ b/.depend
@@ -441,6 +441,34 @@ typing/btype.cmi : \
     typing/types.cmi \
     typing/path.cmi \
     parsing/asttypes.cmi
+typing/cmt2annot.cmo : \
+    typing/types.cmi \
+    typing/typedtree.cmi \
+    typing/tast_iterator.cmi \
+    typing/stypes.cmi \
+    typing/path.cmi \
+    typing/oprint.cmi \
+    parsing/location.cmi \
+    typing/ident.cmi \
+    typing/envaux.cmi \
+    typing/env.cmi \
+    file_formats/cmt_format.cmi \
+    parsing/asttypes.cmi \
+    typing/annot.cmi
+typing/cmt2annot.cmx : \
+    typing/types.cmx \
+    typing/typedtree.cmx \
+    typing/tast_iterator.cmx \
+    typing/stypes.cmx \
+    typing/path.cmx \
+    typing/oprint.cmx \
+    parsing/location.cmx \
+    typing/ident.cmx \
+    typing/envaux.cmx \
+    typing/env.cmx \
+    file_formats/cmt_format.cmx \
+    parsing/asttypes.cmi \
+    typing/annot.cmi
 typing/ctype.cmo : \
     typing/types.cmi \
     typing/type_immediacy.cmi \
@@ -553,6 +581,7 @@ typing/envaux.cmo : \
     typing/subst.cmi \
     typing/printtyp.cmi \
     typing/path.cmi \
+    parsing/location.cmi \
     typing/ident.cmi \
     typing/env.cmi \
     parsing/asttypes.cmi \
@@ -561,6 +590,7 @@ typing/envaux.cmx : \
     typing/subst.cmx \
     typing/printtyp.cmx \
     typing/path.cmx \
+    parsing/location.cmx \
     typing/ident.cmx \
     typing/env.cmx \
     parsing/asttypes.cmi \
@@ -819,6 +849,7 @@ typing/persistent_env.cmi : \
     file_formats/cmi_format.cmi
 typing/predef.cmo : \
     typing/types.cmi \
+    typing/type_immediacy.cmi \
     typing/path.cmi \
     parsing/parsetree.cmi \
     parsing/location.cmi \
@@ -829,6 +860,7 @@ typing/predef.cmo : \
     typing/predef.cmi
 typing/predef.cmx : \
     typing/types.cmx \
+    typing/type_immediacy.cmx \
     typing/path.cmx \
     parsing/parsetree.cmi \
     parsing/location.cmx \
@@ -1064,7 +1096,6 @@ typing/typeclass.cmo : \
     typing/typedecl.cmi \
     typing/typecore.cmi \
     typing/subst.cmi \
-    typing/stypes.cmi \
     typing/printtyp.cmi \
     typing/predef.cmi \
     typing/path.cmi \
@@ -1093,7 +1124,6 @@ typing/typeclass.cmx : \
     typing/typedecl.cmx \
     typing/typecore.cmx \
     typing/subst.cmx \
-    typing/stypes.cmx \
     typing/printtyp.cmx \
     typing/predef.cmx \
     typing/path.cmx \
@@ -1130,7 +1160,6 @@ typing/typecore.cmo : \
     typing/typedtree.cmi \
     typing/typedecl.cmi \
     typing/subst.cmi \
-    typing/stypes.cmi \
     typing/rec_check.cmi \
     typing/printtyp.cmi \
     typing/printpat.cmi \
@@ -1140,7 +1169,6 @@ typing/typecore.cmo : \
     typing/path.cmi \
     parsing/parsetree.cmi \
     typing/parmatch.cmi \
-    typing/oprint.cmi \
     typing/mtype.cmi \
     utils/misc.cmi \
     parsing/longident.cmi \
@@ -1163,7 +1191,6 @@ typing/typecore.cmx : \
     typing/typedtree.cmx \
     typing/typedecl.cmx \
     typing/subst.cmx \
-    typing/stypes.cmx \
     typing/rec_check.cmx \
     typing/printtyp.cmx \
     typing/printpat.cmx \
@@ -1173,7 +1200,6 @@ typing/typecore.cmx : \
     typing/path.cmx \
     parsing/parsetree.cmi \
     typing/parmatch.cmx \
-    typing/oprint.cmx \
     typing/mtype.cmx \
     utils/misc.cmx \
     parsing/longident.cmx \
@@ -1438,7 +1464,6 @@ typing/typemod.cmo : \
     typing/typecore.cmi \
     typing/typeclass.cmi \
     typing/subst.cmi \
-    typing/stypes.cmi \
     typing/printtyp.cmi \
     typing/path.cmi \
     parsing/parsetree.cmi \
@@ -1454,6 +1479,7 @@ typing/typemod.cmo : \
     typing/ctype.cmi \
     utils/config.cmi \
     file_formats/cmt_format.cmi \
+    typing/cmt2annot.cmo \
     file_formats/cmi_format.cmi \
     utils/clflags.cmi \
     parsing/builtin_attributes.cmi \
@@ -1471,7 +1497,6 @@ typing/typemod.cmx : \
     typing/typecore.cmx \
     typing/typeclass.cmx \
     typing/subst.cmx \
-    typing/stypes.cmx \
     typing/printtyp.cmx \
     typing/path.cmx \
     parsing/parsetree.cmi \
@@ -1487,6 +1512,7 @@ typing/typemod.cmx : \
     typing/ctype.cmx \
     utils/config.cmx \
     file_formats/cmt_format.cmx \
+    typing/cmt2annot.cmx \
     file_formats/cmi_format.cmx \
     utils/clflags.cmx \
     parsing/builtin_attributes.cmx \
@@ -1547,6 +1573,7 @@ typing/types.cmo : \
     utils/misc.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
+    utils/identifiable.cmi \
     typing/ident.cmi \
     utils/config.cmi \
     parsing/asttypes.cmi \
@@ -1559,6 +1586,7 @@ typing/types.cmx : \
     utils/misc.cmx \
     parsing/longident.cmx \
     parsing/location.cmx \
+    utils/identifiable.cmx \
     typing/ident.cmx \
     utils/config.cmx \
     parsing/asttypes.cmi \
@@ -1570,6 +1598,7 @@ typing/types.cmi : \
     parsing/parsetree.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
+    utils/identifiable.cmi \
     typing/ident.cmi \
     parsing/asttypes.cmi
 typing/typetexp.cmo : \
@@ -3302,25 +3331,21 @@ lambda/runtimedef.cmx : \
 lambda/runtimedef.cmi :
 lambda/simplif.cmo : \
     utils/warnings.cmi \
-    typing/stypes.cmi \
     typing/primitive.cmi \
     parsing/location.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
     utils/clflags.cmi \
     parsing/asttypes.cmi \
-    typing/annot.cmi \
     lambda/simplif.cmi
 lambda/simplif.cmx : \
     utils/warnings.cmx \
-    typing/stypes.cmx \
     typing/primitive.cmx \
     parsing/location.cmx \
     lambda/lambda.cmx \
     typing/ident.cmx \
     utils/clflags.cmx \
     parsing/asttypes.cmi \
-    typing/annot.cmi \
     lambda/simplif.cmi
 lambda/simplif.cmi : \
     parsing/location.cmi \
@@ -5708,7 +5733,6 @@ driver/compile_common.cmo : \
     typing/typemod.cmi \
     typing/typedtree.cmi \
     typing/typecore.cmi \
-    typing/stypes.cmi \
     utils/profile.cmi \
     typing/printtyped.cmi \
     typing/printtyp.cmi \
@@ -5729,7 +5753,6 @@ driver/compile_common.cmx : \
     typing/typemod.cmx \
     typing/typedtree.cmx \
     typing/typecore.cmx \
-    typing/stypes.cmx \
     utils/profile.cmx \
     typing/printtyped.cmx \
     typing/printtyp.cmx \
@@ -5751,6 +5774,7 @@ driver/compile_common.cmi : \
     typing/env.cmi
 driver/compmisc.cmo : \
     utils/warnings.cmi \
+    typing/types.cmi \
     typing/typemod.cmi \
     utils/misc.cmi \
     parsing/location.cmi \
@@ -5763,6 +5787,7 @@ driver/compmisc.cmo : \
     driver/compmisc.cmi
 driver/compmisc.cmx : \
     utils/warnings.cmx \
+    typing/types.cmx \
     typing/typemod.cmx \
     utils/misc.cmx \
     parsing/location.cmx \
diff --git a/Changes b/Changes
index c6d48794e6..a574cf7327 100644
--- a/Changes
+++ b/Changes
@@ -178,6 +178,10 @@ Working version
   from intermediate-representation dumps (-dfoo).
   (Gabriel Scherer, review by Vincent Laviron)
 
+- #2141: generate .annot files from cmt data; deprecate -annot.
+  (Nicolás Ojeda Bär, review by Alain Frisch, Gabriel Scherer and Damien
+  Doligez)
+
 ### Internal/compiler-libs changes:
 
  - #463: a new Misc.Magic_number module for user-friendly parsing
diff --git a/compilerlibs/Makefile.compilerlibs b/compilerlibs/Makefile.compilerlibs
index 5ce1945b8d..4bcd179c1e 100644
--- a/compilerlibs/Makefile.compilerlibs
+++ b/compilerlibs/Makefile.compilerlibs
@@ -54,10 +54,10 @@ TYPING=typing/ident.cmo typing/path.cmo \
   typing/typedtree.cmo typing/printtyped.cmo typing/ctype.cmo \
   typing/printtyp.cmo typing/includeclass.cmo \
   typing/mtype.cmo typing/envaux.cmo typing/includecore.cmo \
-  typing/tast_iterator.cmo typing/tast_mapper.cmo \
-  file_formats/cmt_format.cmo typing/untypeast.cmo \
+  typing/tast_iterator.cmo typing/tast_mapper.cmo typing/stypes.cmo \
+  file_formats/cmt_format.cmo typing/cmt2annot.cmo typing/untypeast.cmo \
   typing/includemod.cmo typing/typetexp.cmo typing/printpat.cmo \
-  typing/parmatch.cmo typing/stypes.cmo \
+  typing/parmatch.cmo \
   typing/typedecl_properties.cmo typing/typedecl_variance.cmo \
   typing/typedecl_unboxed.cmo typing/typedecl_immediacy.cmo \
   typing/typedecl_separability.cmo \
diff --git a/driver/compile_common.ml b/driver/compile_common.ml
index 601cfa831c..fb15396e3b 100644
--- a/driver/compile_common.ml
+++ b/driver/compile_common.ml
@@ -101,15 +101,12 @@ let parse_impl i =
   |> print_if i.ppf_dump Clflags.dump_source Pprintast.structure
 
 let typecheck_impl i parsetree =
-  let always () = Stypes.dump (Some (annot i)) in
-  Misc.try_finally ~always (fun () ->
-    parsetree
-    |> Profile.(record typing)
-      (Typemod.type_implementation
-         i.source_file i.output_prefix i.module_name i.env)
-    |> print_if i.ppf_dump Clflags.dump_typedtree
-      Printtyped.implementation_with_coercion
-  )
+  parsetree
+  |> Profile.(record typing)
+    (Typemod.type_implementation
+       i.source_file i.output_prefix i.module_name i.env)
+  |> print_if i.ppf_dump Clflags.dump_typedtree
+    Printtyped.implementation_with_coercion
 
 let implementation info ~backend =
   Profile.record_call info.source_file @@ fun () ->
diff --git a/driver/main_args.ml b/driver/main_args.ml
index 5c8c3aef9c..5c28ded5c2 100644
--- a/driver/main_args.ml
+++ b/driver/main_args.ml
@@ -33,7 +33,7 @@ let mk_absname f =
 ;;
 
 let mk_annot f =
-  "-annot", Arg.Unit f, " Save information in <filename>.annot"
+  "-annot", Arg.Unit f, " (deprecated) Save information in <filename>.annot"
 ;;
 
 let mk_binannot f =
diff --git a/lambda/simplif.ml b/lambda/simplif.ml
index 8cc7fe5e88..465d299364 100644
--- a/lambda/simplif.ml
+++ b/lambda/simplif.ml
@@ -600,12 +600,6 @@ let is_tail_native_heuristic : (int -> bool) ref =
   ref (fun _ -> true)
 
 let rec emit_tail_infos is_tail lambda =
-  let call_kind args =
-    if is_tail
-    && ((not !Clflags.native_code)
-        || (!is_tail_native_heuristic (List.length args)))
-   then Annot.Tail
-   else Annot.Stack in
   match lambda with
   | Lvar _ -> ()
   | Lconst _ -> ()
@@ -615,9 +609,7 @@ let rec emit_tail_infos is_tail lambda =
       && Warnings.is_active Warnings.Expect_tailcall
         then Location.prerr_warning ap.ap_loc Warnings.Expect_tailcall;
       emit_tail_infos false ap.ap_func;
-      list_emit_tail_infos false ap.ap_args;
-      if !Clflags.annotations then
-        Stypes.record (Stypes.An_call (ap.ap_loc, call_kind ap.ap_args))
+      list_emit_tail_infos false ap.ap_args
   | Lfunction {body = lam} ->
       emit_tail_infos true lam
   | Llet (_str, _k, _, lam, body) ->
@@ -671,12 +663,10 @@ let rec emit_tail_infos is_tail lambda =
       emit_tail_infos false body
   | Lassign (_, lam) ->
       emit_tail_infos false lam
-  | Lsend (_, meth, obj, args, loc) ->
+  | Lsend (_, meth, obj, args, _loc) ->
       emit_tail_infos false meth;
       emit_tail_infos false obj;
-      list_emit_tail_infos false args;
-      if !Clflags.annotations then
-        Stypes.record (Stypes.An_call (loc, call_kind (obj :: args)));
+      list_emit_tail_infos false args
   | Levent (lam, _) ->
       emit_tail_infos is_tail lam
   | Lifused (_, lam) ->
diff --git a/man/ocamlc.m b/man/ocamlc.m
index 8663685979..456c0f6604 100644
--- a/man/ocamlc.m
+++ b/man/ocamlc.m
@@ -204,17 +204,9 @@ excluding the filename.
 Show absolute filenames in error messages.
 .TP
 .B \-annot
-Dump detailed information about the compilation (types, bindings,
-tail-calls, etc).  The information for file
-.IR src .ml
-is put into file
-.IR src .annot.
-In case of a type error, dump all the information inferred by the
-type-checker before the error. The
-.IR src .annot
-file can be used with the emacs commands given in
-.B emacs/caml\-types.el
-to display types and other annotations interactively.
+Deprecated since 4.11. Please use
+.BR \-bin-annot
+instead.
 .TP
 .B \-bin\-annot
 Dump detailed information about the compilation (types, bindings,
diff --git a/man/ocamlopt.m b/man/ocamlopt.m
index 5c1bc40e2c..a857c2c1fa 100644
--- a/man/ocamlopt.m
+++ b/man/ocamlopt.m
@@ -167,17 +167,9 @@ excluding the filename.
 Show absolute filenames in error messages.
 .TP
 .B \-annot
-Dump detailed information about the compilation (types, bindings,
-tail-calls, etc).  The information for file
-.IR src .ml
-is put into file
-.IR src .annot.
-In case of a type error, dump all the information inferred by the
-type-checker before the error. The
-.IR src .annot
-file can be used with the emacs commands given in
-.B emacs/caml\-types.el
-to display types and other annotations interactively.
+Deprecated since OCaml 4.11. Please use
+.BR \-bin-annot
+instead.
 .TP
 .B \-bin\-annot
 Dump detailed information about the compilation (types, bindings,
diff --git a/manual/manual/cmds/unified-options.etex b/manual/manual/cmds/unified-options.etex
index 183d00a67c..fe63611283 100644
--- a/manual/manual/cmds/unified-options.etex
+++ b/manual/manual/cmds/unified-options.etex
@@ -61,13 +61,7 @@ command line, unless the "-noautolink" option is given.
 Force error messages to show absolute paths for file names.
 
 \notop{\item["-annot"]
-Dump detailed information about the compilation (types, bindings,
-tail-calls, etc).  The information for file \var{src}".ml"
-is put into file \var{src}".annot".  In case of a type error, dump
-all the information inferred by the type-checker before the error.
-The \var{src}".annot" file can be used with the emacs commands given in
-"emacs/caml-types.el" to display types and other annotations
-interactively.
+Deprecated since OCaml 4.11. Please use "-bin-annot" instead.
 }%notop
 
 \item["-args" \var{filename}]
diff --git a/tools/.depend b/tools/.depend
index a4d18f4b17..109cb1f3f1 100644
--- a/tools/.depend
+++ b/tools/.depend
@@ -28,40 +28,6 @@ cmpbyt.cmo : \
     ../bytecomp/bytesections.cmi
 cmpbyt.cmx : \
     ../bytecomp/bytesections.cmx
-cmt2annot.cmo : \
-    ../typing/untypeast.cmi \
-    ../typing/types.cmi \
-    ../typing/typedtree.cmi \
-    ../typing/tast_iterator.cmi \
-    ../typing/stypes.cmi \
-    ../parsing/pprintast.cmi \
-    ../typing/path.cmi \
-    ../typing/oprint.cmi \
-    ../parsing/location.cmi \
-    ../utils/load_path.cmi \
-    ../typing/ident.cmi \
-    ../typing/envaux.cmi \
-    ../typing/env.cmi \
-    ../file_formats/cmt_format.cmi \
-    ../parsing/asttypes.cmi \
-    ../typing/annot.cmi
-cmt2annot.cmx : \
-    ../typing/untypeast.cmx \
-    ../typing/types.cmx \
-    ../typing/typedtree.cmx \
-    ../typing/tast_iterator.cmx \
-    ../typing/stypes.cmx \
-    ../parsing/pprintast.cmx \
-    ../typing/path.cmx \
-    ../typing/oprint.cmx \
-    ../parsing/location.cmx \
-    ../utils/load_path.cmx \
-    ../typing/ident.cmx \
-    ../typing/envaux.cmx \
-    ../typing/env.cmx \
-    ../file_formats/cmt_format.cmx \
-    ../parsing/asttypes.cmi \
-    ../typing/annot.cmi
 cvt_emit.cmo :
 cvt_emit.cmx :
 dumpobj.cmo : \
@@ -202,17 +168,29 @@ profiling.cmx : \
     profiling.cmi
 profiling.cmi :
 read_cmt.cmo : \
+    ../typing/untypeast.cmi \
+    ../typing/stypes.cmi \
+    ../parsing/pprintast.cmi \
     ../parsing/location.cmi \
+    ../utils/load_path.cmi \
+    ../typing/envaux.cmi \
     ../driver/compmisc.cmi \
     ../file_formats/cmt_format.cmi \
-    cmt2annot.cmo \
-    ../utils/clflags.cmi
+    ../typing/cmt2annot.cmo \
+    ../utils/clflags.cmi \
+    ../typing/annot.cmi
 read_cmt.cmx : \
+    ../typing/untypeast.cmx \
+    ../typing/stypes.cmx \
+    ../parsing/pprintast.cmx \
     ../parsing/location.cmx \
+    ../utils/load_path.cmx \
+    ../typing/envaux.cmx \
     ../driver/compmisc.cmx \
     ../file_formats/cmt_format.cmx \
-    cmt2annot.cmx \
-    ../utils/clflags.cmx
+    ../typing/cmt2annot.cmx \
+    ../utils/clflags.cmx \
+    ../typing/annot.cmi
 stripdebug.cmo : \
     ../utils/misc.cmi \
     ../bytecomp/bytesections.cmi
diff --git a/tools/Makefile b/tools/Makefile
index 18aead9359..8bd51bfd8f 100644
--- a/tools/Makefile
+++ b/tools/Makefile
@@ -228,7 +228,7 @@ READ_CMT= \
           $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
           $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
           \
-          cmt2annot.cmo read_cmt.cmo
+          read_cmt.cmo
 
 # Reading cmt files
 $(call byte_and_opt,read_cmt,$(READ_CMT),)
diff --git a/tools/read_cmt.ml b/tools/read_cmt.ml
index 0e3cfbc267..ae6b97fdc3 100644
--- a/tools/read_cmt.ml
+++ b/tools/read_cmt.ml
@@ -97,6 +97,64 @@ let print_info cmt =
   end;
   ()
 
+let generate_ml target_filename filename cmt =
+  let (printer, ext) =
+    match cmt.Cmt_format.cmt_annots with
+      | Cmt_format.Implementation typedtree ->
+          (fun ppf -> Pprintast.structure ppf
+                                        (Untypeast.untype_structure typedtree)),
+          ".ml"
+      | Cmt_format.Interface typedtree ->
+          (fun ppf -> Pprintast.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 _ -> 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
+
+(* Save cmt information as faked annotations, attached to
+   Location.none, on top of the .annot file. Only when -save-cmt-info is
+   provided to ocaml_cmt.
+*)
+let record_cmt_info cmt =
+  let location_none = {
+    Location.none with Location.loc_ghost = false }
+  in
+  let location_file file = {
+    Location.none with
+      Location.loc_start = {
+        Location.none.Location.loc_start with
+          Lexing.pos_fname = file }}
+  in
+  let record_info name value =
+    let ident = Printf.sprintf ".%s" name in
+    Stypes.record (Stypes.An_ident (location_none, ident,
+                                    Annot.Idef (location_file value)))
+  in
+  let open Cmt_format in
+  (* record in reverse order to get them in correct order... *)
+  List.iter (fun dir -> record_info "include" dir) (List.rev cmt.cmt_loadpath);
+  record_info "chdir" cmt.cmt_builddir;
+  (match cmt.cmt_sourcefile with
+    None -> () | Some file -> record_info "source" file)
+
 let main () =
   Clflags.annotations := true;
 
@@ -105,12 +163,25 @@ let main () =
       Filename.check_suffix filename ".cmt" ||
         Filename.check_suffix filename ".cmti"
     then begin
+      let open Cmt_format in
       Compmisc.init_path ();
-      let cmt = Cmt_format.read_cmt filename in
-      if !gen_annot then
-        Cmt2annot.gen_annot ~save_cmt_info: !save_cmt_info
-          !target_filename filename cmt;
-      if !gen_ml then Cmt2annot.gen_ml !target_filename filename cmt;
+      let cmt = read_cmt filename in
+      if !gen_annot then begin
+        if !save_cmt_info then record_cmt_info cmt;
+        let target_filename =
+          match !target_filename with
+          | None -> Some (filename ^ ".annot")
+          | Some "-" -> None
+          | Some _ as x -> x
+        in
+        Envaux.reset_cache ();
+        List.iter Load_path.add_dir (List.rev cmt.cmt_loadpath);
+        Cmt2annot.gen_annot target_filename
+          ~sourcefile:cmt.cmt_sourcefile
+          ~use_summaries:cmt.cmt_use_summaries
+          cmt.cmt_annots
+      end;
+      if !gen_ml then generate_ml !target_filename filename cmt;
       if !print_info_arg || not (!gen_ml || !gen_annot) then print_info cmt;
     end else begin
       Printf.fprintf stderr
diff --git a/typing/TODO.md b/typing/TODO.md
index ebd0f99907..c115116117 100644
--- a/typing/TODO.md
+++ b/typing/TODO.md
@@ -79,9 +79,6 @@ consensus for all of them.
 - Track "string literals" in the type-checker, which often act as
   magic "internal" names which should be avoided.
 
-- Get rid of -annot.
-  (see Nicolas' PR)
-
 - Consider storing warning settings (+other context) as part of `Env.t`?
 
 - Parse attributes understood (e.g. the deprecated attribute) by the
diff --git a/tools/cmt2annot.ml b/typing/cmt2annot.ml
index 3455fa0caa..40ee752e80 100644
--- a/tools/cmt2annot.ml
+++ b/typing/cmt2annot.ml
@@ -76,11 +76,7 @@ let rec iterator ~scope rebuild_env =
         let full_name = Path.name ~paren:Oprint.parenthesized_ident path in
         let env =
           if rebuild_env then
-            try
-              Env.env_of_only_summary Envaux.env_from_summary exp.exp_env
-            with Envaux.Error err ->
-              Format.eprintf "%a@." Envaux.report_error err;
-              exit 2
+            Env.env_of_only_summary Envaux.env_from_summary exp.exp_env
           else
             exp.exp_env
         in
@@ -169,89 +165,20 @@ let binary_part iter x =
   | Partial_signature_item x -> iter.signature_item iter x
   | Partial_module_type x -> iter.module_type iter x
 
-(* Save cmt information as faked annotations, attached to
-   Location.none, on top of the .annot file. Only when -save-cmt-info is
-   provided to ocaml_cmt.
-*)
-let record_cmt_info cmt =
-  let location_none = {
-    Location.none with Location.loc_ghost = false }
-  in
-  let location_file file = {
-    Location.none with
-      Location.loc_start = {
-        Location.none.Location.loc_start with
-          Lexing.pos_fname = file }}
-  in
-  let record_info name value =
-    let ident = Printf.sprintf ".%s" name in
-    Stypes.record (Stypes.An_ident (location_none, ident,
-                                    Annot.Idef (location_file value)))
-  in
-  let open Cmt_format in
-  (* record in reverse order to get them in correct order... *)
-  List.iter (fun dir -> record_info "include" dir) (List.rev cmt.cmt_loadpath);
-  record_info "chdir" cmt.cmt_builddir;
-  (match cmt.cmt_sourcefile with
-    None -> () | Some file -> record_info "source" file)
-
-let gen_annot ?(save_cmt_info=false) target_filename filename cmt =
+let gen_annot target_filename ~sourcefile ~use_summaries annots =
   let open Cmt_format in
-  Envaux.reset_cache ();
-  List.iter Load_path.add_dir (List.rev cmt.cmt_loadpath);
-  let target_filename =
-    match target_filename with
-    | None -> Some (filename ^ ".annot")
-    | Some "-" -> None
-    | Some _ -> target_filename
+  let scope =
+    match sourcefile with
+    | None -> Location.none
+    | Some s -> Location.in_file s
   in
-  if save_cmt_info then record_cmt_info cmt;
-  let iter = iterator ~scope:Location.none cmt.cmt_use_summaries in
-  match cmt.cmt_annots with
+  let iter = iterator ~scope use_summaries in
+  match annots with
   | Implementation typedtree ->
       iter.structure iter typedtree;
       Stypes.dump target_filename
-  | Interface _ ->
-      Printf.eprintf "Cannot generate annotations for interface file\n%!";
-      exit 2
   | Partial_implementation parts ->
       Array.iter (binary_part iter) parts;
       Stypes.dump target_filename
-  | Packed _ ->
-      Printf.fprintf stderr "Packed files not yet supported\n%!";
-      Stypes.dump target_filename
-  | Partial_interface _ ->
-      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.structure ppf
-                                        (Untypeast.untype_structure typedtree)),
-          ".ml"
-      | Cmt_format.Interface typedtree ->
-          (fun ppf -> Pprintast.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 _ -> 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
+  | Interface _ | Packed _ | Partial_interface _ ->
+      ()
diff --git a/typing/envaux.ml b/typing/envaux.ml
index 2d3a02bc14..8f77435aeb 100644
--- a/typing/envaux.ml
+++ b/typing/envaux.ml
@@ -106,3 +106,10 @@ open Format
 let report_error ppf = function
   | Module_not_found p ->
       fprintf ppf "@[Cannot find module %a@].@." Printtyp.path p
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index ca6463e88e..a5436e5dfe 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -247,7 +247,6 @@ let rec limited_generalize rv =
 (* Record a class type *)
 let rc node =
   Cmt_format.add_saved_type (Cmt_format.Partial_class_expr node);
-  Stypes.record (Stypes.Ti_class node); (* moved to genannot *)
   node
 
 
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 37c86aeefb..70a2880fd8 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -172,17 +172,14 @@ let type_object =
 *)
 let re node =
   Cmt_format.add_saved_type (Cmt_format.Partial_expression node);
-  Stypes.record (Stypes.Ti_expr node);
   node
 ;;
 let rp node =
   Cmt_format.add_saved_type (Cmt_format.Partial_pattern (Value, node));
-  Stypes.record (Stypes.Ti_pat (Value, node));
   node
 ;;
 let rcp node =
   Cmt_format.add_saved_type (Cmt_format.Partial_pattern (Computation, node));
-  Stypes.record (Stypes.Ti_pat (Computation, node));
   node
 ;;
 
@@ -417,11 +414,6 @@ let enter_variable ?(is_module=false) ?(is_as_variable=false) loc name ty
     if not !allow_modules then
       raise (Error (loc, Env.empty, Modules_not_allowed));
     module_variables := (name, loc) :: !module_variables
-  end else begin
-    (* moved to genannot *)
-    Option.iter
-      (fun s -> Stypes.record (Stypes.An_ident (name.loc, name.txt, s)))
-      !pattern_scope
   end;
   id
 
@@ -3647,15 +3639,6 @@ and type_expect_
 
 and type_ident env ?(recarg=Rejected) lid =
   let (path, desc) = Env.lookup_value ~loc:lid.loc lid.txt env in
-  if !Clflags.annotations then begin
-    let dloc = desc.Types.val_loc in
-    let annot =
-      if dloc.Location.loc_ghost then Annot.Iref_external
-      else Annot.Iref_internal dloc
-    in
-    let name = Path.name ~paren:Oprint.parenthesized_ident path in
-    Stypes.record (Stypes.An_ident (lid.loc, name, annot))
-  end;
   let is_recarg =
     match (repr desc.val_type).desc with
     | Tconstr(p, _, _) -> Path.is_constructor_typath p
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 2f5948e632..5cf03dc761 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -214,11 +214,6 @@ let type_open_descr ?used_slot ?toplevel env sod =
   in
   (od, newenv)
 
-(* Record a module type *)
-let rm node =
-  Stypes.record (Stypes.Ti_mod node);
-  node
-
 (* Forward declaration, to be filled in by type_module_type_of *)
 let type_module_type_of_fwd :
     (Env.t -> Parsetree.module_expr ->
@@ -1906,16 +1901,16 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
               else mty
             in
             { md with mod_type = mty }
-      in rm md
+      in md
   | Pmod_structure sstr ->
       let (str, sg, names, _finalenv) =
         type_structure funct_body anchor env sstr smod.pmod_loc in
       let md =
-        rm { mod_desc = Tmod_structure str;
-             mod_type = Mty_signature sg;
-             mod_env = env;
-             mod_attributes = smod.pmod_attributes;
-             mod_loc = smod.pmod_loc }
+        { mod_desc = Tmod_structure str;
+          mod_type = Mty_signature sg;
+          mod_env = env;
+          mod_attributes = smod.pmod_attributes;
+          mod_loc = smod.pmod_loc }
       in
       let sg' = Signature_names.simplify _finalenv names sg in
       if List.length sg' = List.length sg then md else
@@ -1948,11 +1943,11 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
           Named (id, param, mty), Types.Named (id, mty.mty_type), newenv, true
       in
       let body = type_module sttn funct_body None newenv sbody in
-      rm { mod_desc = Tmod_functor(t_arg, body);
-           mod_type = Mty_functor(ty_arg, body.mod_type);
-           mod_env = env;
-           mod_attributes = smod.pmod_attributes;
-           mod_loc = smod.pmod_loc }
+      { mod_desc = Tmod_functor(t_arg, body);
+        mod_type = Mty_functor(ty_arg, body.mod_type);
+        mod_env = env;
+        mod_attributes = smod.pmod_attributes;
+        mod_loc = smod.pmod_loc }
   | Pmod_apply(sfunct, sarg) ->
       let arg = type_module true funct_body None env sarg in
       let path = path_of_module arg in
@@ -1964,11 +1959,11 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
             raise (Error (sfunct.pmod_loc, env, Apply_generative));
           if funct_body && Mtype.contains_type env funct.mod_type then
             raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
-          rm { mod_desc = Tmod_apply(funct, arg, Tcoerce_none);
-               mod_type = mty_res;
-               mod_env = env;
-               mod_attributes = smod.pmod_attributes;
-               mod_loc = smod.pmod_loc }
+          { mod_desc = Tmod_apply(funct, arg, Tcoerce_none);
+            mod_type = mty_res;
+            mod_env = env;
+            mod_attributes = smod.pmod_attributes;
+            mod_loc = smod.pmod_loc }
       | Mty_functor (Named (param, mty_param), mty_res) as mty_functor ->
           let coercion =
             try
@@ -2017,11 +2012,11 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
           in
           check_well_formed_module env smod.pmod_loc
             "the signature of this functor application" mty_appl;
-          rm { mod_desc = Tmod_apply(funct, arg, coercion);
-               mod_type = mty_appl;
-               mod_env = env;
-               mod_attributes = smod.pmod_attributes;
-               mod_loc = smod.pmod_loc }
+          { mod_desc = Tmod_apply(funct, arg, coercion);
+            mod_type = mty_appl;
+            mod_env = env;
+            mod_attributes = smod.pmod_attributes;
+            mod_loc = smod.pmod_loc }
       | Mty_alias path ->
           raise(Error(sfunct.pmod_loc, env, Cannot_scrape_alias path))
       | _ ->
@@ -2033,10 +2028,10 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
       let md =
         wrap_constraint env true arg mty.mty_type (Tmodtype_explicit mty)
       in
-      rm { md with
-          mod_loc = smod.pmod_loc;
-          mod_attributes = smod.pmod_attributes;
-         }
+      { md with
+        mod_loc = smod.pmod_loc;
+        mod_attributes = smod.pmod_attributes;
+      }
 
   | Pmod_unpack sexp ->
       if !Clflags.principal then Ctype.begin_def ();
@@ -2065,11 +2060,11 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
       in
       if funct_body && Mtype.contains_type env mty then
         raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
-      rm { mod_desc = Tmod_unpack(exp, mty);
-           mod_type = mty;
-           mod_env = env;
-           mod_attributes = smod.pmod_attributes;
-           mod_loc = smod.pmod_loc }
+      { mod_desc = Tmod_unpack(exp, mty);
+        mod_type = mty;
+        mod_env = env;
+        mod_attributes = smod.pmod_attributes;
+        mod_loc = smod.pmod_loc }
   | Pmod_extension ext ->
       raise (Error_forward (Builtin_attributes.error_of_extension ext))
 
@@ -2439,9 +2434,6 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
         let (str_rem, sig_rem, final_env) = type_struct new_env srem in
         (str :: str_rem, sg @ sig_rem, final_env)
   in
-  if !Clflags.annotations then
-    (* moved to genannot *)
-    List.iter (function {pstr_loc = l} -> Stypes.record_phrase l) sstr;
   let previous_saved_types = Cmt_format.get_saved_types () in
   let run () =
     let (items, sg, final_env) = type_struct env sstr in
@@ -2486,11 +2478,11 @@ let type_module_type_of env smod =
     match smod.pmod_desc with
     | Pmod_ident lid -> (* turn off strengthening in this case *)
         let path, md = Env.lookup_module ~loc:smod.pmod_loc lid.txt env in
-          rm { mod_desc = Tmod_ident (path, lid);
-               mod_type = md.md_type;
-               mod_env = env;
-               mod_attributes = smod.pmod_attributes;
-               mod_loc = smod.pmod_loc }
+          { mod_desc = Tmod_ident (path, lid);
+            mod_type = md.md_type;
+            mod_env = env;
+            mod_attributes = smod.pmod_attributes;
+            mod_loc = smod.pmod_loc }
     | _ -> type_module env smod
   in
   let mty = Mtype.scrape_for_type_of ~remove_aliases env tmty.mod_type in
@@ -2624,6 +2616,10 @@ let () =
 
 (* Typecheck an implementation file *)
 
+let gen_annot outputprefix sourcefile annots =
+  Cmt2annot.gen_annot (Some (outputprefix ^ ".annot"))
+    ~sourcefile:(Some sourcefile) ~use_summaries:false annots
+
 let type_implementation sourcefile outputprefix modulename initial_env ast =
   Cmt_format.clear ();
   Misc.try_finally (fun () ->
@@ -2640,6 +2636,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
           (fun () -> fprintf std_formatter "%a@."
               (Printtyp.printed_signature sourcefile) simple_sg
           );
+        gen_annot outputprefix sourcefile (Cmt_format.Implementation str);
         (str, Tcoerce_none)   (* result is ignored by Compile.implementation *)
       end else begin
         let sourceintf =
@@ -2660,8 +2657,10 @@ 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. *)
+          let annots = Cmt_format.Implementation str in
           Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename
-            (Cmt_format.Implementation str) (Some sourcefile) initial_env None;
+            annots (Some sourcefile) initial_env None;
+          gen_annot outputprefix sourcefile annots;
           (str, coercion)
         end else begin
           let coercion =
@@ -2681,19 +2680,24 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
               Env.save_signature ~alerts
                 simple_sg modulename (outputprefix ^ ".cmi")
             in
+            let annots = Cmt_format.Implementation str in
             Cmt_format.save_cmt  (outputprefix ^ ".cmt") modulename
-              (Cmt_format.Implementation str)
-              (Some sourcefile) initial_env (Some cmi);
+              annots (Some sourcefile) initial_env (Some cmi);
+            gen_annot outputprefix sourcefile annots
           end;
           (str, coercion)
         end
       end
     )
     ~exceptionally:(fun () ->
+        let annots =
+          Cmt_format.Partial_implementation
+            (Array.of_list (Cmt_format.get_saved_types ()))
+        in
         Cmt_format.save_cmt  (outputprefix ^ ".cmt") modulename
-          (Cmt_format.Partial_implementation
-             (Array.of_list (Cmt_format.get_saved_types ())))
-          (Some sourcefile) initial_env None)
+          annots (Some sourcefile) initial_env None;
+        gen_annot outputprefix sourcefile annots
+      )
 
 let save_signature modname tsg outputprefix source_file initial_env cmi =
   Cmt_format.save_cmt  (outputprefix ^ ".cmti") modname