Mercurial > urweb

comparison src/compiler.sml @ 673:a8effb6159c2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Variable timeouts and client keep-alive
author Adam Chlipala <adamc@hcoop.net>
date Tue, 24 Mar 2009 15:35:46 -0400
parents aa2290c32ce2
children 54ec237a3028
comparison
equal deleted inserted replaced
672:df6eb58de040 673:a8effb6159c2
40 database : string option, 40 database : string option,
41 sources : string list, 41 sources : string list,
42 exe : string, 42 exe : string,
43 sql : string option, 43 sql : string option,
44 debug : bool, 44 debug : bool,
45 profile : bool 45 profile : bool,
46 timeout : int
46 } 47 }
47 48
48 type ('src, 'dst) phase = { 49 type ('src, 'dst) phase = {
49 func : 'src -> 'dst, 50 func : 'src -> 'dst,
50 print : 'dst -> Print.PD.pp_desc 51 print : 'dst -> Print.PD.pp_desc
198 | _ => absyn 199 | _ => absyn
199 end 200 end
200 handle LrParser.ParseError => [], 201 handle LrParser.ParseError => [],
201 print = SourcePrint.p_file} 202 print = SourcePrint.p_file}
202 203
203 fun p_job {prefix, database, exe, sql, sources, debug, profile} = 204 fun p_job {prefix, database, exe, sql, sources, debug, profile, timeout} =
204 let 205 let
205 open Print.PD 206 open Print.PD
206 open Print 207 open Print
207 in 208 in
208 box [if debug then 209 box [if debug then
221 string exe, 222 string exe,
222 newline, 223 newline,
223 case sql of 224 case sql of
224 NONE => string "No SQL file." 225 NONE => string "No SQL file."
225 | SOME sql => string ("SQL fle: " ^ sql), 226 | SOME sql => string ("SQL fle: " ^ sql),
227 newline,
228 string "Timeout: ",
229 string (Int.toString timeout),
230 newline,
226 string "Sources:", 231 string "Sources:",
227 p_list string sources, 232 p_list string sources,
228 newline] 233 newline]
229 end 234 end
230 235
263 end 268 end
264 in 269 in
265 readSources acc 270 readSources acc
266 end 271 end
267 272
268 fun finish (prefix, database, exe, sql, debug, profile, sources) = 273 fun finish (prefix, database, exe, sql, debug, profile, timeout, sources) =
269 {prefix = Option.getOpt (prefix, "/"), 274 {prefix = Option.getOpt (prefix, "/"),
270 database = database, 275 database = database,
271 exe = Option.getOpt (exe, OS.Path.joinBaseExt {base = OS.Path.base filename, 276 exe = Option.getOpt (exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
272 ext = SOME "exe"}), 277 ext = SOME "exe"}),
273 sql = sql, 278 sql = sql,
274 debug = debug, 279 debug = debug,
275 profile = profile, 280 profile = profile,
281 timeout = Option.getOpt (timeout, 60),
276 sources = sources} 282 sources = sources}
277 283
278 fun read (prefix, database, exe, sql, debug, profile) = 284 fun read (prefix, database, exe, sql, debug, profile, timeout) =
279 case TextIO.inputLine inf of 285 case TextIO.inputLine inf of
280 NONE => finish (prefix, database, exe, sql, debug, profile, []) 286 NONE => finish (prefix, database, exe, sql, debug, profile, timeout, [])
281 | SOME "\n" => finish (prefix, database, exe, sql, debug, profile, readSources []) 287 | SOME "\n" => finish (prefix, database, exe, sql, debug, profile, timeout, readSources [])
282 | SOME line => 288 | SOME line =>
283 let 289 let
284 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line) 290 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
285 val cmd = Substring.string (trim cmd) 291 val cmd = Substring.string (trim cmd)
286 val arg = Substring.string (trim arg) 292 val arg = Substring.string (trim arg)
288 case cmd of 294 case cmd of
289 "prefix" => 295 "prefix" =>
290 (case prefix of 296 (case prefix of
291 NONE => () 297 NONE => ()
292 | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive"; 298 | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
293 read (SOME arg, database, exe, sql, debug, profile)) 299 read (SOME arg, database, exe, sql, debug, profile, timeout))
294 | "database" => 300 | "database" =>
295 (case database of 301 (case database of
296 NONE => () 302 NONE => ()
297 | SOME _ => ErrorMsg.error "Duplicate 'database' directive"; 303 | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
298 read (prefix, SOME arg, exe, sql, debug, profile)) 304 read (prefix, SOME arg, exe, sql, debug, profile, timeout))
299 | "exe" => 305 | "exe" =>
300 (case exe of 306 (case exe of
301 NONE => () 307 NONE => ()
302 | SOME _ => ErrorMsg.error "Duplicate 'exe' directive"; 308 | SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
303 read (prefix, database, SOME (relify arg), sql, debug, profile)) 309 read (prefix, database, SOME (relify arg), sql, debug, profile, timeout))
304 | "sql" => 310 | "sql" =>
305 (case sql of 311 (case sql of
306 NONE => () 312 NONE => ()
307 | SOME _ => ErrorMsg.error "Duplicate 'sql' directive"; 313 | SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
308 read (prefix, database, exe, SOME (relify arg), debug, profile)) 314 read (prefix, database, exe, SOME (relify arg), debug, profile, timeout))
309 | "debug" => read (prefix, database, exe, sql, true, profile) 315 | "debug" => read (prefix, database, exe, sql, true, profile, timeout)
310 | "profile" => read (prefix, database, exe, sql, debug, true) 316 | "profile" => read (prefix, database, exe, sql, debug, true, timeout)
317 | "timeout" =>
318 (case timeout of
319 NONE => ()
320 | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
321 read (prefix, database, exe, sql, debug, profile, SOME (valOf (Int.fromString arg))))
311 | _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); 322 | _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
312 read (prefix, database, exe, sql, debug, profile)) 323 read (prefix, database, exe, sql, debug, profile, timeout))
313 end 324 end
314 325
315 val job = read (NONE, NONE, NONE, NONE, false, false) 326 val job = read (NONE, NONE, NONE, NONE, false, false, NONE)
316 in 327 in
317 TextIO.closeIn inf; 328 TextIO.closeIn inf;
318 Monoize.urlPrefix := #prefix job; 329 Monoize.urlPrefix := #prefix job;
330 CjrPrint.timeout := #timeout job;
319 job 331 job
320 end, 332 end,
321 print = p_job 333 print = p_job
322 } 334 }
323 335
596 if not (OS.Process.isSuccess (OS.Process.system compile)) then 608 if not (OS.Process.isSuccess (OS.Process.system compile)) then
597 print "C compilation failed\n" 609 print "C compilation failed\n"
598 else if not (OS.Process.isSuccess (OS.Process.system link)) then 610 else if not (OS.Process.isSuccess (OS.Process.system link)) then
599 print "C linking failed\n" 611 print "C linking failed\n"
600 else 612 else
601 print "Success\n" 613 ()
602 end 614 end
603 615
604 fun compile job = 616 fun compile job =
605 case run toPrepare job of 617 case run toPrepare job of
606 NONE => print "Ur compilation failed\n" 618 NONE => print "Ur compilation failed\n"