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
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id$ *)
{
(* Remember the possibly free structure identifiers *)
module StringSet =
Set.Make(struct type t = string let compare = compare end)
let free_structure_names = ref StringSet.empty
let add_structure name =
free_structure_names := StringSet.add name !free_structure_names
(* For nested comments *)
let comment_depth = ref 0
}
rule main = parse
"open" [' ' '\010' '\013' '\009' '\012'] +
{ struct_name lexbuf; main lexbuf }
| ['A'-'Z' '\192'-'\214' '\216'-'\222' ]
(['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255'
'\'' '0'-'9' ]) * '.'
{ let s = Lexing.lexeme lexbuf in
add_structure(String.sub s 0 (String.length s - 1));
main lexbuf }
| "\""
{ string lexbuf; main lexbuf }
| "(*"
{ comment_depth := 1; comment lexbuf; main lexbuf }
| eof
{ () }
| _
{ main lexbuf }
and struct_name = parse
['A'-'Z' '\192'-'\214' '\216'-'\222' ]
(['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255'
'\'' '0'-'9' ]) *
{ add_structure(Lexing.lexeme lexbuf) }
| ""
{ () }
and comment = parse
"(*"
{ comment_depth := succ !comment_depth; comment lexbuf }
| "*)"
{ comment_depth := pred !comment_depth;
if !comment_depth > 0 then comment lexbuf }
| "\""
{ string lexbuf; comment lexbuf }
| "''"
{ comment lexbuf }
| "'" [^ '\\' '\''] "'"
{ comment lexbuf }
| "'\\" ['\\' '\'' 'n' 't' 'b' 'r'] "'"
{ comment lexbuf }
| "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
{ comment lexbuf }
| eof
{ () }
| _
{ comment lexbuf }
and string = parse
'"'
{ () }
| '\\' ("\010" | "\013" | "\010\013") [' ' '\009'] *
{ string lexbuf }
| '\\' ['\\' '"' 'n' 't' 'b' 'r']
{ string lexbuf }
| '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
{ string lexbuf }
| eof
{ () }
| _
{ string lexbuf }
{
(* Print the dependencies *)
let load_path = ref [""]
let opt_flag = ref true
let find_dependency modname (byt_deps, opt_deps) =
let name = Misc.lowercase modname in
try
let filename = Misc.find_in_path !load_path (name ^ ".mli") in
let basename = Filename.chop_suffix filename ".mli" in
((basename ^ ".cmi") :: byt_deps,
(if !opt_flag & Sys.file_exists (basename ^ ".ml")
then basename ^ ".cmx"
else basename ^ ".cmi") :: opt_deps)
with Not_found ->
try
let filename = Misc.find_in_path !load_path (name ^ ".ml") in
let basename = Filename.chop_suffix filename ".ml" in
((basename ^ ".cmo") :: byt_deps,
(basename ^ ".cmx") :: opt_deps)
with Not_found ->
(byt_deps, opt_deps)
let print_dependencies target_file deps =
match deps with
[] -> ()
| _ ->
print_string target_file; print_string ": ";
let rec print_items pos = function
[] -> print_string "\n"
| dep :: rem ->
if pos + String.length dep <= 77 then begin
print_string dep; print_string " ";
print_items (pos + String.length dep + 1) rem
end else begin
print_string "\\\n "; print_string dep; print_string " ";
print_items (String.length dep + 5) rem
end in
print_items (String.length target_file + 2) deps
let file_dependencies source_file =
try
free_structure_names := StringSet.empty;
let ic = open_in source_file in
let lb = Lexing.from_channel ic in
main lb;
if Filename.check_suffix source_file ".ml" then begin
let basename = Filename.chop_suffix source_file ".ml" in
let init_deps =
if Sys.file_exists (basename ^ ".mli")
then let cmi_name = basename ^ ".cmi" in ([cmi_name], [cmi_name])
else ([], []) in
let (byt_deps, opt_deps) =
StringSet.fold find_dependency !free_structure_names init_deps in
print_dependencies (basename ^ ".cmo") byt_deps;
print_dependencies (basename ^ ".cmx") opt_deps
end else
if Filename.check_suffix source_file ".mli" then begin
let basename = Filename.chop_suffix source_file ".mli" in
let (byt_deps, opt_deps) =
StringSet.fold find_dependency !free_structure_names ([], []) in
print_dependencies (basename ^ ".cmi") byt_deps
end else
();
close_in ic
with Sys_error msg ->
()
(* Entry point *)
let _ =
Arg.parse
["-I", Arg.String(fun dir -> load_path := !load_path @ [dir]);
"-opt", Arg.Set opt_flag;
"-noopt", Arg.Clear opt_flag]
file_dependencies;
exit 0
}
|
