diff src/sqlcache.sml @ 2301:8d772fbf59c1

Tweak cache consolidation and choose better default.
author Ziv Scully <ziv@mit.edu>
date Fri, 20 Nov 2015 03:26:21 -0500
parents 57f6473b1469
children
line wrap: on
line diff
--- a/src/sqlcache.sml	Thu Nov 19 18:13:01 2015 -0500
+++ b/src/sqlcache.sml	Fri Nov 20 03:26:21 2015 -0500
@@ -93,12 +93,11 @@
 fun setCache c = cacheRef := c
 fun getCache () = !cacheRef
 
-datatype heuristic = SmartEq (* | SmartSub *) | Always | Never | NoPureAll | NoPureOne | NoCombo
+datatype heuristic = Smart | Always | Never | NoPureAll | NoPureOne | NoCombo
 
-val heuristicRef = ref Always
+val heuristicRef = ref NoPureOne
 fun setHeuristic h = heuristicRef := (case h of
-                                          "smarteq" => SmartEq
-                                        (* | "smartsub" => SmartSub *)
+                                          "smart" => Smart
                                         | "always" => Always
                                         | "never" => Never
                                         | "nopureall" => NoPureAll
@@ -498,6 +497,7 @@
             structure I = SK
             structure J = SK
             structure K = struct type ord_key = Mono.typ val compare = MonoUtil.Typ.compare end)))
+    structure AS = BinarySetFn(AK)
     structure AM = BinaryMapFn(AK)
 
     (* Traversal Utilities *)
@@ -615,13 +615,16 @@
 
     val union = op@
 
-    fun addToSqlArgsMap ((q, subst), acc) =
-        IM.foldl (fn (arg, acc) => AM.insert (acc, arg, ())) acc subst
+    fun sqlArgsSet (q, subst) =
+        IM.foldl AS.add' AS.empty subst
 
     fun sqlArgsMap (qs : t) =
         let
             val args =
-                List.foldl addToSqlArgsMap AM.empty qs
+                List.foldl (fn ((q, subst), acc) =>
+                               IM.foldl (fn (arg, acc) => AM.insert (acc, arg, ())) acc subst)
+                           AM.empty
+                           qs
             val countRef = ref (~1)
             fun count () = (countRef := !countRef + 1; !countRef)
         in
@@ -649,25 +652,26 @@
             val pureArgs = PS.difference (paths, invalPaths)
             val shouldCache =
                 case getHeuristic () of
-                    SmartEq =>
+                    Smart =>
                     (case (qs, PS.numItems pureArgs) of
                          ((q::qs), 0) =>
                          let
-                             val m = addToSqlArgsMap (q, AM.empty)
-                             val ms = map (fn q => addToSqlArgsMap (q, AM.empty)) qs
-                             fun test (m, acc) =
+                             val args = sqlArgsSet q
+                             val argss = map sqlArgsSet qs
+                             fun test (args, acc) =
                                  acc
                                  <\obind\>
-                                  (fn m' =>
+                                  (fn args' =>
                                       let
-                                          val mm = AM.unionWith #1 (m, m')
+                                          val both = AS.union (args, args')
                                       in
-                                          AM.numItems m = AM.numItems mm
+                                          (AS.numItems args = AS.numItems both
+                                           orelse AS.numItems args' = AS.numItems both)
                                           <\oguard\>
-                                           (fn _ => SOME mm)
+                                           (fn _ => SOME both)
                                       end)
                          in
-                             case List.foldl test (SOME m) ms of
+                             case List.foldl test (SOME args) argss of
                                  NONE => false
                                | SOME _ => true
                          end
@@ -1714,9 +1718,7 @@
 fun go file =
     let
         (* TODO: do something nicer than [Sql] being in one of two modes. *)
-        val () = (resetFfiInfo ();
-                  Sql.sqlcacheMode := true;
-                  setHeuristic (Settings.getSqlcacheHeuristic ()))
+        val () = (resetFfiInfo (); Sql.sqlcacheMode := true)
         val file = go' file
         (* Important that this happens after [MonoFooify.urlify] calls! *)
         val fmDecls = MonoFooify.getNewFmDecls ()