Make daemon mode support sharing of libraries across projects

5 files changed, 71 insertions, 25 deletions

diff --git a/src/compiler.sml b/src/compiler.sml
index 8f6d1fad..99f2ff31 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -413,11 +413,7 @@ fun inputCommentableLine inf =
 val lastUrp = ref ""
 
 fun parseUrp' accLibs fname =
-    (if !lastUrp = fname then
-         ()
-     else
-         ModDb.reset ();
-     lastUrp := fname;
+    (lastUrp := fname;
      if not (Posix.FileSys.access (fname ^ ".urp", []) orelse Posix.FileSys.access (fname ^ "/lib.urp", []))
         andalso Posix.FileSys.access (fname ^ ".ur", []) then
          let
diff --git a/src/elaborate.sml b/src/elaborate.sml
index c3e81b65..7671f597 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -5019,5 +5019,7 @@ fun elabFile basis basis_tm topStr topSgn top_tm env file =
         @ (L'.DStr ("Top", top_n, topSgn, topStr), ErrorMsg.dummySpan)
         :: ds' @ file
     end
+    handle e => (ModDb.revert ();
+                 raise e)
 
 end
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index bfc18e59..7197babf 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -279,19 +279,25 @@ val () = case CommandLine.arguments () of
                                           in
                                               case cmd of
                                                   "" =>
-                                                  let
-                                                      val success = (oneRun (rev args))
-                                                          handle ex => (print "unhandled exception:\n";
-                                                                        print (General.exnMessage ex ^ "\n");
-                                                                        OS.Process.failure)
-                                                  in
-                                                      TextIO.flushOut TextIO.stdOut;
-                                                      TextIO.flushOut TextIO.stdErr;
-                                                      send (sock, if OS.Process.isSuccess success then
-                                                                      "\001"
-                                                                  else
-                                                                      "\002")
-                                                  end
+                                                  (case args of
+                                                       ["stop", "daemon"] =>
+                                                       (((Socket.close listen;
+                                                          OS.FileSys.remove socket) handle OS.SysErr _ => ());
+                                                        OS.Process.exit OS.Process.success)
+                                                     | _ =>
+                                                       let
+                                                           val success = (oneRun (rev args))
+                                                               handle ex => (print "unhandled exception:\n";
+                                                                             print (General.exnMessage ex ^ "\n");
+                                                                             OS.Process.failure)
+                                                       in
+                                                           TextIO.flushOut TextIO.stdOut;
+                                                           TextIO.flushOut TextIO.stdErr;
+                                                           send (sock, if OS.Process.isSuccess success then
+                                                                           "\001"
+                                                                       else
+                                                                           "\002")
+                                                       end)
                                                 | _ => loop' (rest, cmd :: args)
                                           end
                                   end handle OS.SysErr _ => ()
@@ -315,6 +321,7 @@ val () = case CommandLine.arguments () of
                               Posix.IO.close oldStdout;
                               Posix.IO.close oldStderr;
 
+                              Settings.reset ();
                               MLton.GC.pack ();
                               loop ()
                           end
@@ -324,8 +331,6 @@ val () = case CommandLine.arguments () of
                       Socket.listen (listen, 1);
                       loop ()
                   end)
-           | ["daemon", "stop"] =>
-	     (OS.FileSys.remove socket handle OS.SysErr _ => OS.Process.exit OS.Process.success) 
            | args =>
              let
                  val sock = UnixSock.Strm.socket ()
diff --git a/src/settings.sig b/src/settings.sig
index 9b32e502..d918f0c5 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -27,6 +27,10 @@
 
 signature SETTINGS = sig
 
+    (* Call this when compiling a new project, e.g. with the Ur/Web daemon or from the SML/NJ REPL.
+     * Some settings stay, but most are reset, especially files cached for the app to serve. *)
+    val reset : unit -> unit
+
     (* XXX these should be unit -> string too *)
     val configBin : string ref
     val configLib : string ref
diff --git a/src/settings.sml b/src/settings.sml
index b021b587..8300d621 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -726,11 +726,6 @@ val minHeap = ref 0
 fun setMinHeap n = if n >= 0 then minHeap := n else raise Fail "Trying to set negative minHeap"
 fun getMinHeap () = !minHeap
 
-structure SS = BinarySetFn(struct
-                           type ord_key = string
-                           val compare = String.compare
-                           end)
-
 val alwaysInline = ref SS.empty
 fun addAlwaysInline s = alwaysInline := SS.add (!alwaysInline, s)
 fun checkAlwaysInline s = SS.member (!alwaysInline, s)
@@ -908,4 +903,48 @@ fun addFile {Uri, LoadFromFilename} =
 
 fun listFiles () = map #2 (SM.listItems (!files))
 
+fun reset () =
+    (urlPrefixFull := "/";
+     urlPrefix := "/";
+     urlPrePrefix := "";
+     timeout := 0;
+     headers := [];
+     scripts := [];
+     clientToServer := clientToServerBase;
+     effectful := effectfulBase;
+     benign := benignBase;
+     client := clientBase;
+     server := serverBase;
+     jsFuncs := jsFuncsBase;
+     rewrites := [];
+     url := [];
+     mime := [];
+     request := [];
+     response := [];
+     env := [];
+     debug := false;
+     dbstring := NONE;
+     exe := NONE;
+     sql := NONE;
+     coreInline := 5;
+     monoInline := 5;
+     staticLinking := false;
+     deadlines := false;
+     sigFile := NONE;
+     safeGet := SS.empty;
+     onError := NONE;
+     limitsList := [];
+     minHeap := 0;
+     alwaysInline := SS.empty;
+     neverInline := SS.empty;
+     noXsrfProtection := SS.empty;
+     timeFormat := "%c";
+     mangle := true;
+     html5 := false;
+     less := false;
+     noMimeFile := false;
+     mimeTypes := NONE;
+     files := SM.empty;
+     filePath := ".")
+
 end