Mercurial > urweb
changeset 2223:9410959d296f
Remove Sqlcache urlification hack.
| author | Ziv Scully <ziv@mit.edu> |
|---|---|
| date | Sat, 29 Nov 2014 04:34:41 -0500 |
| parents | 4d967a4ddb82 |
| children | 5709482a2afd |
| files | src/cjr_print.sml src/monoize.sml src/sqlcache.sml |
| diffstat | 3 files changed, 46 insertions(+), 89 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjr_print.sml Sat Nov 29 03:38:26 2014 -0500 +++ b/src/cjr_print.sml Sat Nov 29 04:34:41 2014 -0500 @@ -3394,7 +3394,6 @@ newline, (* For sqlcache. *) - (* TODO: also record between Cache.check and Cache.store. *) box (List.map (fn {index, params} => let val i = Int.toString index @@ -3440,14 +3439,16 @@ string i, string "(uw_context ctx", string args, - string ") {\n puts(\"SQLCACHE: checked ", - string i, - string ".\");\n if (cacheQuery", + string ") {\n if (cacheQuery", string i, (* ASK: is returning the pointer okay? Should we duplicate? *) string " == NULL", string eqs, - string ") {\n puts(\"miss D:\");\n uw_recordingStart(ctx);\n return NULL;\n } else {\n puts(\"hit :D\");\n uw_write(ctx, cacheWrite", + string ") {\n puts(\"SQLCACHE: miss ", + string i, + string ".\");\n uw_recordingStart(ctx);\n return NULL;\n } else {\n puts(\"SQLCACHE: hit ", + string i, + string ".\");\n uw_write(ctx, cacheWrite", string i, string ");\n return cacheQuery", string i, @@ -3473,7 +3474,7 @@ newline, string sets, newline, - string "puts(\"SQLCACHE: stored ", + string "puts(\"SQLCACHE: store ", string i, string ".\");\n return uw_unit_v;\n };", newline, @@ -3489,11 +3490,11 @@ string i, string ");\n cacheQuery", string i, - string " = NULL;\n puts(\"SQLCACHE: flushed ", + string " = NULL;\n puts(\"SQLCACHE: flush ", string i, - string ".\");}\n else { puts(\"SQLCACHE: keeping ", + string ".\");}\n else { puts(\"SQLCACHE: keep ", string i, - string "\"); } return uw_unit_v;\n };", + string ".\"); } return uw_unit_v;\n };", newline, newline] end)
--- a/src/monoize.sml Sat Nov 29 03:38:26 2014 -0500 +++ b/src/monoize.sml Sat Nov 29 04:34:41 2014 -0500 @@ -1982,9 +1982,6 @@ initial = (L'.ERel 1, loc), sqlcacheInfo = urlifiedRel0}, loc) - val body = if Settings.getSqlcache () - then Sqlcache.instrumentQuery (body, urlifiedRel0) - else body in ((L'.EAbs ("q", s, (L'.TFun (ft, (L'.TFun (state, (L'.TFun (un, state), loc)), loc)), loc), (L'.EAbs ("f", ft, (L'.TFun (state, (L'.TFun (un, state), loc)), loc),
--- a/src/sqlcache.sml Sat Nov 29 03:38:26 2014 -0500 +++ b/src/sqlcache.sml Sat Nov 29 04:34:41 2014 -0500 @@ -16,7 +16,7 @@ (* Some FFIs have writing as their only effect, which the caching records. *) val ffiEffectful = - (* TODO: have this less hard-coded. *) + (* ASK: how can this be less hard-coded? *) let val fs = SS.fromList ["htmlifyInt_w", "htmlifyFloat_w", @@ -46,7 +46,7 @@ false, then expression is definitely not effectful if effs is fully populated. The intended pattern is to use this a number of times equal to the number of declarations in a file, Bellman-Ford style. *) - (* TODO: make incrementing of bound less janky, probably by using MonoUtil + (* TODO: make incrementing of bound less janky, probably by using [MonoUtil] instead of all this. *) let (* DEBUG: remove printing when done. *) @@ -253,7 +253,9 @@ | ((QueryArg n, DmlRel r), SOME eqs) => SOME (addToEqs (eqs, n, DmlRel r)) | ((Prim p, QueryArg n), SOME eqs) => SOME (addToEqs (eqs, n, Prim p)) | ((DmlRel r, QueryArg n), SOME eqs) => SOME (addToEqs (eqs, n, DmlRel r)) - (* TODO: deal with equalities involving just [DmlRel]s and [Prim]s. *) + (* TODO: deal with equalities involving just [DmlRel]s and [Prim]s. + This would involve guarding the invalidation with a check for the + relevant comparisons. *) | (_, eqso) => eqso val eqsOfClass : atomExp list -> atomExp IM.map option = List.foldl accumulateEqs (SOME IM.empty) @@ -295,9 +297,6 @@ fun dnf (fQuery, fDml) = normalize negateCmp Dnf (Combo (Cnf, [markQuery fQuery, markDml fDml])) in - (* val conflictMaps : (Sql.cmp * Sql.sqexp * Sql.sqexp) formula *) - (* * (Sql.cmp * Sql.sqexp * Sql.sqexp) formula *) - (* -> atomExp IM.map list = *) List.mapPartial (mergeEqs o map eqsOfClass o equivClasses) o dnf end @@ -402,63 +401,27 @@ val incRels = incRelsBound 0 -(* Filled in by instrumentQuery during [Monoize], used during [Sqlcache]. *) -val urlifiedRel0s : Mono.exp IM.map ref = ref IM.empty - -(* Used by [Monoize]. *) -val instrumentQuery = +fun cacheWrap (query, i, urlifiedRel0, resultTyp, args) = let - val nextQuery = ref 0 - fun iq (query, urlifiedRel0) = - case query of - (EQuery {state = typ, ...}, loc) => - let - val i = !nextQuery before nextQuery := !nextQuery + 1 - in - urlifiedRel0s := IM.insert (!urlifiedRel0s, i, urlifiedRel0); - (ELet (varPrefix ^ Int.toString i, typ, query, - (* Uses a dummy FFI call to keep the urlified expression around, which - in turn keeps the declarations required for urlification safe from - [MonoShake]. The dummy call is removed during [Sqlcache]. *) - (* TODO: thread a [Monoize.Fm.t] through this module. *) - (ESeq ((EFfiApp ("Sqlcache", - "dummy", - [(urlifiedRel0, stringTyp)]), - loc), - (ERel 0, loc)), - loc)), - loc) - end - | _ => raise Match + val () = ffiInfo := {index = i, params = length args} :: !ffiInfo + val loc = ErrorMsg.dummySpan + (* We ensure before this step that all arguments aren't effectful. + by turning them into local variables as needed. *) + val argTyps = map (fn e => (e, stringTyp)) args + val argTypsInc = map (fn (e, typ) => (incRels 1 e, typ)) argTyps + val check = ffiAppCache ("check", i, argTyps) + val store = ffiAppCache ("store", i, (urlifiedRel0, stringTyp) :: argTypsInc) + val rel0 = (ERel 0, loc) in - iq + ECase (check, + [((PNone stringTyp, loc), + (ELet ("q", resultTyp, query, (ESeq (store, rel0), loc)), loc)), + ((PSome (stringTyp, (PVar ("hit", stringTyp), loc)), loc), + (* Boolean is false because we're not unurlifying from a cookie. *) + (EUnurlify (rel0, resultTyp, false), loc))], + {disc = stringTyp, result = resultTyp}) end -fun cacheWrap (query, i, urlifiedRel0, args) = - case query of - (EQuery {state = typ, ...}, _) => - let - val () = ffiInfo := {index = i, params = length args} :: !ffiInfo - val loc = ErrorMsg.dummySpan - (* We ensure before this step that all arguments aren't effectful. - by turning them into local variables as needed. *) - val argTyps = map (fn e => (e, stringTyp)) args - val argTypsInc = map (fn (e, typ) => (incRels 1 e, typ)) argTyps - val check = ffiAppCache ("check", i, argTyps) - val store = ffiAppCache ("store", i, (urlifiedRel0, stringTyp) :: argTypsInc) - val rel0 = (ERel 0, loc) - in - (ECase (check, - [((PNone stringTyp, loc), - (ELet ("q", typ, query, (ESeq (store, rel0), loc)), loc)), - ((PSome (stringTyp, (PVar ("hit", stringTyp), loc)), loc), - (* Boolean is false because we're not unurlifying from a cookie. *) - (EUnurlify (rel0, typ, false), loc))], - {disc = stringTyp, result = typ}), - loc) - end - | _ => raise Match - fun fileMapfold doExp file start = case MonoUtil.File.mapfold {typ = Search.return2, exp = fn x => (fn s => Search.Continue (doExp x s)), @@ -504,23 +467,23 @@ fun addChecking file = let - fun doExp (queryInfo as (tableToIndices, indexToQueryNumArgs)) = - fn e' as ELet (v, t, - (EQuery {query = origQueryText, - initial, body, state, tables, exps, sqlcacheInfo}, queryLoc), - letBody) => + fun doExp (queryInfo as (tableToIndices, indexToQueryNumArgs, index)) = + fn e' as EQuery {query = origQueryText, + sqlcacheInfo = urlifiedRel0, + state = resultTyp, + initial, body, tables, exps} => let val (newQueryText, wrapLets, numArgs) = factorOutNontrivial origQueryText (* Increment once for each new variable just made. *) val queryExp = incRels numArgs (EQuery {query = newQueryText, + sqlcacheInfo = urlifiedRel0, + state = resultTyp, initial = initial, body = body, - state = state, tables = tables, - exps = exps, - sqlcacheInfo = sqlcacheInfo}, - queryLoc) + exps = exps}, + ErrorMsg.dummySpan) val (EQuery {query = queryText, ...}, _) = queryExp val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty queryText)) val args = List.tabulate (numArgs, fn n => (ERel n, ErrorMsg.dummySpan)) @@ -532,24 +495,20 @@ (* Ziv misses Haskell's do notation.... *) guard (safe 0 queryText andalso safe 0 initial andalso safe 2 body) ( bind (Sql.parse Sql.query queryText) (fn queryParsed => - bind (indexOfName v) (fn index => - bind (IM.find (!urlifiedRel0s, index)) (fn urlifiedRel0 => - SOME (wrapLets (ELet (v, t, - cacheWrap (queryExp, index, urlifiedRel0, args), - incRelsBound 1 numArgs letBody)), + SOME (wrapLets (cacheWrap (queryExp, index, urlifiedRel0, resultTyp, args)), (SS.foldr (fn (tab, qi) => SIMM.insert (qi, tab, index)) tableToIndices (tablesQuery queryParsed), - IM.insert (indexToQueryNumArgs, index, (queryParsed, numArgs)))))))) + IM.insert (indexToQueryNumArgs, index, (queryParsed, numArgs)), + index + 1)))) in case attempt of SOME pair => pair | NONE => (e', queryInfo) end - | ESeq ((EFfiApp ("Sqlcache", "dummy", _), _), (e', _)) => (e', queryInfo) | e' => (e', queryInfo) in - fileMapfold (fn exp => fn state => doExp state exp) file (SIMM.empty, IM.empty) + fileMapfold (fn exp => fn state => doExp state exp) file (SIMM.empty, IM.empty, 0) end val gunk : (Sql.query * Sql.dml * Mono.exp list list) list ref = ref [] @@ -601,7 +560,7 @@ (* gunk := (queryParsed, dmlParsed, invalidations (numArgs, queryParsed, dmlParsed)) :: !gunk); *) -fun addFlushing (file, (tableToIndices, indexToQueryNumArgs)) = +fun addFlushing (file, (tableToIndices, indexToQueryNumArgs, _)) = let (* TODO: write this. *) val allInvs = () (* SM.foldr (fn (x, acc) => IS.listItems x @ acc) [] tableToIndices *)