Mercurial > urweb

comparison src/sqlcache.sml @ 2257:28a541bd2d23

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use referenced (rather than all) free variables as keys for pure caches.
author Ziv Scully <ziv@mit.edu>
date Sun, 27 Sep 2015 14:46:12 -0400
parents 6f2ea4ed573a
children b1ba35ce2613
comparison
equal deleted inserted replaced
2256:6f2ea4ed573a 2257:28a541bd2d23
671 (* DEBUG *) 671 (* DEBUG *)
672 val gunk : ((Sql.query * int) * Sql.dml) list ref = ref [] 672 val gunk : ((Sql.query * int) * Sql.dml) list ref = ref []
673 673
674 fun addFlushing ((file, (tableToIndices, indexToQueryNumArgs, index)), effs) = 674 fun addFlushing ((file, (tableToIndices, indexToQueryNumArgs, index)), effs) =
675 let 675 let
676 val flushes = List.concat o 676 val flushes = List.concat
677 map (fn (i, argss) => map (fn args => flush (i, args)) argss) 677 o map (fn (i, argss) => map (fn args => flush (i, args)) argss)
678 val doExp = 678 val doExp =
679 fn EDml (origDmlText, failureMode) => 679 fn EDml (origDmlText, failureMode) =>
680 let 680 let
681 val (newDmlText, wrapLets, numArgs) = factorOutNontrivial origDmlText 681 val (newDmlText, wrapLets, numArgs) = factorOutNontrivial origDmlText
682 val dmlText = incRels numArgs newDmlText 682 val dmlText = incRels numArgs newDmlText
781 781
782 (*******************************) 782 (*******************************)
783 (* Caching Pure Subexpressions *) 783 (* Caching Pure Subexpressions *)
784 (*******************************) 784 (*******************************)
785 785
786 val freeVars =
787 IS.listItems
788 o MonoUtil.Exp.foldB
789 {typ = #2,
790 exp = fn (bound, ERel n, vars) => if n < bound
791 then vars
792 else IS.add (vars, n - bound)
793 | (_, _, vars) => vars,
794 bind = fn (bound, MonoUtil.Exp.RelE _) => bound + 1 | (bound, _) => bound}
795 0
796 IS.empty
797
786 datatype subexp = Pure of unit -> exp | Impure of exp 798 datatype subexp = Pure of unit -> exp | Impure of exp
787 799
788 val isImpure = 800 val isImpure =
789 fn Pure _ => false 801 fn Pure _ => false
790 | Impure _ => true 802 | Impure _ => true
796 fun makeCache (env, exp', index) = 808 fun makeCache (env, exp', index) =
797 case typOfExp' env exp' of 809 case typOfExp' env exp' of
798 NONE => NONE 810 NONE => NONE
799 | SOME (TFun _, _) => NONE 811 | SOME (TFun _, _) => NONE
800 | SOME typ => 812 | SOME typ =>
801 case ListUtil.foldri (fn (_, _, NONE) => NONE 813 case List.foldr (fn ((_, _), NONE) => NONE
802 | (n, typ, SOME args) => 814 | ((n, typ), SOME args) =>
803 case MonoFooify.urlify env ((ERel n, dummyLoc), typ) of 815 case MonoFooify.urlify env ((ERel n, dummyLoc), typ) of
804 NONE => NONE 816 NONE => NONE
805 | SOME arg => SOME (arg :: args)) 817 | SOME arg => SOME (arg :: args))
806 (SOME []) 818 (SOME [])
807 (MonoEnv.typeContext env) of 819 (map (fn n => (n, #2 (MonoEnv.lookupERel env n)))
820 (freeVars (exp', dummyLoc))) of
808 NONE => NONE 821 NONE => NONE
809 | SOME args => cacheWrap (env, (exp', dummyLoc), typ, args, index) 822 | SOME args => cacheWrap (env, (exp', dummyLoc), typ, args, index)
810 823
811 fun pureCache (effs : IS.set) ((env, exp as (exp', loc)), index) : subexp * int = 824 fun pureCache (effs : IS.set) ((env, exp as (exp', loc)), index) : subexp * int =
812 let 825 let
904 val decls = #1 (ListUtil.foldlMap doDecl index decls) 917 val decls = #1 (ListUtil.foldlMap doDecl index decls)
905 (* Important that this happens after the MonoFooify.urlify calls! *) 918 (* Important that this happens after the MonoFooify.urlify calls! *)
906 val fmDecls = MonoFooify.getNewFmDecls () 919 val fmDecls = MonoFooify.getNewFmDecls ()
907 in 920 in
908 print (Int.toString (length fmDecls)); 921 print (Int.toString (length fmDecls));
909 (decls @ fmDecls, sideInfo) 922 (* ASK: fmDecls before or after? *)
923 (fmDecls @ decls, sideInfo)
910 end 924 end
911 925
912 val go' = addPure o addFlushing o addChecking o inlineSql 926 val go' = addPure o addFlushing o addChecking o inlineSql
913 927
914 fun go file = 928 fun go file =