Mercurial > urweb

comparison src/sqlcache.sml @ 2301:8d772fbf59c1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
2300:57f6473b1469 2301:8d772fbf59c1
91 91
92 val cacheRef = ref LruCache.cache 92 val cacheRef = ref LruCache.cache
93 fun setCache c = cacheRef := c 93 fun setCache c = cacheRef := c
94 fun getCache () = !cacheRef 94 fun getCache () = !cacheRef
95 95
96 datatype heuristic = SmartEq (* | SmartSub *) | Always | Never | NoPureAll | NoPureOne | NoCombo 96 datatype heuristic = Smart | Always | Never | NoPureAll | NoPureOne | NoCombo
97 97
98 val heuristicRef = ref Always 98 val heuristicRef = ref NoPureOne
99 fun setHeuristic h = heuristicRef := (case h of 99 fun setHeuristic h = heuristicRef := (case h of
100 "smarteq" => SmartEq 100 "smart" => Smart
101 (* | "smartsub" => SmartSub *)
102 | "always" => Always 101 | "always" => Always
103 | "never" => Never 102 | "never" => Never
104 | "nopureall" => NoPureAll 103 | "nopureall" => NoPureAll
105 | "nopureone" => NoPureOne 104 | "nopureone" => NoPureOne
106 | "nocombo" => NoCombo 105 | "nocombo" => NoCombo
496 structure I = PK 495 structure I = PK
497 structure J = OptionKeyFn(TripleKeyFn( 496 structure J = OptionKeyFn(TripleKeyFn(
498 structure I = SK 497 structure I = SK
499 structure J = SK 498 structure J = SK
500 structure K = struct type ord_key = Mono.typ val compare = MonoUtil.Typ.compare end))) 499 structure K = struct type ord_key = Mono.typ val compare = MonoUtil.Typ.compare end)))
500 structure AS = BinarySetFn(AK)
501 structure AM = BinaryMapFn(AK) 501 structure AM = BinaryMapFn(AK)
502 502
503 (* Traversal Utilities *) 503 (* Traversal Utilities *)
504 (* TODO: get rid of unused ones. *) 504 (* TODO: get rid of unused ones. *)
505 505
613 IM.empty 613 IM.empty
614 (varsOfQuery q))] 614 (varsOfQuery q))]
615 615
616 val union = op@ 616 val union = op@
617 617
618 fun addToSqlArgsMap ((q, subst), acc) = 618 fun sqlArgsSet (q, subst) =
619 IM.foldl (fn (arg, acc) => AM.insert (acc, arg, ())) acc subst 619 IM.foldl AS.add' AS.empty subst
620 620
621 fun sqlArgsMap (qs : t) = 621 fun sqlArgsMap (qs : t) =
622 let 622 let
623 val args = 623 val args =
624 List.foldl addToSqlArgsMap AM.empty qs 624 List.foldl (fn ((q, subst), acc) =>
625 IM.foldl (fn (arg, acc) => AM.insert (acc, arg, ())) acc subst)
626 AM.empty
627 qs
625 val countRef = ref (~1) 628 val countRef = ref (~1)
626 fun count () = (countRef := !countRef + 1; !countRef) 629 fun count () = (countRef := !countRef + 1; !countRef)
627 in 630 in
628 (* Maps each arg to a different consecutive integer, starting from 0. *) 631 (* Maps each arg to a different consecutive integer, starting from 0. *)
629 AM.map count args 632 AM.map count args
647 val invalPaths = List.foldl PS.union PS.empty (map freePaths args) 650 val invalPaths = List.foldl PS.union PS.empty (map freePaths args)
648 (* TODO: make sure these variables are okay to remove from the argument list. *) 651 (* TODO: make sure these variables are okay to remove from the argument list. *)
649 val pureArgs = PS.difference (paths, invalPaths) 652 val pureArgs = PS.difference (paths, invalPaths)
650 val shouldCache = 653 val shouldCache =
651 case getHeuristic () of 654 case getHeuristic () of
652 SmartEq => 655 Smart =>
653 (case (qs, PS.numItems pureArgs) of 656 (case (qs, PS.numItems pureArgs) of
654 ((q::qs), 0) => 657 ((q::qs), 0) =>
655 let 658 let
656 val m = addToSqlArgsMap (q, AM.empty) 659 val args = sqlArgsSet q
657 val ms = map (fn q => addToSqlArgsMap (q, AM.empty)) qs 660 val argss = map sqlArgsSet qs
658 fun test (m, acc) = 661 fun test (args, acc) =
659 acc 662 acc
660 <\obind\> 663 <\obind\>
661 (fn m' => 664 (fn args' =>
662 let 665 let
663 val mm = AM.unionWith #1 (m, m') 666 val both = AS.union (args, args')
664 in 667 in
665 AM.numItems m = AM.numItems mm 668 (AS.numItems args = AS.numItems both
669 orelse AS.numItems args' = AS.numItems both)
666 <\oguard\> 670 <\oguard\>
667 (fn _ => SOME mm) 671 (fn _ => SOME both)
668 end) 672 end)
669 in 673 in
670 case List.foldl test (SOME m) ms of 674 case List.foldl test (SOME args) argss of
671 NONE => false 675 NONE => false
672 | SOME _ => true 676 | SOME _ => true
673 end 677 end
674 | _ => false) 678 | _ => false)
675 | Always => true 679 | Always => true
1712 val go' = addLocking o addFlushing o addCaching o simplifySql o inlineSql 1716 val go' = addLocking o addFlushing o addCaching o simplifySql o inlineSql
1713 1717
1714 fun go file = 1718 fun go file =
1715 let 1719 let
1716 (* TODO: do something nicer than [Sql] being in one of two modes. *) 1720 (* TODO: do something nicer than [Sql] being in one of two modes. *)
1717 val () = (resetFfiInfo (); 1721 val () = (resetFfiInfo (); Sql.sqlcacheMode := true)
1718 Sql.sqlcacheMode := true;
1719 setHeuristic (Settings.getSqlcacheHeuristic ()))
1720 val file = go' file 1722 val file = go' file
1721 (* Important that this happens after [MonoFooify.urlify] calls! *) 1723 (* Important that this happens after [MonoFooify.urlify] calls! *)
1722 val fmDecls = MonoFooify.getNewFmDecls () 1724 val fmDecls = MonoFooify.getNewFmDecls ()
1723 val () = Sql.sqlcacheMode := false 1725 val () = Sql.sqlcacheMode := false
1724 in 1726 in