4 let gen dest_filename =
6 let basename = Filename.basename dest_filename in
7 let directory = Filename.dirname dest_filename in
8 let dirname = Filename.basename directory in
9 let up_directory = Filename.dirname directory in
10 let templates = Filename.concat up_directory "template" in
11 let template, keyword =
12 let keyword = ref "" in
13 let template = ref "" in
15 let len = String.length basename in
16 for i = 0 to len - 1 do
17 match basename.[i] with
19 template := "template" ^ (String.sub basename i (len-i));
20 keyword := String.sub basename 0 i;
21 !keyword.[0] <- Char.uppercase !keyword.[0];
26 with Exit -> !template, !keyword
30 prerr_endline (Printf.sprintf "FILE [%s]" dest_filename);
31 prerr_endline (Printf.sprintf "Replace [%s] by [%s]" "Template" keyword);
34 let ts = "Template" in
35 let ts_len = String.length ts in
37 let full_template = Filename.concat templates template in
38 let ic = open_in full_template in
39 let oc = open_out dest_filename in
42 let line = input_line ic in
44 let buf = Buffer.create 100 in
45 let len = String.length line in
46 (* Printf.printf "LINE [%d]" len; print_newline (); *)
49 (* Printf.printf "[%d]" i; print_newline (); *)
50 if i <= len - ts_len then
51 if line.[i] = 'T' && String.sub line i ts_len = ts then begin
52 Buffer.add_string buf keyword;
55 Buffer.add_char buf line.[i];
59 Buffer.add_string buf (String.sub line i (len-i))
62 output_string oc (Buffer.contents buf);
64 output_string oc line;
69 Printf.fprintf oc "(*\n\n WARNING: this file is automatically generated from: \n\t%s\n\n*)\n\n" full_template;
70 Printf.fprintf oc "# 1 \"%s\"\n" full_template;
77 let depend dest_filename =
78 if Sys.file_exists dest_filename then begin
79 let dest_filename = String.sub dest_filename 0 (String.length dest_filename - 1) in
80 let basename = Filename.basename dest_filename in
81 let directory = Filename.dirname dest_filename in
82 let dirname = Filename.basename directory in
83 let up_directory = Filename.dirname directory in
84 let templates = Filename.concat up_directory "template" in
85 let template, keyword =
86 let keyword = ref "" in
87 let template = ref "" in
89 let len = String.length basename in
90 for i = 0 to len - 1 do
91 match basename.[i] with
93 template := "template" ^ (String.sub basename i (len-i));
94 keyword := String.sub basename 0 i;
95 !keyword.[0] <- Char.uppercase !keyword.[0];
100 with Exit -> !template, !keyword
102 let full_template = Filename.concat templates template in
104 Printf.printf "%s: %s\n" dest_filename full_template
109 Include of string * (Str.regexp * string) list
110 | Line of int * string
111 | Regexps of (Str.regexp * string) list
120 regexps : (Str.regexp * string) list;
121 defines : string list;
125 let new_env = { regexps = []; defines = []; ifs = [] }
128 let lexer = make_lexer [
129 "include"; "where"; "and" ;
131 "ifdef"; "else"; "endif";
134 let rec parse_line = parser
135 [< 'Kwd "#"; key = parse_key >] -> key
137 and parse_key = parser
138 [< 'Kwd "include"; 'String filename; regexps = parse_where >] ->
139 Include (filename, regexps)
140 | [< 'Int line; 'String filename >] ->
141 Line (line, filename)
142 | [< 'Kwd "where"; 'String reg; 'Kwd "="; 'String templ;
143 regexps = parse_where >] ->
144 Regexps ( (Str.regexp reg, templ) :: regexps)
146 and parse_where = parser
147 [< 'Kwd "where"; 'String reg; 'Kwd "="; 'String templ;
148 regexps = parse_where >] ->
149 (Str.regexp reg, templ) :: regexps
150 | [< 'Kwd "and"; 'String reg; 'Kwd "="; 'String templ;
151 regexps = parse_where >] ->
152 (Str.regexp reg, templ) :: regexps
155 let rec preprocess filename env =
156 let ic = open_in filename in
158 let line_warning line =
159 Printf.fprintf stdout "(*\n\n WARNING: this file is automatically generated from: \n\t%s\n\n*)\n\n" filename;
160 Printf.fprintf stdout "# %d \"%s\"\n" (line+1) filename;
163 let rec iter_line i env =
164 let line = input_line ic in
166 let line = iter_regexps line env.regexps in
168 let len = String.length line in
170 if len > 1 && line.[0] = '#' then begin
172 let s = Stream.of_string line in
174 match parse_line (lexer s) with
175 Include (filename, regexps2) ->
177 { env with regexps = regexps2 @ env.regexps };
180 | Line (line, filename) ->
181 Printf.fprintf stdout "# %d \"%s\"\n" line filename;
183 | Regexps regexps2 ->
185 { env with regexps = regexps2 @ env.regexps }
188 Printf.fprintf stderr "Line [%s]:\n"
189 (String.escaped line);
190 Printf.fprintf stderr "Error %s in \"%s\" line %d (%d)\n"
191 (Printexc.to_string e) filename i (Stream.count s + 1);
195 output_string stdout line;
196 output_char stdout '\n';
202 and iter_regexps line regexps =
205 | (reg, templ) :: regexps ->
206 (* Printf.fprintf stderr "Checking replacement for %s\n" templ; *)
207 let line = Str.global_replace reg templ line in
208 iter_regexps line regexps
216 let pp filename = preprocess filename new_env
218 let add_depend filedep filename depends =
219 if not (List.mem filename !depends) then begin
220 Printf.fprintf stdout "%s: %s\n" filedep filename;
221 depends := filename :: !depends
224 let rec dep filedep filename env depends =
225 let ic = open_in filename in
227 let rec iter_line i env =
228 let line = input_line ic in
230 let line = iter_regexps line env.regexps in
232 let len = String.length line in
234 if len > 1 && line.[0] = '#' then begin
235 let s = Stream.of_string line in
237 match parse_line (lexer s) with
238 Include (filename, regexps2) ->
239 add_depend filedep filename depends;
241 { env with regexps = regexps2 @ env.regexps } depends;
243 | Line (line, filename) ->
244 add_depend filedep filename depends;
246 | Regexps regexps2 ->
247 { env with regexps = regexps2 @ env.regexps }
250 Printf.fprintf stderr "Line [%s]:\n"
251 (String.escaped line);
252 Printf.fprintf stderr "Error \"%s\" line %d (%d)\n"
253 filename i (Stream.count s + 1);
260 and iter_regexps line regexps =
263 | (reg, templ) :: regexps ->
264 let line = Str.global_replace reg templ line in
265 iter_regexps line regexps
268 ignore (iter_line 0 env)
272 let depend filename =
273 if Sys.file_exists filename then
274 if Filename.check_suffix filename ".mlt" then
275 let filedep = (Filename.chop_suffix filename ".mlt") ^ ".ml" in
276 dep filedep filename new_env (ref [])
278 Printf.fprintf stderr "Don't know what to do with %s\n" filename;
285 (* "-gen", Arg.String gen, " <filename> : generate filename"; *)
286 "-pp", Arg.String pp, " <filename> : preprocess filename";