Mercurial > urweb

comparison src/compiler.sml @ 767:d27ed5ddeb52

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add 'library' directive
author Adam Chlipala <adamc@hcoop.net>
date Sat, 02 May 2009 12:50:52 -0400
parents df09c95085f8
children 3b7e46790fa7
comparison
equal deleted inserted replaced
766:df09c95085f8 767:d27ed5ddeb52
262 val (s, _) = Substring.splitr Char.isSpace s 262 val (s, _) = Substring.splitr Char.isSpace s
263 in 263 in
264 s 264 s
265 end 265 end
266 266
267 fun parseUrp' filename =
268 let
269 val dir = OS.Path.dir filename
270 val inf = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
271
272 fun relify fname =
273 OS.Path.concat (dir, fname)
274 handle OS.Path.Path => fname
275
276 val absDir = OS.Path.mkAbsolute {path = dir, relativeTo = OS.FileSys.getDir ()}
277
278 fun relifyA fname = OS.Path.mkAbsolute {path = fname, relativeTo = absDir}
279
280 fun readSources acc =
281 case TextIO.inputLine inf of
282 NONE => rev acc
283 | SOME line =>
284 let
285 val acc = if CharVector.all Char.isSpace line then
286 acc
287 else
288 let
289 val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
290 (String.explode line))
291 val fname = relify fname
292 in
293 fname :: acc
294 end
295 in
296 readSources acc
297 end
298
299 val prefix = ref NONE
300 val database = ref NONE
301 val exe = ref NONE
302 val sql = ref NONE
303 val debug = ref false
304 val profile = ref false
305 val timeout = ref NONE
306 val ffi = ref []
307 val link = ref []
308 val headers = ref []
309 val scripts = ref []
310 val clientToServer = ref []
311 val effectful = ref []
312 val clientOnly = ref []
313 val serverOnly = ref []
314 val jsFuncs = ref []
315 val libs = ref []
316
317 fun finish sources =
318 let
319 val job = {
320 prefix = Option.getOpt (!prefix, "/"),
321 database = !database,
322 exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
323 ext = SOME "exe"}),
324 sql = !sql,
325 debug = !debug,
326 profile = !profile,
327 timeout = Option.getOpt (!timeout, 60),
328 ffi = rev (!ffi),
329 link = rev (!link),
330 headers = rev (!headers),
331 scripts = rev (!scripts),
332 clientToServer = rev (!clientToServer),
333 effectful = rev (!effectful),
334 clientOnly = rev (!clientOnly),
335 serverOnly = rev (!serverOnly),
336 jsFuncs = rev (!jsFuncs),
337 sources = sources
338 }
339
340 fun mergeO f (old, new) =
341 case (old, new) of
342 (NONE, _) => new
343 | (_, NONE) => old
344 | (SOME v1, SOME v2) => SOME (f (v1, v2))
345
346 fun same desc = mergeO (fn (x : string, y) =>
347 (if x = y then
348 ()
349 else
350 ErrorMsg.error ("Multiple "
351 ^ desc ^ " values that don't agree");
352 x))
353
354 fun merge (old : job, new : job) = {
355 prefix = #prefix old,
356 database = #database old,
357 exe = #exe old,
358 sql = #sql old,
359 debug = #debug old orelse #debug new,
360 profile = #profile old orelse #profile new,
361 timeout = #timeout old,
362 ffi = #ffi old @ #ffi new,
363 link = #link old @ #link new,
364 headers = #headers old @ #headers new,
365 scripts = #scripts old @ #scripts new,
366 clientToServer = #clientToServer old @ #clientToServer new,
367 effectful = #effectful old @ #effectful new,
368 clientOnly = #clientOnly old @ #clientOnly new,
369 serverOnly = #serverOnly old @ #serverOnly new,
370 jsFuncs = #jsFuncs old @ #jsFuncs new,
371 sources = #sources old @ #sources new
372 }
373 in
374 foldr (fn (fname, job) => merge (job, parseUrp' fname)) job (!libs)
375 end
376
377 fun read () =
378 case TextIO.inputLine inf of
379 NONE => finish []
380 | SOME "\n" => finish (readSources [])
381 | SOME line =>
382 let
383 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
384 val cmd = Substring.string (trim cmd)
385 val arg = Substring.string (trim arg)
386
387 fun ffiS () =
388 case String.fields (fn ch => ch = #".") arg of
389 [m, x] => (m, x)
390 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func");
391 ("", ""))
392
393 fun ffiM () =
394 case String.fields (fn ch => ch = #"=") arg of
395 [f, s] =>
396 (case String.fields (fn ch => ch = #".") f of
397 [m, x] => ((m, x), s)
398 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
399 (("", ""), "")))
400 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
401 (("", ""), ""))
402 in
403 case cmd of
404 "prefix" =>
405 (case !prefix of
406 NONE => ()
407 | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
408 prefix := SOME arg)
409 | "database" =>
410 (case !database of
411 NONE => ()
412 | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
413 database := SOME arg)
414 | "exe" =>
415 (case !exe of
416 NONE => ()
417 | SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
418 exe := SOME (relify arg))
419 | "sql" =>
420 (case !sql of
421 NONE => ()
422 | SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
423 sql := SOME (relify arg))
424 | "debug" => debug := true
425 | "profile" => profile := true
426 | "timeout" =>
427 (case !timeout of
428 NONE => ()
429 | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
430 timeout := SOME (valOf (Int.fromString arg)))
431 | "ffi" => ffi := relify arg :: !ffi
432 | "link" => link := relifyA arg :: !link
433 | "include" => headers := relifyA arg :: !headers
434 | "script" => scripts := arg :: !scripts
435 | "clientToServer" => clientToServer := ffiS () :: !clientToServer
436 | "effectful" => effectful := ffiS () :: !effectful
437 | "clientOnly" => clientOnly := ffiS () :: !clientOnly
438 | "serverOnly" => serverOnly := ffiS () :: !serverOnly
439 | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
440 | "library" => libs := relify arg :: !libs
441 | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
442 read ()
443 end
444
445 val job = read ()
446 in
447 TextIO.closeIn inf;
448 Settings.setUrlPrefix (#prefix job);
449 Settings.setTimeout (#timeout job);
450 Settings.setHeaders (#headers job);
451 Settings.setScripts (#scripts job);
452 Settings.setClientToServer (#clientToServer job);
453 Settings.setEffectful (#effectful job);
454 Settings.setClientOnly (#clientOnly job);
455 Settings.setServerOnly (#serverOnly job);
456 Settings.setJsFuncs (#jsFuncs job);
457 job
458 end
459
267 val parseUrp = { 460 val parseUrp = {
268 func = fn filename => 461 func = parseUrp',
269 let
270 val dir = OS.Path.dir filename
271 val inf = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
272
273 fun relify fname =
274 OS.Path.concat (dir, fname)
275 handle OS.Path.Path => fname
276
277 val absDir = OS.Path.mkAbsolute {path = dir, relativeTo = OS.FileSys.getDir ()}
278
279 fun relifyA fname = OS.Path.mkAbsolute {path = fname, relativeTo = absDir}
280
281 fun readSources acc =
282 case TextIO.inputLine inf of
283 NONE => rev acc
284 | SOME line =>
285 let
286 val acc = if CharVector.all Char.isSpace line then
287 acc
288 else
289 let
290 val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
291 (String.explode line))
292 val fname = relify fname
293 in
294 fname :: acc
295 end
296 in
297 readSources acc
298 end
299
300 val prefix = ref NONE
301 val database = ref NONE
302 val exe = ref NONE
303 val sql = ref NONE
304 val debug = ref false
305 val profile = ref false
306 val timeout = ref NONE
307 val ffi = ref []
308 val link = ref []
309 val headers = ref []
310 val scripts = ref []
311 val clientToServer = ref []
312 val effectful = ref []
313 val clientOnly = ref []
314 val serverOnly = ref []
315 val jsFuncs = ref []
316
317 fun finish sources =
318 {prefix = Option.getOpt (!prefix, "/"),
319 database = !database,
320 exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
321 ext = SOME "exe"}),
322 sql = !sql,
323 debug = !debug,
324 profile = !profile,
325 timeout = Option.getOpt (!timeout, 60),
326 ffi = rev (!ffi),
327 link = rev (!link),
328 headers = rev (!headers),
329 scripts = rev (!scripts),
330 clientToServer = rev (!clientToServer),
331 effectful = rev (!effectful),
332 clientOnly = rev (!clientOnly),
333 serverOnly = rev (!serverOnly),
334 jsFuncs = rev (!jsFuncs),
335 sources = sources}
336
337 fun read () =
338 case TextIO.inputLine inf of
339 NONE => finish []
340 | SOME "\n" => finish (readSources [])
341 | SOME line =>
342 let
343 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
344 val cmd = Substring.string (trim cmd)
345 val arg = Substring.string (trim arg)
346
347 fun ffiS () =
348 case String.fields (fn ch => ch = #".") arg of
349 [m, x] => (m, x)
350 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func");
351 ("", ""))
352
353 fun ffiM () =
354 case String.fields (fn ch => ch = #"=") arg of
355 [f, s] =>
356 (case String.fields (fn ch => ch = #".") f of
357 [m, x] => ((m, x), s)
358 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
359 (("", ""), "")))
360 | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
361 (("", ""), ""))
362 in
363 case cmd of
364 "prefix" =>
365 (case !prefix of
366 NONE => ()
367 | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
368 prefix := SOME arg)
369 | "database" =>
370 (case !database of
371 NONE => ()
372 | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
373 database := SOME arg)
374 | "exe" =>
375 (case !exe of
376 NONE => ()
377 | SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
378 exe := SOME (relify arg))
379 | "sql" =>
380 (case !sql of
381 NONE => ()
382 | SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
383 sql := SOME (relify arg))
384 | "debug" => debug := true
385 | "profile" => profile := true
386 | "timeout" =>
387 (case !timeout of
388 NONE => ()
389 | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
390 timeout := SOME (valOf (Int.fromString arg)))
391 | "ffi" => ffi := relify arg :: !ffi
392 | "link" => link := relifyA arg :: !link
393 | "include" => headers := relifyA arg :: !headers
394 | "script" => scripts := arg :: !scripts
395 | "clientToServer" => clientToServer := ffiS () :: !clientToServer
396 | "effectful" => effectful := ffiS () :: !effectful
397 | "clientOnly" => clientOnly := ffiS () :: !clientOnly
398 | "serverOnly" => serverOnly := ffiS () :: !serverOnly
399 | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
400 | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
401 read ()
402 end
403
404 val job = read ()
405 in
406 TextIO.closeIn inf;
407 Settings.setUrlPrefix (#prefix job);
408 Settings.setTimeout (#timeout job);
409 Settings.setHeaders (#headers job);
410 Settings.setScripts (#scripts job);
411 Settings.setClientToServer (#clientToServer job);
412 Settings.setEffectful (#effectful job);
413 Settings.setClientOnly (#clientOnly job);
414 Settings.setServerOnly (#serverOnly job);
415 Settings.setJsFuncs (#jsFuncs job);
416 job
417 end,
418 print = p_job 462 print = p_job
419 } 463 }
420 464
421 val toParseJob = transform parseUrp "parseJob" 465 val toParseJob = transform parseUrp "parseJob"
422 466