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
|
(* camlp4r *)
(***********************************************************************)
(* *)
(* Camlp4 *)
(* *)
(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1998 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id: compile.ml,v 2.0 1998/12/01 08:22:17 ddr Exp $ *)
value tb1 = "(* camlp4r";
value tb2 = "(* camlp4";
value te = " *)";
value eq_substr s1 i s2 =
loop i 0 where rec loop i j =
if j = String.length s2 then True
else if i = String.length s1 then False
else if s1.[i] == s2.[j] then loop (i + 1) (j + 1)
else False
;
value launch s =
do Printf.eprintf "%s\n" s;
flush stderr;
return
let r = Sys.command s in
if r <> 0 then exit 2 else ()
;
value go () =
let file = ref "" in
let args = ref "" in
do for i = 1 to Array.length Sys.argv - 1 do
if i == Array.length Sys.argv - 1 then file.val := Sys.argv.(i)
else args.val := args.val ^ Sys.argv.(i) ^ " ";
done;
return
if file.val = "" then ()
else
let comm =
match try Some (open_in file.val) with _ -> None with
[ Some ic ->
let line = input_line ic in
let r =
if eq_substr line 0 tb1
&& eq_substr line (String.length line - String.length te) te then
"../boot/camlp4r -nolib -I ../boot" ^
String.sub line (String.length tb1)
(String.length line - String.length tb1 - String.length te)
else if eq_substr line 0 tb2
&& eq_substr line (String.length line - String.length te) te then
"../boot/camlp4 -nolib -I ../boot" ^
String.sub line (String.length tb2)
(String.length line - String.length tb2 - String.length te)
else ""
in
do close_in ic; return r
| None -> "" ]
in
if comm = "" then
launch (args.val ^ file.val)
else
(* Unix version
launch (args.val ^ "-pp \"" ^ comm ^ "\" " ^ file.val)
*)
(* Unix or Windows version *)
let (file_o, file_t) =
if Filename.check_suffix file.val ".mli" then
(Filename.chop_suffix file.val ".mli" ^ ".ppi", "-intf ")
else if Filename.check_suffix file.val ".ml" then
(Filename.chop_suffix file.val ".ml" ^ ".ppo", "-impl ")
else failwith ("Don't know what to do with " ^ file.val)
in
do launch (comm ^ " -o " ^ file_o ^ " " ^ file.val);
launch (args.val ^ file_t ^ file_o);
Sys.remove file_o;
return ()
(**)
;
Printexc.catch go ();
|
