Mercurial > urweb

comparison src/compiler.sml @ 1294:b4480a56cab7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Server-side 'onError'
author Adam Chlipala <adam@chlipala.net>
date Tue, 07 Sep 2010 08:28:07 -0400
parents 5b5c0b552f59
children 0d3d9e653829
comparison
equal deleted inserted replaced
1293:acabf3935060 1294:b4480a56cab7
56 filterUrl : Settings.rule list, 56 filterUrl : Settings.rule list,
57 filterMime : Settings.rule list, 57 filterMime : Settings.rule list,
58 protocol : string option, 58 protocol : string option,
59 dbms : string option, 59 dbms : string option,
60 sigFile : string option, 60 sigFile : string option,
61 safeGets : string list 61 safeGets : string list,
62 onError : (string * string list * string) option
62 } 63 }
63 64
64 type ('src, 'dst) phase = { 65 type ('src, 'dst) phase = {
65 func : 'src -> 'dst, 66 func : 'src -> 'dst,
66 print : 'dst -> Print.PD.pp_desc 67 print : 'dst -> Print.PD.pp_desc
394 val libs = ref [] 395 val libs = ref []
395 val protocol = ref NONE 396 val protocol = ref NONE
396 val dbms = ref NONE 397 val dbms = ref NONE
397 val sigFile = ref (Settings.getSigFile ()) 398 val sigFile = ref (Settings.getSigFile ())
398 val safeGets = ref [] 399 val safeGets = ref []
400 val onError = ref NONE
399 401
400 fun finish sources = 402 fun finish sources =
401 let 403 let
402 val job = { 404 val job = {
403 prefix = Option.getOpt (!prefix, "/"), 405 prefix = Option.getOpt (!prefix, "/"),
423 filterMime = rev (!mime), 425 filterMime = rev (!mime),
424 sources = sources, 426 sources = sources,
425 protocol = !protocol, 427 protocol = !protocol,
426 dbms = !dbms, 428 dbms = !dbms,
427 sigFile = !sigFile, 429 sigFile = !sigFile,
428 safeGets = rev (!safeGets) 430 safeGets = rev (!safeGets),
431 onError = !onError
429 } 432 }
430 433
431 fun mergeO f (old, new) = 434 fun mergeO f (old, new) =
432 case (old, new) of 435 case (old, new) of
433 (NONE, _) => new 436 (NONE, _) => new
467 @ List.filter (fn s => List.all (fn s' => s' <> s) (#sources new)) 470 @ List.filter (fn s => List.all (fn s' => s' <> s) (#sources new))
468 (#sources old), 471 (#sources old),
469 protocol = mergeO #2 (#protocol old, #protocol new), 472 protocol = mergeO #2 (#protocol old, #protocol new),
470 dbms = mergeO #2 (#dbms old, #dbms new), 473 dbms = mergeO #2 (#dbms old, #dbms new),
471 sigFile = mergeO #2 (#sigFile old, #sigFile new), 474 sigFile = mergeO #2 (#sigFile old, #sigFile new),
472 safeGets = #safeGets old @ #safeGets new 475 safeGets = #safeGets old @ #safeGets new,
476 onError = mergeO #2 (#onError old, #onError new)
473 } 477 }
474 in 478 in
475 if accLibs then 479 if accLibs then
476 foldr (fn (job', job) => merge (job, job')) job (!libs) 480 foldr (fn (job', job) => merge (job, job')) job (!libs)
477 else 481 else
629 bigLibs := libify' arg :: !bigLibs 633 bigLibs := libify' arg :: !bigLibs
630 | "path" => 634 | "path" =>
631 (case String.fields (fn ch => ch = #"=") arg of 635 (case String.fields (fn ch => ch = #"=") arg of
632 [n, v] => pathmap := M.insert (!pathmap, n, v) 636 [n, v] => pathmap := M.insert (!pathmap, n, v)
633 | _ => ErrorMsg.error "path argument not of the form name=value'") 637 | _ => ErrorMsg.error "path argument not of the form name=value'")
638 | "onError" =>
639 (case String.fields (fn ch => ch = #".") arg of
640 m1 :: (fs as _ :: _) =>
641 onError := SOME (m1, List.take (fs, length fs - 1), List.last fs)
642 | _ => ErrorMsg.error "invalid 'onError' argument")
643
634 | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); 644 | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
635 read () 645 read ()
636 end 646 end
637 647
638 val job = if hasBlankLine then 648 val job = if hasBlankLine then
655 Settings.setUrlRules (#filterUrl job); 665 Settings.setUrlRules (#filterUrl job);
656 Settings.setMimeRules (#filterMime job); 666 Settings.setMimeRules (#filterMime job);
657 Option.app Settings.setProtocol (#protocol job); 667 Option.app Settings.setProtocol (#protocol job);
658 Option.app Settings.setDbms (#dbms job); 668 Option.app Settings.setDbms (#dbms job);
659 Settings.setSafeGets (#safeGets job); 669 Settings.setSafeGets (#safeGets job);
670 Settings.setOnError (#onError job);
660 job 671 job
661 end 672 end
662 in 673 in
663 {Job = pu fname, Libs = !bigLibs} 674 {Job = pu fname, Libs = !bigLibs}
664 end 675 end
707 type ord_key = string 718 type ord_key = string
708 val compare = String.compare 719 val compare = String.compare
709 end) 720 end)
710 721
711 val parse = { 722 val parse = {
712 func = fn {database, sources = fnames, ffi, ...} : job => 723 func = fn {database, sources = fnames, ffi, onError, ...} : job =>
713 let 724 let
714 val mrs = !moduleRoots 725 val mrs = !moduleRoots
715 726
716 val anyErrors = ref false 727 val anyErrors = ref false
717 fun checkErrors () = anyErrors := (!anyErrors orelse ErrorMsg.anyErrors ()) 728 fun checkErrors () = anyErrors := (!anyErrors orelse ErrorMsg.anyErrors ())
882 @ [(Source.DExport final, loc)] 893 @ [(Source.DExport final, loc)]
883 894
884 val ds = case database of 895 val ds = case database of
885 NONE => ds 896 NONE => ds
886 | SOME s => (Source.DDatabase s, loc) :: ds 897 | SOME s => (Source.DDatabase s, loc) :: ds
898
899 val ds = case onError of
900 NONE => ds
901 | SOME v => ds @ [(Source.DOnError v, loc)]
887 in 902 in
888 ds 903 ds
889 end handle Empty => ds 904 end handle Empty => ds
890 end, 905 end,
891 print = SourcePrint.p_file 906 print = SourcePrint.p_file