blob: f8535b66a6084fbef9f6b2f692b63d00db8c65e8 (
plain)
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
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Fabrice Le Fessant, projet OCamlPro, INRIA Rocquencourt *)
(* *)
(* Copyright 2010 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(*
Generate .annot file from a .types files.
*)
open Typedtree
let load_cmt_or_exit filename =
try
let ic = open_in filename in
let (types : saved_type array) = input_value ic in
close_in ic;
match types with
[| Saved_implementation typedtree |] -> typedtree
| _ ->
Printf.fprintf stderr "File was generated with an error\n%!";
exit 2
with e ->
Printf.fprintf stderr "Error %s while loading %s\n%!" (Printexc.to_string e) filename;
exit 2
let load_cmti_or_exit filename =
try
let ic = open_in filename in
let (types : saved_type array) = input_value ic in
close_in ic;
match types with
[| Saved_signature typedtree |] -> typedtree
| _ ->
Printf.fprintf stderr "File was generated with an error\n%!";
exit 2
with e ->
Printf.fprintf stderr "Error %s while loading %s\n%!" (Printexc.to_string e) filename;
exit 2
let directories = ref []
let arg_list = [
"-I", Arg.String (fun filename -> directories := filename :: !directories),
"<dir> Add <dir> to the list of include directories";
]
let arg_usage = " ... : generates some information from .cmt/.cmti files"
let _ =
Arg.parse arg_list (fun filename -> Arg.usage arg_list arg_usage) arg_usage
module StringMap = Map.Make(struct type t = string let compare = compare end)
type cmt = {
cmt_modname : string;
cmt_filename : string;
cmt_typedtree : Typedtree.structure;
}
type cmti = {
cmti_modname : string;
cmti_filename : string;
cmti_typedtree : Typedtree.signature;
}
let cmts = ref StringMap.empty
let cmtis = ref StringMap.empty
let first_cmt = ref None
let add_cmt filename =
let typedtree = load_cmt_or_exit filename in
Printf.printf "%s loaded\n%!" filename;
let modname = String.capitalize (Filename.basename (Filename.chop_suffix filename ".cmt")) in
let cmt = {
cmt_modname = modname;
cmt_filename = filename;
cmt_typedtree = typedtree;
} in
first_cmt := Some cmt;
cmts := StringMap.add modname cmt !cmts
let add_cmti filename =
let typedtree = load_cmti_or_exit filename in
Printf.printf "%s loaded\n%!" filename;
let modname = String.capitalize (Filename.basename (Filename.chop_suffix filename ".cmti")) in
let cmti = {
cmti_modname = modname;
cmti_filename = filename;
cmti_typedtree = typedtree;
} in
cmtis := StringMap.add modname cmti !cmtis
let _ =
List.iter (fun dirname ->
let dir = Unix.opendir dirname in
begin
try
while true do
let file = Unix.readdir dir in
if Filename.check_suffix file ".cmt" then
let filename = Filename.concat dirname file in
add_cmt filename
else
if Filename.check_suffix file ".cmti" then
let filename = Filename.concat dirname file in
add_cmti filename
done
with End_of_file -> ()
end;
Unix.closedir dir;
) !directories
let cmts = !cmts
let cmtis = !cmtis
let current_cmt = ref (match !first_cmt with None -> assert false | Some cmt -> cmt)
let get_path path = ()
module ForIterator = struct
open Asttypes
open Types
open Typedtree
include DefaultIteratorArgument
let enter_expression e =
match e.exp_desc with
Texp_ident (path, { val_kind = Val_reg}) ->
()
| _ -> ()
end
module Iterator = MakeIterator(ForIterator)
let set_iterator cmt =
current_cmt := cmt
let _ =
StringMap.iter (fun _ cmt ->
set_iterator cmt;
Iterator.iter_structure cmt.cmt_typedtree
) cmts
|
