From a0d66adaeceaa07e4006a0570211f7453a5b5738 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Fri, 20 Nov 2015 03:26:21 -0500 Subject: Tweak cache consolidation and choose better default. --- src/main.mlton.sml | 2 +- src/settings.sig | 2 -- src/settings.sml | 4 ---- src/sqlcache.sig | 2 ++ src/sqlcache.sml | 40 +++++++++++++++++++++------------------- 5 files changed, 24 insertions(+), 26 deletions(-) (limited to 'src') diff --git a/src/main.mlton.sml b/src/main.mlton.sml index d3d88af9..164ddfbd 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -163,7 +163,7 @@ fun oneRun args = (Settings.setSqlcache true; doArgs rest) | "-heuristic" :: h :: rest => - (Settings.setSqlcacheHeuristic h; + (Sqlcache.setHeuristic h; doArgs rest) | "-moduleOf" :: fname :: _ => (print (Compiler.moduleOf fname ^ "\n"); diff --git a/src/settings.sig b/src/settings.sig index d4bb4b08..e94832e0 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -281,8 +281,6 @@ signature SETTINGS = sig val setSqlcache : bool -> unit val getSqlcache : unit -> bool - val setSqlcacheHeuristic : string -> unit - val getSqlcacheHeuristic : unit -> string val setFilePath : string -> unit (* Sets the directory where we look for files being added below. *) diff --git a/src/settings.sml b/src/settings.sml index 073e7883..f9125c64 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -811,10 +811,6 @@ val sqlcache = ref false fun setSqlcache b = sqlcache := b fun getSqlcache () = !sqlcache -val sqlcacheHeuristic = ref "always" -fun setSqlcacheHeuristic h = sqlcacheHeuristic := h -fun getSqlcacheHeuristic () = !sqlcacheHeuristic - structure SM = BinaryMapFn(struct type ord_key = string val compare = String.compare diff --git a/src/sqlcache.sig b/src/sqlcache.sig index fabc9ebf..e264c1f0 100644 --- a/src/sqlcache.sig +++ b/src/sqlcache.sig @@ -3,6 +3,8 @@ signature SQLCACHE = sig val setCache : Cache.cache -> unit val getCache : unit -> Cache.cache +val setHeuristic : string -> unit + val getFfiInfo : unit -> {index : int, params : int} list val go : Mono.file -> Mono.file diff --git a/src/sqlcache.sml b/src/sqlcache.sml index b2c8504b..75a17e48 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -93,12 +93,11 @@ val cacheRef = ref LruCache.cache 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 @@ end = struct 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 @@ end = struct 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 @@ end = struct 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 @@ val go' = addLocking o addFlushing o addCaching o simplifySql o inlineSql 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 () -- cgit v1.2.3