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
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
|
(* $Id$ *)
(* Ici, on trie la ligne de commande pour en extraire les options spécifiques
à coqmktop, puis on appelle "ocamlc" (ou "ocamlopt")
avec les autres options et la liste des fichiers à linker.
On essaye au maximum d'utiliser les modules Sys et Filename pour que la
portabilité soit maximale. *)
open Unix
(* Objects to link *)
(* 1. Core objects *)
let ocamlobjs = ["unix.cma"]
let dynobjs = ["dynlink.cma"]
let camlp4objs = ["gramlib.cma"]
let configobjs = ["coq_config.cmo"]
let libobjs = ocamlobjs @ camlp4objs @ configobjs
let spaces = Str.regexp "[ \t\n]+"
let split_cmo l = Str.split spaces l
let lib = split_cmo Tolink.lib
let kernel = split_cmo Tolink.kernel
let library = split_cmo Tolink.library
let pretyping = split_cmo Tolink.pretyping
let parsing = split_cmo Tolink.parsing
let proofs = split_cmo Tolink.proofs
let tactics = split_cmo Tolink.tactics
let toplevel = split_cmo Tolink.toplevel
let core_objs =
libobjs @ lib @ kernel @ library @ pretyping @ parsing @
proofs @ tactics
(* 3. Files only in coqsearchisos (if option -searchisos is used) *)
let coqsearch = ["version_searchisos.cmo"; "cmd_searchisos_line.cmo"]
(* 4. Toplevel objects *)
let camlp4objs =
["camlp4_top.cma"; "pa_o.cmo"; "pa_op.cmo"; "pa_extend.cmo";
"q_coqast.cmo" ]
let topobjs = camlp4objs
let gramobjs = ["g_zsyntax.cmo"; "g_natsyntax.cmo"]
let notopobjs = gramobjs
(* 5. High-level tactics objects *)
let hightactics = (split_cmo Tolink.hightactics) @ (split_cmo Tolink.contrib)
(* environment *)
let src_coqtop = ref Coq_config.coqtop
let opt = ref false
let full = ref false
let top = ref false
let searchisos = ref false
let echo = ref false
let includes () =
List.fold_right
(fun d l -> "-I" :: List.fold_left Filename.concat !src_coqtop d :: l)
[ [ "config" ] ;
[ "scripts" ] ;
[ "lib" ] ;
[ "kernel" ] ;
[ "library" ] ;
[ "pretyping" ] ;
[ "parsing" ] ;
[ "proofs" ] ;
[ "tactics" ] ;
[ "toplevel" ]
]
["-I"; Coq_config.camlp4lib]
(* Transform bytecode object file names in native object file names *)
let native_suffix f =
if Filename.check_suffix f ".cmo" then
(Filename.chop_suffix f ".cmo") ^ ".cmx"
else if Filename.check_suffix f ".cma" then
(Filename.chop_suffix f ".cma") ^ ".cmxa"
else
failwith ("File "^f^" has not extension .cmo or .cma")
(* Transforms a file name in the corresponding Caml module name. *)
let rem_ext_regexpr = Str.regexp "\(.*\)\.\(cm..?\|ml\)"
let module_of_file name =
let s = Str.replace_first rem_ext_regexpr "\1" (Filename.basename name) in
String.capitalize s
(* Build the list of files to link and the list of modules names *)
let files_to_link userfiles =
let dyn_objs = if not !opt then dynobjs else [] in
let command_objs = if !searchisos then coqsearch else [] in
let toplevel_objs = if !top then topobjs else if !opt then notopobjs else []
in
let objs = core_objs @ dyn_objs @ toplevel @ command_objs @ hightactics @
toplevel_objs in
let tolink =
if !opt then
(List.map native_suffix objs) @ userfiles
else
objs @ userfiles
in
let modules = List.map module_of_file tolink in
(modules, tolink)
(*Gives the list of all the directories under dir*)
(*Uses Unix, sorry... But you can try to do the same thing without it.*)
let all_subdirs dir =
let l = ref [] in
let add f = l := f :: !l in
let rec traverse dir =
Printf.printf "%s\n" dir;
let dirh =
try opendir dir with Unix_error _ -> invalid_arg "all_subdirs"
in
try
while true do
let f = readdir dirh in
if f <> "." && f <> ".." then
let file = Filename.concat dir f in
if (stat file).st_kind = S_DIR then begin
add file;
traverse file
end
done
with End_of_file ->
closedir dirh
in
traverse dir; List.rev !l
(* usage *)
let usage () =
prerr_endline "Usage: coqmktop <options> <ocaml options> files
Options are:
-srcdir dir Specify where the Coq source files are
-o exec-file Specify the name of the resulting toplevel
-opt Compile in native code
-full Link high level tactics
-top Build Coq on a ocaml toplevel (incompatible with -opt)
-searchisos Build a toplevel for SearchIsos
-R dir Specify recursively directories for Ocaml\n";
exit 1
(* parsing of the command line *)
let parse_args () =
let rec parse (op,fl) = function
| [] -> List.rev op, List.rev fl
| "-srcdir" :: d :: rem -> src_coqtop := d ; parse (op,fl) rem
| "-srcdir" :: _ -> usage ()
| "-opt" :: rem -> opt := true ; parse (op,fl) rem
| "-full" :: rem -> full := true ; parse (op,fl) rem
| "-top" :: rem -> top := true ; parse (op,fl) rem
| "-searchisos" :: rem ->
searchisos := true; parse (op,fl) rem
| "-echo" :: rem -> echo := true ; parse (op,fl) rem
| ("-cclib"|"-ccopt"|"-I"|"-o" as o) :: rem' ->
begin
match rem' with
| a :: rem -> parse (a::o::op,fl) rem
| [] -> usage ()
end
| "-R" :: rem' ->
begin
match rem' with
| a :: rem ->
parse ((List.rev(List.flatten (List.map (fun d -> ["-I";d])
(all_subdirs a))))@op,fl) rem
| [] -> usage ()
end
| ("-compact"|"-g"|"-p" as o) :: rem -> parse (o::op,fl) rem
| ("-h"|"--help") :: _ -> usage ()
| f :: rem ->
if Filename.check_suffix f ".ml"
or Filename.check_suffix f ".cmx"
or Filename.check_suffix f ".cmo"
or Filename.check_suffix f ".cmxa"
or Filename.check_suffix f ".cma" then
parse (op,f::fl) rem
else begin
prerr_endline ("Don't know what to do with " ^ f);
exit 1
end
in
parse ([Coq_config.osdeplibs],[]) (List.tl (Array.to_list Sys.argv))
let clean file =
let rm f = if Sys.file_exists f then Sys.remove f in
let basename = Filename.chop_suffix file ".ml" in
if not !echo then begin
rm file;
rm (basename ^ ".o");
rm (basename ^ ".cmi");
rm (basename ^ ".cmo");
rm (basename ^ ".cmx")
end
(*Gives all modules in dir. Uses .cmi. Unix again sorry again*)
let all_modules_in_dir dir =
try
let lst = ref []
and stg = ref ""
and dh = Unix.opendir dir in
try
while true do
let stg = Unix.readdir dh in
if (Filename.check_suffix stg ".cmi") then
lst := !lst @ [String.capitalize (Filename.chop_suffix stg ".cmi")]
done;
[]
with End_of_file ->
Unix.closedir dh; !lst
with Unix.Unix_error (_,"opendir",_) ->
failwith ("all_modules_in_dir: directory "^dir^" not found")
(*Gives a part of command line (corresponding to dir) for extract_crc*)
let crc_cmd dir =
" -I "^dir^(List.fold_right (fun x y -> " "^x^y) (all_modules_in_dir dir)
"")
(*Same as crc_cmd but recursively*)
let rec_crc_cmd dir =
List.fold_right (fun x y -> x^y) (List.map crc_cmd (all_subdirs dir)) ""
(*Creates another temporary file for Dynlink if needed*)
let tmp_dynlink()=
let tmp = Filename.temp_file "coqdynlink" ".ml" in
let _ = Sys.command ("echo \"Dynlink.init();;\" > "^tmp) in
let _ = Sys.command (Coq_config.camllib^"/extract_crc"^(crc_cmd
Coq_config.camllib)^(crc_cmd Coq_config.camlp4lib)^(rec_crc_cmd
(Coq_config.coqtop^"/src"))^" >> "^tmp) in
let _ = Sys.command ("echo \";;\" >> "^tmp) in
let _ =
Sys.command ("echo \"Dynlink.add_available_units crc_unit_list;;\" >> "^
tmp)
in
tmp
(*Initializes the kind of loading in the main program*)
let declare_loading_string () =
if !opt then
"Mltop.set Mltop.Native;;\n"
else if not !top then
"Mltop.set Mltop.WithoutTop;;\n"
else
"let ppf = Format.std_formatter;;
Mltop.set (Mltop.WithTop {Mltop.load_obj=Topdirs.dir_load ppf;
Mltop.use_file=Topdirs.dir_use ppf;
Mltop.add_dir=Topdirs.dir_directory});;\n"
(* create a temporary main file to link *)
let create_tmp_main_file modules =
let main_name = Filename.temp_file "coqmain" ".ml" in
let oc = open_out main_name in
try
(* Add the pre-linked modules *)
output_string oc "List.iter Mltop.add_known_module [\"";
output_string oc (String.concat "\";\"" modules);
output_string oc "\"];;\n";
(*Initializes the kind of loading*)
output_string oc (declare_loading_string());
(* Start the right toplevel loop: Coq or Coq_searchisos *)
if !searchisos then
output_string oc "Cmd_searchisos_line.start();;\n"
else
output_string oc "Coqtop.start();;\n";
(* Start the Ocaml toplevel if it exists *)
if !top then
output_string oc "Printexc.catch Toploop.loop ppf; exit 1;;\n";
close_out oc;
main_name
with e ->
clean main_name; raise e
(* main part *)
let main () =
let (options, userfiles) = parse_args () in
(* which ocaml command to invoke *)
let prog =
if !opt then begin
(* native code *)
if !top then failwith "no custom toplevel in native code !";
"ocamlopt -linkall"
end else
(* bytecode *)
if !top then "ocamlmktop -custom -linkall" else "ocamlc -custom -linkall"
in
(* files to link *)
let (modules, tolink) = files_to_link userfiles in
(*file for dynlink *)
let dynlink=
if not (!opt || !top) then
[tmp_dynlink()]
else
[]
in
(* the list of the loaded modules *)
let main_file = create_tmp_main_file modules in
try
let args = (includes ()) @ options @ tolink @ dynlink @ [ main_file ] in
(* Now, with the .cma, we MUST use the -linkall option *)
let command = String.concat " " ((prog^" -linkall")::args) in
if !echo then begin print_endline command; flush Pervasives.stdout end;
let retcode = Sys.command command in
clean main_file;
(* command gives the exit code in HSB, and signal in LSB !!! *)
if retcode > 255 then retcode lsr 8 else retcode
with e ->
clean main_file; raise e
let retcode =
try Printexc.print main () with _ -> 1
let _ = exit retcode
|