1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Fabrice Le Fessant, INRIA Saclay *)
(* *)
(* Copyright 2012 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
let gen_annot = ref false
let gen_ml = ref false
let print_info_arg = ref false
let target_filename = ref None
let save_cmt_info = ref false
let arg_list = Arg.align [
"-o", Arg.String (fun s -> target_filename := Some s),
"<file> Dump to file <file> (or stdout if -)";
"-annot", Arg.Set gen_annot,
" Generate the corresponding .annot file";
"-save-cmt-info", Arg.Set save_cmt_info,
" Encapsulate additional cmt information in annotations";
"-src", Arg.Set gen_ml,
" Convert .cmt or .cmti back to source code (without comments)";
"-info", Arg.Set print_info_arg, " : print information on the file";
"-args", Arg.Expand Arg.read_arg,
"<file> Read additional newline separated command line arguments \n\
\ from <file>";
"-args0", Arg.Expand Arg.read_arg0,
"<file> Read additional NUL separated command line arguments from \n\
\ <file>";
"-I", Arg.String (fun s ->
Clflags.include_dirs := s :: !Clflags.include_dirs),
"<dir> Add <dir> to the list of include directories";
]
let arg_usage =
"ocamlcmt [OPTIONS] FILE.cmt : read FILE.cmt and print related information"
let dummy_crc = String.make 32 '-'
let print_info cmt =
let oc = match !target_filename with
| None -> stdout
| Some filename -> open_out filename
in
let open Cmt_format in
Printf.fprintf oc "module name: %s\n" cmt.cmt_modname;
begin match cmt.cmt_annots with
Packed (_, list) ->
Printf.fprintf oc "pack: %s\n" (String.concat " " list)
| Implementation _ -> Printf.fprintf oc "kind: implementation\n"
| Interface _ -> Printf.fprintf oc "kind: interface\n"
| Partial_implementation _ ->
Printf.fprintf oc "kind: implementation with errors\n"
| Partial_interface _ -> Printf.fprintf oc "kind: interface with errors\n"
end;
Printf.fprintf oc "command: %s\n"
(String.concat " " (Array.to_list cmt.cmt_args));
begin match cmt.cmt_sourcefile with
None -> ()
| Some name ->
Printf.fprintf oc "sourcefile: %s\n" name;
end;
Printf.fprintf oc "build directory: %s\n" cmt.cmt_builddir;
List.iter (Printf.fprintf oc "load path: %s\n%!") cmt.cmt_loadpath;
begin
match cmt.cmt_source_digest with
None -> ()
| Some digest ->
Printf.fprintf oc "source digest: %s\n" (Digest.to_hex digest);
end;
begin
match cmt.cmt_interface_digest with
None -> ()
| Some digest ->
Printf.fprintf oc "interface digest: %s\n" (Digest.to_hex digest);
end;
List.iter (fun (name, crco) ->
let crc =
match crco with
None -> dummy_crc
| Some crc -> Digest.to_hex crc
in
Printf.fprintf oc "import: %s %s\n" name crc;
) (List.sort compare cmt.cmt_imports);
Printf.fprintf oc "%!";
begin match !target_filename with
| None -> ()
| Some _ -> close_out oc
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
List.iter (fun dir -> record_info "include" dir) 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;
Arg.parse_expand arg_list (fun filename ->
if
Filename.check_suffix filename ".cmt" ||
Filename.check_suffix filename ".cmti"
then begin
let open Cmt_format in
Compmisc.init_path ();
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 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
"Error: the file's extension must be .cmt or .cmti.\n%!";
Arg.usage arg_list arg_usage
end
) arg_usage
let () =
try
main ()
with x ->
Printf.eprintf "Exception in main ()\n%!";
Location.report_exception Format.err_formatter x;
Format.fprintf Format.err_formatter "@.";
exit 2
|
