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
This commit is contained in:
parent
7fd5dd9fdc
commit
57d329e07b
53
.depend
53
.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 \
|
||||
|
|
4
Changes
4
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
|
||||
|
|
|
@ -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 \
|
||||
|
|
|
@ -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 () ->
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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) ->
|
||||
|
|
14
man/ocamlc.m
14
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,
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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}]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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),)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 gen_annot target_filename ~sourcefile ~use_summaries annots =
|
||||
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 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 _ ->
|
||||
()
|
|
@ -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
|
||||
)
|
||||
|
|
|
@ -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
|
||||
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue