Mercurial > urweb
changeset 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 | ace43b90b388 |
| files | src/main.mlton.sml src/settings.sig src/settings.sml src/sqlcache.sig src/sqlcache.sml |
| diffstat | 5 files changed, 24 insertions(+), 26 deletions(-) [+] |
line wrap: on
line diff
--- a/src/main.mlton.sml Thu Nov 19 18:13:01 2015 -0500 +++ b/src/main.mlton.sml Fri Nov 20 03:26:21 2015 -0500 @@ -163,7 +163,7 @@ (Settings.setSqlcache true; doArgs rest) | "-heuristic" :: h :: rest => - (Settings.setSqlcacheHeuristic h; + (Sqlcache.setHeuristic h; doArgs rest) | "-moduleOf" :: fname :: _ => (print (Compiler.moduleOf fname ^ "\n");
--- a/src/settings.sig Thu Nov 19 18:13:01 2015 -0500 +++ b/src/settings.sig Fri Nov 20 03:26:21 2015 -0500 @@ -281,8 +281,6 @@ 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. *)
--- a/src/settings.sml Thu Nov 19 18:13:01 2015 -0500 +++ b/src/settings.sml Fri Nov 20 03:26:21 2015 -0500 @@ -811,10 +811,6 @@ 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
--- a/src/sqlcache.sig Thu Nov 19 18:13:01 2015 -0500 +++ b/src/sqlcache.sig Fri Nov 20 03:26:21 2015 -0500 @@ -3,6 +3,8 @@ 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
--- 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 ()