Flush elaboration cache when switching between .urp files

1 files changed, 456 insertions, 449 deletions

diff --git a/src/compiler.sml b/src/compiler.sml
index 477c8fa4..10b2bd2f 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -401,464 +401,471 @@ fun inputCommentableLine inf =
                 end
         end
 
-fun parseUrp' accLibs fname =
-    if not (Posix.FileSys.access (fname ^ ".urp", []) orelse Posix.FileSys.access (fname ^ "/lib.urp", []))
-       andalso Posix.FileSys.access (fname ^ ".ur", []) then
-        let
-            val job = {prefix = "/",
-                       database = NONE,
-                       sources = [fname],
-                       exe = fname ^ ".exe",
-                       sql = NONE,
-                       debug = Settings.getDebug (),
-                       profile = false,
-                       timeout = 60,
-                       ffi = [],
-                       link = [],
-                       linker = NONE,
-                       headers = [],
-                       scripts = [],
-                       clientToServer = [],
-                       effectful = [],
-                       benignEffectful = [],
-                       clientOnly = [],
-                       serverOnly = [],
-                       jsFuncs = [],
-                       rewrites = [{pkind = Settings.Any,
-                                    kind = Settings.Prefix,
-                                    from = capitalize (OS.Path.file fname) ^ "/", to = "",
-                                    hyphenate = false}],
-                       filterUrl = [],
-                       filterMime = [],
-                       filterRequest = [],
-                       filterResponse = [],
-                       protocol = NONE,
-                       dbms = NONE,
-                       sigFile = NONE,
-                       safeGets = [],
-                       onError = NONE,
-                       minHeap = 0}
-        in
-            institutionalizeJob job;
-            {Job = job, Libs = []}
-        end
-    else
-        let
-            val pathmap = ref (!pathmap)
-            val bigLibs = ref []
-
-            fun pu filename =
-                let
-                    val filename = OS.Path.mkAbsolute {path = filename, relativeTo = OS.FileSys.getDir ()}
-
-                    val dir = OS.Path.dir filename
-                    fun opener () = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
-
-                    val inf = opener ()
-
-                    fun hasSpaceLine () =
-                        case inputCommentableLine inf of
-                            Content s => s = "debug" orelse s = "profile"
-                                         orelse CharVector.exists (fn ch => ch = #" " orelse ch = #"\t") s orelse hasSpaceLine ()
-                          | EndOfFile => false
-                          | OnlyComment => hasSpaceLine ()
-
-                    val hasBlankLine = hasSpaceLine ()
-
-                    val inf = (TextIO.closeIn inf; opener ())
-
-                    fun pathify fname =
-                        if size fname > 0 andalso String.sub (fname, 0) = #"$" then
-                            let
-                                val fname' = Substring.extract (fname, 1, NONE)
-                                val (befor, after) = Substring.splitl (fn ch => ch <> #"/") fname'
-                            in
-                                case M.find (!pathmap, Substring.string befor) of
-                                    NONE => fname
-                                  | SOME rep => rep ^ Substring.string after
-                            end
-                        else
-                            fname
-
-                    fun relify fname =
-                        let
-                            val fname = pathify fname
-                        in
-                            OS.Path.concat (dir, fname)
-                            handle OS.Path.Path => fname
-                        end
-
-                    fun libify path =
-                        (if Posix.FileSys.access (path ^ ".urp", []) then
-                             path
-                         else
-                             path ^ "/lib")
-                        handle SysErr => path
+val lastUrp = ref ""
 
-                    fun libify' path =
-                        (if Posix.FileSys.access (relify path ^ ".urp", []) then
-                             path
+fun parseUrp' accLibs fname =
+    (if !lastUrp = fname then
+         ()
+     else
+         ModDb.reset ();
+     lastUrp := fname;
+     if not (Posix.FileSys.access (fname ^ ".urp", []) orelse Posix.FileSys.access (fname ^ "/lib.urp", []))
+        andalso Posix.FileSys.access (fname ^ ".ur", []) then
+         let
+             val job = {prefix = "/",
+                        database = NONE,
+                        sources = [fname],
+                        exe = fname ^ ".exe",
+                        sql = NONE,
+                        debug = Settings.getDebug (),
+                        profile = false,
+                        timeout = 60,
+                        ffi = [],
+                        link = [],
+                        linker = NONE,
+                        headers = [],
+                        scripts = [],
+                        clientToServer = [],
+                        effectful = [],
+                        benignEffectful = [],
+                        clientOnly = [],
+                        serverOnly = [],
+                        jsFuncs = [],
+                        rewrites = [{pkind = Settings.Any,
+                                     kind = Settings.Prefix,
+                                     from = capitalize (OS.Path.file fname) ^ "/", to = "",
+                                     hyphenate = false}],
+                        filterUrl = [],
+                        filterMime = [],
+                        filterRequest = [],
+                        filterResponse = [],
+                        protocol = NONE,
+                        dbms = NONE,
+                        sigFile = NONE,
+                        safeGets = [],
+                        onError = NONE,
+                        minHeap = 0}
+         in
+             institutionalizeJob job;
+             {Job = job, Libs = []}
+         end
+     else
+         let
+             val pathmap = ref (!pathmap)
+             val bigLibs = ref []
+
+             fun pu filename =
+                 let
+                     val filename = OS.Path.mkAbsolute {path = filename, relativeTo = OS.FileSys.getDir ()}
+
+                     val dir = OS.Path.dir filename
+                     fun opener () = TextIO.openIn (OS.Path.joinBaseExt {base = filename, ext = SOME "urp"})
+
+                     val inf = opener ()
+
+                     fun hasSpaceLine () =
+                         case inputCommentableLine inf of
+                             Content s => s = "debug" orelse s = "profile"
+                                          orelse CharVector.exists (fn ch => ch = #" " orelse ch = #"\t") s orelse hasSpaceLine ()
+                           | EndOfFile => false
+                           | OnlyComment => hasSpaceLine ()
+
+                     val hasBlankLine = hasSpaceLine ()
+
+                     val inf = (TextIO.closeIn inf; opener ())
+
+                     fun pathify fname =
+                         if size fname > 0 andalso String.sub (fname, 0) = #"$" then
+                             let
+                                 val fname' = Substring.extract (fname, 1, NONE)
+                                 val (befor, after) = Substring.splitl (fn ch => ch <> #"/") fname'
+                             in
+                                 case M.find (!pathmap, Substring.string befor) of
+                                     NONE => fname
+                                   | SOME rep => rep ^ Substring.string after
+                             end
                          else
-                             path ^ "/lib")
-                        handle SysErr => path
+                             fname
 
-                    val absDir = OS.Path.mkAbsolute {path = dir, relativeTo = OS.FileSys.getDir ()}
+                     fun relify fname =
+                         let
+                             val fname = pathify fname
+                         in
+                             OS.Path.concat (dir, fname)
+                             handle OS.Path.Path => fname
+                         end
 
-                    fun relifyA fname =
-                        OS.Path.mkAbsolute {path = pathify fname, relativeTo = absDir}
+                     fun libify path =
+                         (if Posix.FileSys.access (path ^ ".urp", []) then
+                              path
+                          else
+                              path ^ "/lib")
+                         handle SysErr => path
 
-                    fun readSources acc =
-                        case inputCommentableLine inf of
-                            Content line =>
-                            let
-                                val acc = if CharVector.all Char.isSpace line then
-                                              acc
-                                          else
-                                              let
-                                                  val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
-                                                                                          (String.explode line))
-                                                  val fname = relifyA fname
-                                              in
-                                                  fname :: acc
-                                              end
-                            in
-                                readSources acc
-                            end
-                          | OnlyComment => readSources acc
-                          | EndOfFile => rev acc
-
-                    val prefix = ref (case Settings.getUrlPrefixFull () of "/" => NONE | s => SOME s)
-                    val database = ref (Settings.getDbstring ())
-                    val exe = ref (Settings.getExe ())
-                    val sql = ref (Settings.getSql ())
-                    val debug = ref (Settings.getDebug ())
-                    val profile = ref false
-                    val timeout = ref NONE
-                    val ffi = ref []
-                    val link = ref []
-                    val linker = ref NONE
-                    val headers = ref []
-                    val scripts = ref []
-                    val clientToServer = ref []
-                    val effectful = ref []
-                    val benignEffectful = ref []
-                    val clientOnly = ref []
-                    val serverOnly = ref []
-                    val jsFuncs = ref []
-                    val rewrites = ref []
-                    val url = ref []
-                    val mime = ref []
-                    val request = ref []
-                    val response = ref []
-                    val libs = ref []
-                    val protocol = ref NONE
-                    val dbms = ref NONE
-                    val sigFile = ref (Settings.getSigFile ())
-                    val safeGets = ref []
-                    val onError = ref NONE
-                    val minHeap = ref 0
-
-                    fun finish sources =
-                        let
-                            val job = {
-                                prefix = Option.getOpt (!prefix, "/"),
-                                database = !database,
-                                exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
-                                                                                ext = SOME "exe"}),
-                                sql = !sql,
-                                debug = !debug,
-                                profile = !profile,
-                                timeout = Option.getOpt (!timeout, 60),
-                                ffi = rev (!ffi),
-                                link = rev (!link),
-                                linker = !linker,
-                                headers = rev (!headers),
-                                scripts = rev (!scripts),
-                                clientToServer = rev (!clientToServer),
-                                effectful = rev (!effectful),
-                                benignEffectful = rev (!benignEffectful),
-                                clientOnly = rev (!clientOnly),
-                                serverOnly = rev (!serverOnly),
-                                jsFuncs = rev (!jsFuncs),
-                                rewrites = rev (!rewrites),
-                                filterUrl = rev (!url),
-                                filterMime = rev (!mime),
-                                filterRequest = rev (!request),
-                                filterResponse = rev (!response),
-                                sources = sources,
-                                protocol = !protocol,
-                                dbms = !dbms,
-                                sigFile = !sigFile,
-                                safeGets = rev (!safeGets),
-                                onError = !onError,
-                                minHeap = !minHeap
-                            }
-
-                            fun mergeO f (old, new) =
-                                case (old, new) of
-                                    (NONE, _) => new
-                                  | (_, NONE) => old
-                                  | (SOME v1, SOME v2) => SOME (f (v1, v2))
-
-                            fun same desc = mergeO (fn (x : string, y) =>
-                                                       (if x = y then
-                                                            ()
-                                                        else
-                                                            ErrorMsg.error ("Multiple "
-                                                                            ^ desc ^ " values that don't agree");
-                                                        x))
-
-                            fun merge (old : job, new : job) = {
-                                prefix = case #prefix old of
-                                             "/" => #prefix new
-                                           | pold => case #prefix new of
-                                                         "/" => pold
-                                                       | pnew => (if pold = pnew then
-                                                                      ()
-                                                                  else
-                                                                      ErrorMsg.error ("Multiple prefix values that don't agree: "
-                                                                                      ^ pold ^ ", " ^ pnew);
-                                                                  pold),
-                                database = mergeO (fn (old, _) => old) (#database old, #database new),
-                                exe = #exe old,
-                                sql = #sql old,
-                                debug = #debug old orelse #debug new,
-                                profile = #profile old orelse #profile new,
-                                timeout = #timeout old,
-                                ffi = #ffi old @ #ffi new,
-                                link = #link old @ #link new,
-                                linker = mergeO (fn (_, new) => new) (#linker old, #linker new),
-                                headers = #headers old @ #headers new,
-                                scripts = #scripts old @ #scripts new,
-                                clientToServer = #clientToServer old @ #clientToServer new,
-                                effectful = #effectful old @ #effectful new,
-                                benignEffectful = #benignEffectful old @ #benignEffectful new,
-                                clientOnly = #clientOnly old @ #clientOnly new,
-                                serverOnly = #serverOnly old @ #serverOnly new,
-                                jsFuncs = #jsFuncs old @ #jsFuncs new,
-                                rewrites = #rewrites old @ #rewrites new,
-                                filterUrl = #filterUrl old @ #filterUrl new,
-                                filterMime = #filterMime old @ #filterMime new,
-                                filterRequest = #filterRequest old @ #filterRequest new,
-                                filterResponse = #filterResponse old @ #filterResponse new,
-                                sources = #sources new
-                                          @ List.filter (fn s => List.all (fn s' => s' <> s) (#sources new))
-                                                        (#sources old),
-                                protocol = mergeO #2 (#protocol old, #protocol new),
-                                dbms = mergeO #2 (#dbms old, #dbms new),
-                                sigFile = mergeO #2 (#sigFile old, #sigFile new),
-                                safeGets = #safeGets old @ #safeGets new,
-                                onError = mergeO #2 (#onError old, #onError new),
-                                minHeap = Int.max (#minHeap old, #minHeap new)
-                            }
-                        in
-                            if accLibs then
-                                foldr (fn (job', job) => merge (job, job')) job (!libs)
-                            else
-                                job
-                        end
-
-                    fun parsePkind s =
-                        case s of
-                            "all" => Settings.Any
-                          | "url" => Settings.Url
-                          | "table" => Settings.Table
-                          | "sequence" => Settings.Sequence
-                          | "view" => Settings.View
-                          | "relation" => Settings.Relation
-                          | "cookie" => Settings.Cookie
-                          | "style" => Settings.Style
-                          | _ => (ErrorMsg.error "Bad path kind spec";
-                                  Settings.Any)
-
-                    fun parseFrom s =
-                        if size s > 1 andalso String.sub (s, size s - 2) = #"/" andalso String.sub (s, size s - 1) = #"*" then
-                            (Settings.Prefix, String.substring (s, 0, size s - 1))
-                        else
-                            (Settings.Exact, s)
-
-                    fun parseFkind s =
-                        case s of
-                            "url" => url
-                          | "mime" => mime
-                          | "requestHeader" => request
-                          | "responseHeader" => response
-                          | _ => (ErrorMsg.error "Bad filter kind";
-                                  url)
-
-                    fun parsePattern s =
-                        if size s > 0 andalso String.sub (s, size s - 1) = #"*" then
-                            (Settings.Prefix, String.substring (s, 0, size s - 1))
-                        else
-                            (Settings.Exact, s)
-
-                    fun read () =
-                        case inputCommentableLine inf of
-                            EndOfFile => finish []
-                          | OnlyComment => read ()
-                          | Content "" => finish (readSources [])
-                          | Content line =>
-                            let
-                                val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
-                                val cmd = Substring.string (trim cmd)
-                                val arg = Substring.string (trim arg)
-
-                                fun ffiS () =
-                                    case String.fields (fn ch => ch = #".") arg of
-                                        [m, x] => (m, x)
-                                      | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func");
-                                              ("", ""))
-
-                                fun ffiM () =
-                                    case String.fields (fn ch => ch = #"=") arg of
-                                        [f, s] =>
-                                        let
-                                            val f = trimS f
-                                            val s = trimS s
-                                        in
-                                            case String.fields (fn ch => ch = #".") f of
-                                                [m, x] => ((m, x), s)
-                                              | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
-                                                      (("", ""), ""))
-                                        end
-                                      | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
-                                              (("", ""), ""))
-                            in
-                                case cmd of
-                                    "prefix" => prefix := SOME arg
-                                  | "database" =>
-                                    (case !database of
-                                         NONE => database := SOME arg
-                                       | SOME _ => ())
-                                  | "dbms" =>
-                                    (case !dbms of
-                                         NONE => dbms := SOME arg
-                                       | SOME _ => ())
-                                  | "sigfile" =>
-                                    (case !sigFile of
-                                         NONE => sigFile := SOME arg
-                                       | SOME _ => ())
-                                  | "exe" =>
-                                    (case !exe of
-                                         NONE => exe := SOME (relify arg)
-                                       | SOME _ => ())
-                                  | "sql" =>
-                                    (case !sql of
-                                         NONE => sql := SOME (relify arg)
-                                       | SOME _ => ())
-                                  | "debug" => debug := true
-                                  | "profile" => profile := true
-                                  | "timeout" =>
-                                    (case !timeout of
-                                         NONE => ()
-                                       | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
-                                     timeout := SOME (valOf (Int.fromString arg)))
-                                  | "ffi" => ffi := relify arg :: !ffi
-                                  | "link" => let
-                                        val arg = if size arg >= 1
-                                                     andalso String.sub (arg, 0) = #"-" then
-                                                      arg
-                                                  else
-                                                      relifyA arg
-                                    in
-                                        link := arg :: !link
-                                    end
-                                  | "linker" => linker := SOME arg
-                                  | "include" => headers := relifyA arg :: !headers
-                                  | "script" => scripts := arg :: !scripts
-                                  | "clientToServer" => clientToServer := ffiS () :: !clientToServer
-                                  | "safeGet" => safeGets := arg :: !safeGets
-                                  | "effectful" => effectful := ffiS () :: !effectful
-                                  | "benignEffectful" => benignEffectful := ffiS () :: !benignEffectful
-                                  | "clientOnly" => clientOnly := ffiS () :: !clientOnly
-                                  | "serverOnly" => serverOnly := ffiS () :: !serverOnly
-                                  | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
-                                  | "rewrite" =>
-                                    let
-                                        fun doit (pkind, from, to, hyph) =
-                                            let
-                                                val pkind = parsePkind pkind
-                                                val (kind, from) = parseFrom from
-                                            in
-                                                rewrites := {pkind = pkind, kind = kind, from = from, to = to, hyphenate = hyph} :: !rewrites
-                                            end
-                                    in
-                                        case String.tokens Char.isSpace arg of
-                                            [pkind, from, to, "[-]"] => doit (pkind, from, to, true)
-                                          | [pkind, from, "[-]"] => doit (pkind, from, "", true)
-                                          | [pkind, from, to] => doit (pkind, from, to, false)
-                                          | [pkind, from] => doit (pkind, from, "", false)
-                                          | _ => ErrorMsg.error "Bad 'rewrite' syntax"
-                                    end
-                                  | "allow" =>
-                                    (case String.tokens Char.isSpace arg of
-                                         [fkind, pattern] =>
-                                         let
-                                             val fkind = parseFkind fkind
-                                             val (kind, pattern) = parsePattern pattern
-                                         in
-                                             fkind := {action = Settings.Allow, kind = kind, pattern = pattern} :: !fkind
-                                         end
-                                       | _ => ErrorMsg.error "Bad 'allow' syntax")
-                                  | "deny" =>
-                                    (case String.tokens Char.isSpace arg of
-                                         [fkind, pattern] =>
+                     fun libify' path =
+                         (if Posix.FileSys.access (relify path ^ ".urp", []) then
+                              path
+                          else
+                              path ^ "/lib")
+                         handle SysErr => path
+
+                     val absDir = OS.Path.mkAbsolute {path = dir, relativeTo = OS.FileSys.getDir ()}
+
+                     fun relifyA fname =
+                         OS.Path.mkAbsolute {path = pathify fname, relativeTo = absDir}
+
+                     fun readSources acc =
+                         case inputCommentableLine inf of
+                             Content line =>
+                             let
+                                 val acc = if CharVector.all Char.isSpace line then
+                                               acc
+                                           else
+                                               let
+                                                   val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
+                                                                                           (String.explode line))
+                                                   val fname = relifyA fname
+                                               in
+                                                   fname :: acc
+                                               end
+                             in
+                                 readSources acc
+                             end
+                           | OnlyComment => readSources acc
+                           | EndOfFile => rev acc
+
+                     val prefix = ref (case Settings.getUrlPrefixFull () of "/" => NONE | s => SOME s)
+                     val database = ref (Settings.getDbstring ())
+                     val exe = ref (Settings.getExe ())
+                     val sql = ref (Settings.getSql ())
+                     val debug = ref (Settings.getDebug ())
+                     val profile = ref false
+                     val timeout = ref NONE
+                     val ffi = ref []
+                     val link = ref []
+                     val linker = ref NONE
+                     val headers = ref []
+                     val scripts = ref []
+                     val clientToServer = ref []
+                     val effectful = ref []
+                     val benignEffectful = ref []
+                     val clientOnly = ref []
+                     val serverOnly = ref []
+                     val jsFuncs = ref []
+                     val rewrites = ref []
+                     val url = ref []
+                     val mime = ref []
+                     val request = ref []
+                     val response = ref []
+                     val libs = ref []
+                     val protocol = ref NONE
+                     val dbms = ref NONE
+                     val sigFile = ref (Settings.getSigFile ())
+                     val safeGets = ref []
+                     val onError = ref NONE
+                     val minHeap = ref 0
+
+                     fun finish sources =
+                         let
+                             val job = {
+                                 prefix = Option.getOpt (!prefix, "/"),
+                                 database = !database,
+                                 exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
+                                                                                 ext = SOME "exe"}),
+                                 sql = !sql,
+                                 debug = !debug,
+                                 profile = !profile,
+                                 timeout = Option.getOpt (!timeout, 60),
+                                 ffi = rev (!ffi),
+                                 link = rev (!link),
+                                 linker = !linker,
+                                 headers = rev (!headers),
+                                 scripts = rev (!scripts),
+                                 clientToServer = rev (!clientToServer),
+                                 effectful = rev (!effectful),
+                                 benignEffectful = rev (!benignEffectful),
+                                 clientOnly = rev (!clientOnly),
+                                 serverOnly = rev (!serverOnly),
+                                 jsFuncs = rev (!jsFuncs),
+                                 rewrites = rev (!rewrites),
+                                 filterUrl = rev (!url),
+                                 filterMime = rev (!mime),
+                                 filterRequest = rev (!request),
+                                 filterResponse = rev (!response),
+                                 sources = sources,
+                                 protocol = !protocol,
+                                 dbms = !dbms,
+                                 sigFile = !sigFile,
+                                 safeGets = rev (!safeGets),
+                                 onError = !onError,
+                                 minHeap = !minHeap
+                             }
+
+                             fun mergeO f (old, new) =
+                                 case (old, new) of
+                                     (NONE, _) => new
+                                   | (_, NONE) => old
+                                   | (SOME v1, SOME v2) => SOME (f (v1, v2))
+
+                             fun same desc = mergeO (fn (x : string, y) =>
+                                                        (if x = y then
+                                                             ()
+                                                         else
+                                                             ErrorMsg.error ("Multiple "
+                                                                             ^ desc ^ " values that don't agree");
+                                                         x))
+
+                             fun merge (old : job, new : job) = {
+                                 prefix = case #prefix old of
+                                              "/" => #prefix new
+                                            | pold => case #prefix new of
+                                                          "/" => pold
+                                                        | pnew => (if pold = pnew then
+                                                                       ()
+                                                                   else
+                                                                       ErrorMsg.error ("Multiple prefix values that don't agree: "
+                                                                                       ^ pold ^ ", " ^ pnew);
+                                                                   pold),
+                                 database = mergeO (fn (old, _) => old) (#database old, #database new),
+                                 exe = #exe old,
+                                 sql = #sql old,
+                                 debug = #debug old orelse #debug new,
+                                 profile = #profile old orelse #profile new,
+                                 timeout = #timeout old,
+                                 ffi = #ffi old @ #ffi new,
+                                 link = #link old @ #link new,
+                                 linker = mergeO (fn (_, new) => new) (#linker old, #linker new),
+                                 headers = #headers old @ #headers new,
+                                 scripts = #scripts old @ #scripts new,
+                                 clientToServer = #clientToServer old @ #clientToServer new,
+                                 effectful = #effectful old @ #effectful new,
+                                 benignEffectful = #benignEffectful old @ #benignEffectful new,
+                                 clientOnly = #clientOnly old @ #clientOnly new,
+                                 serverOnly = #serverOnly old @ #serverOnly new,
+                                 jsFuncs = #jsFuncs old @ #jsFuncs new,
+                                 rewrites = #rewrites old @ #rewrites new,
+                                 filterUrl = #filterUrl old @ #filterUrl new,
+                                 filterMime = #filterMime old @ #filterMime new,
+                                 filterRequest = #filterRequest old @ #filterRequest new,
+                                 filterResponse = #filterResponse old @ #filterResponse new,
+                                 sources = #sources new
+                                           @ List.filter (fn s => List.all (fn s' => s' <> s) (#sources new))
+                                                         (#sources old),
+                                 protocol = mergeO #2 (#protocol old, #protocol new),
+                                 dbms = mergeO #2 (#dbms old, #dbms new),
+                                 sigFile = mergeO #2 (#sigFile old, #sigFile new),
+                                 safeGets = #safeGets old @ #safeGets new,
+                                 onError = mergeO #2 (#onError old, #onError new),
+                                 minHeap = Int.max (#minHeap old, #minHeap new)
+                             }
+                         in
+                             if accLibs then
+                                 foldr (fn (job', job) => merge (job, job')) job (!libs)
+                             else
+                                 job
+                         end
+
+                     fun parsePkind s =
+                         case s of
+                             "all" => Settings.Any
+                           | "url" => Settings.Url
+                           | "table" => Settings.Table
+                           | "sequence" => Settings.Sequence
+                           | "view" => Settings.View
+                           | "relation" => Settings.Relation
+                           | "cookie" => Settings.Cookie
+                           | "style" => Settings.Style
+                           | _ => (ErrorMsg.error "Bad path kind spec";
+                                   Settings.Any)
+
+                     fun parseFrom s =
+                         if size s > 1 andalso String.sub (s, size s - 2) = #"/" andalso String.sub (s, size s - 1) = #"*" then
+                             (Settings.Prefix, String.substring (s, 0, size s - 1))
+                         else
+                             (Settings.Exact, s)
+
+                     fun parseFkind s =
+                         case s of
+                             "url" => url
+                           | "mime" => mime
+                           | "requestHeader" => request
+                           | "responseHeader" => response
+                           | _ => (ErrorMsg.error "Bad filter kind";
+                                   url)
+
+                     fun parsePattern s =
+                         if size s > 0 andalso String.sub (s, size s - 1) = #"*" then
+                             (Settings.Prefix, String.substring (s, 0, size s - 1))
+                         else
+                             (Settings.Exact, s)
+
+                     fun read () =
+                         case inputCommentableLine inf of
+                             EndOfFile => finish []
+                           | OnlyComment => read ()
+                           | Content "" => finish (readSources [])
+                           | Content line =>
+                             let
+                                 val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
+                                 val cmd = Substring.string (trim cmd)
+                                 val arg = Substring.string (trim arg)
+
+                                 fun ffiS () =
+                                     case String.fields (fn ch => ch = #".") arg of
+                                         [m, x] => (m, x)
+                                       | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func");
+                                               ("", ""))
+
+                                 fun ffiM () =
+                                     case String.fields (fn ch => ch = #"=") arg of
+                                         [f, s] =>
                                          let
-                                             val fkind = parseFkind fkind
-                                             val (kind, pattern) = parsePattern pattern
+                                             val f = trimS f
+                                             val s = trimS s
                                          in
-                                             fkind := {action = Settings.Deny, kind = kind, pattern = pattern} :: !fkind
+                                             case String.fields (fn ch => ch = #".") f of
+                                                 [m, x] => ((m, x), s)
+                                               | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
+                                                       (("", ""), ""))
                                          end
-                                       | _ => ErrorMsg.error "Bad 'deny' syntax")
-                                  | "library" => if accLibs then
-                                                     libs := pu (libify (relify arg)) :: !libs
-                                                 else
-                                                     bigLibs := libify' arg :: !bigLibs
-                                  | "path" =>
-                                    (case String.fields (fn ch => ch = #"=") arg of
-                                         [n, v] => ((pathmap := M.insert (!pathmap, n, OS.Path.mkAbsolute {path = v, relativeTo = dir}))
+                                       | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
+                                               (("", ""), ""))
+                             in
+                                 case cmd of
+                                     "prefix" => prefix := SOME arg
+                                   | "database" =>
+                                     (case !database of
+                                          NONE => database := SOME arg
+                                        | SOME _ => ())
+                                   | "dbms" =>
+                                     (case !dbms of
+                                          NONE => dbms := SOME arg
+                                        | SOME _ => ())
+                                   | "sigfile" =>
+                                     (case !sigFile of
+                                          NONE => sigFile := SOME arg
+                                        | SOME _ => ())
+                                   | "exe" =>
+                                     (case !exe of
+                                          NONE => exe := SOME (relify arg)
+                                        | SOME _ => ())
+                                   | "sql" =>
+                                     (case !sql of
+                                          NONE => sql := SOME (relify arg)
+                                        | SOME _ => ())
+                                   | "debug" => debug := true
+                                   | "profile" => profile := true
+                                   | "timeout" =>
+                                     (case !timeout of
+                                          NONE => ()
+                                        | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
+                                      timeout := SOME (valOf (Int.fromString arg)))
+                                   | "ffi" => ffi := relify arg :: !ffi
+                                   | "link" => let
+                                         val arg = if size arg >= 1
+                                                      andalso String.sub (arg, 0) = #"-" then
+                                                       arg
+                                                   else
+                                                       relifyA arg
+                                     in
+                                         link := arg :: !link
+                                     end
+                                   | "linker" => linker := SOME arg
+                                   | "include" => headers := relifyA arg :: !headers
+                                   | "script" => scripts := arg :: !scripts
+                                   | "clientToServer" => clientToServer := ffiS () :: !clientToServer
+                                   | "safeGet" => safeGets := arg :: !safeGets
+                                   | "effectful" => effectful := ffiS () :: !effectful
+                                   | "benignEffectful" => benignEffectful := ffiS () :: !benignEffectful
+                                   | "clientOnly" => clientOnly := ffiS () :: !clientOnly
+                                   | "serverOnly" => serverOnly := ffiS () :: !serverOnly
+                                   | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
+                                   | "rewrite" =>
+                                     let
+                                         fun doit (pkind, from, to, hyph) =
+                                             let
+                                                 val pkind = parsePkind pkind
+                                                 val (kind, from) = parseFrom from
+                                             in
+                                                 rewrites := {pkind = pkind, kind = kind, from = from, to = to, hyphenate = hyph} :: !rewrites
+                                             end
+                                     in
+                                         case String.tokens Char.isSpace arg of
+                                             [pkind, from, to, "[-]"] => doit (pkind, from, to, true)
+                                           | [pkind, from, "[-]"] => doit (pkind, from, "", true)
+                                           | [pkind, from, to] => doit (pkind, from, to, false)
+                                           | [pkind, from] => doit (pkind, from, "", false)
+                                           | _ => ErrorMsg.error "Bad 'rewrite' syntax"
+                                     end
+                                   | "allow" =>
+                                     (case String.tokens Char.isSpace arg of
+                                          [fkind, pattern] =>
+                                          let
+                                              val fkind = parseFkind fkind
+                                              val (kind, pattern) = parsePattern pattern
+                                          in
+                                              fkind := {action = Settings.Allow, kind = kind, pattern = pattern} :: !fkind
+                                          end
+                                        | _ => ErrorMsg.error "Bad 'allow' syntax")
+                                   | "deny" =>
+                                     (case String.tokens Char.isSpace arg of
+                                          [fkind, pattern] =>
+                                          let
+                                              val fkind = parseFkind fkind
+                                              val (kind, pattern) = parsePattern pattern
+                                          in
+                                              fkind := {action = Settings.Deny, kind = kind, pattern = pattern} :: !fkind
+                                          end
+                                        | _ => ErrorMsg.error "Bad 'deny' syntax")
+                                   | "library" => if accLibs then
+                                                      libs := pu (libify (relify arg)) :: !libs
+                                                  else
+                                                      bigLibs := libify' arg :: !bigLibs
+                                   | "path" =>
+                                     (case String.fields (fn ch => ch = #"=") arg of
+                                          [n, v] => ((pathmap := M.insert (!pathmap, n, OS.Path.mkAbsolute {path = v, relativeTo = dir}))
                                                      handle OS.Path.Path => ErrorMsg.error "Invalid 'path' directory argument")
-                                       | _ => ErrorMsg.error "path argument not of the form name=value'")
-                                  | "onError" =>
-                                    (case String.fields (fn ch => ch = #".") arg of
-                                         m1 :: (fs as _ :: _) =>
-                                         onError := SOME (m1, List.take (fs, length fs - 1), List.last fs)
-                                       | _ => ErrorMsg.error "invalid 'onError' argument")
-                                  | "limit" =>
-                                    (case String.fields Char.isSpace arg of
-                                         [class, num] =>
-                                         (case Int.fromString num of
-                                              NONE => ErrorMsg.error ("invalid limit number '" ^ num ^ "'")
-                                            | SOME n =>
-                                              if n < 0 then
-                                                  ErrorMsg.error ("invalid limit number '" ^ num ^ "'")
-                                              else
-                                                  Settings.addLimit (class, n))
-                                       | _ => ErrorMsg.error "invalid 'limit' arguments")
-                                  | "minHeap" =>
-                                    (case Int.fromString arg of
-                                         NONE => ErrorMsg.error ("invalid min heap '" ^ arg ^ "'")
-                                       | SOME n => minHeap := n)
-                                  | "alwaysInline" => Settings.addAlwaysInline arg
-                                  | "noXsrfProtection" => Settings.addNoXsrfProtection arg
-                                  | "timeFormat" => Settings.setTimeFormat arg
-
-                                  | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
-                                read ()
-                            end
-
-                    val job = if hasBlankLine then
-                                  read ()
-                              else
-                                  finish (readSources [])
-                in
-                    TextIO.closeIn inf;
-                    institutionalizeJob job;
-                    job
-                end
-        in
-            {Job = pu fname, Libs = !bigLibs}
-        end
+                                        | _ => ErrorMsg.error "path argument not of the form name=value'")
+                                   | "onError" =>
+                                     (case String.fields (fn ch => ch = #".") arg of
+                                          m1 :: (fs as _ :: _) =>
+                                          onError := SOME (m1, List.take (fs, length fs - 1), List.last fs)
+                                        | _ => ErrorMsg.error "invalid 'onError' argument")
+                                   | "limit" =>
+                                     (case String.fields Char.isSpace arg of
+                                          [class, num] =>
+                                          (case Int.fromString num of
+                                               NONE => ErrorMsg.error ("invalid limit number '" ^ num ^ "'")
+                                             | SOME n =>
+                                               if n < 0 then
+                                                   ErrorMsg.error ("invalid limit number '" ^ num ^ "'")
+                                               else
+                                                   Settings.addLimit (class, n))
+                                        | _ => ErrorMsg.error "invalid 'limit' arguments")
+                                   | "minHeap" =>
+                                     (case Int.fromString arg of
+                                          NONE => ErrorMsg.error ("invalid min heap '" ^ arg ^ "'")
+                                        | SOME n => minHeap := n)
+                                   | "alwaysInline" => Settings.addAlwaysInline arg
+                                   | "noXsrfProtection" => Settings.addNoXsrfProtection arg
+                                   | "timeFormat" => Settings.setTimeFormat arg
+
+                                   | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
+                                 read ()
+                             end
+
+                     val job = if hasBlankLine then
+                                   read ()
+                               else
+                                   finish (readSources [])
+                 in
+                     TextIO.closeIn inf;
+                     institutionalizeJob job;
+                     job
+                 end
+         in
+             {Job = pu fname, Libs = !bigLibs}
+         end)
 
 fun p_job' {Job = j, Libs = _ : string list} = p_job j