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