From f3373fd5809689bece7fd390f2d737aa0b43f594 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 3 Jun 2018 15:01:24 -0400
Subject: 'filecache' .urp directive, fixing a longstanding MonoUtil bug in the
 process

---
 src/compiler.sml | 19 ++++++++++++++++++-
 1 file changed, 18 insertions(+), 1 deletion(-)

(limited to 'src/compiler.sml')

diff --git a/src/compiler.sml b/src/compiler.sml
index 3fb0b767..f724bf56 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -64,6 +64,7 @@ type job = {
      protocol : string option,
      dbms : string option,
      sigFile : string option,
+     fileCache : string option,
      safeGets : string list,
      onError : (string * string list * string) option,
      minHeap : int,
@@ -388,6 +389,7 @@ fun institutionalizeJob (job : job) =
      Settings.setOnError (#onError job);
      Settings.setMinHeap (#minHeap job);
      Settings.setSigFile (#sigFile job);
+     Settings.setFileCache (#fileCache job);
      Settings.setMimeFilePath (Option.getOpt (#mimeTypes job, "/etc/mime.types")))
 
 datatype commentableLine =
@@ -467,6 +469,7 @@ fun parseUrp' accLibs fname =
                         protocol = NONE,
                         dbms = NONE,
                         sigFile = NONE,
+                        fileCache = NONE,
                         safeGets = [],
                         onError = NONE,
                         minHeap = 0,
@@ -601,6 +604,7 @@ fun parseUrp' accLibs fname =
                      val protocol = ref NONE
                      val dbms = ref NONE
                      val sigFile = ref (Settings.getSigFile ())
+                     val fileCache = ref (Settings.getFileCache ())
                      val safeGets = ref []
                      val onError = ref NONE
                      val minHeap = ref 0
@@ -640,6 +644,7 @@ fun parseUrp' accLibs fname =
                                  protocol = !protocol,
                                  dbms = !dbms,
                                  sigFile = !sigFile,
+                                 fileCache = !fileCache,
                                  safeGets = rev (!safeGets),
                                  onError = !onError,
                                  minHeap = !minHeap,
@@ -702,6 +707,7 @@ fun parseUrp' accLibs fname =
                                  protocol = mergeO #2 (#protocol old, #protocol new),
                                  dbms = mergeO #2 (#dbms old, #dbms new),
                                  sigFile = mergeO #2 (#sigFile old, #sigFile new),
+                                 fileCache = mergeO #2 (#fileCache old, #fileCache new),
                                  safeGets = #safeGets old @ #safeGets new,
                                  onError = mergeO #2 (#onError old, #onError new),
                                  minHeap = Int.max (#minHeap old, #minHeap new),
@@ -790,6 +796,10 @@ fun parseUrp' accLibs fname =
                                      (case !sigFile of
                                           NONE => sigFile := SOME arg
                                         | SOME _ => ())
+                                   | "filecache" =>
+                                     (case !fileCache of
+                                          NONE => fileCache := SOME arg
+                                        | SOME _ => ())
                                    | "exe" =>
                                      (case !exe of
                                           NONE => exe := SOME (relify arg)
@@ -1513,6 +1523,13 @@ val sigcheck = {
 
 val toSigcheck = transform sigcheck "sigcheck" o toSidecheck
 
+val filecache = {
+    func = FileCache.instrument,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toFilecache = transform filecache "filecache" o toSigcheck
+
 val sqlcache = {
     func = (fn file =>
                if Settings.getSqlcache ()
@@ -1521,7 +1538,7 @@ val sqlcache = {
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toSqlcache = transform sqlcache "sqlcache" o toSigcheck
+val toSqlcache = transform sqlcache "sqlcache" o toFilecache
 
 val cjrize = {
     func = Cjrize.cjrize,
-- 
cgit v1.2.3