Mercurial > urweb
changeset 2230:a749acc51ae4
Factor out cache implementation from Sqlcache.
| author | Ziv Scully <ziv@mit.edu> |
|---|---|
| date | Wed, 06 May 2015 14:50:29 -0400 |
| parents | 54884b28b6c6 |
| children | 67e801cf42c6 |
| files | src/cjr_print.sml src/sources src/sqlcache.sml |
| diffstat | 3 files changed, 19 insertions(+), 141 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjr_print.sml Tue Apr 07 17:26:53 2015 -0400 +++ b/src/cjr_print.sml Wed May 06 14:50:29 2015 -0400 @@ -3404,111 +3404,7 @@ newline, (* For sqlcache. *) - box (List.map - (fn {index, params} => - let val i = Int.toString index - fun paramRepeat itemi sep = - let - fun f n = - if n < 0 then "" - else if n = 0 then itemi (Int.toString 0) - else f (n-1) ^ sep ^ itemi (Int.toString n) - in - f (params - 1) - end - fun paramRepeatInit itemi sep = - if params = 0 then "" else sep ^ paramRepeat itemi sep - val args = paramRepeatInit (fn p => "uw_Basis_string p" ^ p) ", " - val decls = paramRepeat (fn p => "uw_Basis_string param" ^ i ^ "_" - ^ p ^ " = NULL;") - "\n" - val sets = paramRepeat (fn p => "param" ^ i ^ "_" ^ p - ^ " = strdup(p" ^ p ^ ");") - "\n" - val frees = paramRepeat (fn p => "free(param" ^ i ^ "_" ^ p ^ ");") - "\n" - val eqs = paramRepeatInit (fn p => "strcmp(param" ^ i ^ "_" ^ p - ^ ", p" ^ p ^ ")") - " || " - (* Using [!=] instead of [==] to mimic [strcmp]. *) - val eqsNull = paramRepeatInit (fn p => "(p" ^ p ^ " == NULL || " - ^ "!strcmp(param" ^ i ^ "_" - ^ p ^ ", p" ^ p ^ "))") - " && " - in box [string "static char *cacheQuery", - string i, - string " = NULL;", - newline, - string "static char *cacheWrite", - string i, - string " = NULL;", - newline, - string decls, - newline, - string "static uw_Basis_string uw_Sqlcache_check", - string i, - string "(uw_context ctx", - string args, - string ") {\n if (cacheQuery", - string i, - (* ASK: is returning the pointer okay? Should we duplicate? *) - string " == NULL", - string eqs, - 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, - string ";\n } };", - newline, - string "static uw_unit uw_Sqlcache_store", - string i, - string "(uw_context ctx, uw_Basis_string s", - string args, - string ") {\n free(cacheQuery", - string i, - string "); free(cacheWrite", - string i, - string ");", - newline, - string frees, - newline, - string "cacheQuery", - string i, - string " = strdup(s); cacheWrite", - string i, - string " = uw_recordingRead(ctx);", - newline, - string sets, - newline, - string "puts(\"SQLCACHE: store ", - string i, - string ".\");\n return uw_unit_v;\n };", - newline, - string "static uw_unit uw_Sqlcache_flush", - string i, - string "(uw_context ctx", - string args, - string ") {\n if (cacheQuery", - string i, - string " != NULL", - string eqsNull, - string ") {\n free(cacheQuery", - string i, - string ");\n cacheQuery", - string i, - string " = NULL;\n puts(\"SQLCACHE: flush ", - string i, - string ".\");}\n else { puts(\"SQLCACHE: keep ", - string i, - string ".\"); } return uw_unit_v;\n };", - newline, - newline] - end) - (Sqlcache.getFfiInfo ())), + box (List.map ToyCache.setupQuery (Sqlcache.getFfiInfo ())), newline, p_list_sep newline (fn x => x) pds,
--- a/src/sources Tue Apr 07 17:26:53 2015 -0400 +++ b/src/sources Wed May 06 14:50:29 2015 -0400 @@ -175,6 +175,8 @@ $(SRC)/multimap_fn.sml +$(SRC)/toy_cache.sml + $(SRC)/sqlcache.sig $(SRC)/sqlcache.sml
--- a/src/sqlcache.sml Tue Apr 07 17:26:53 2015 -0400 +++ b/src/sqlcache.sml Wed May 06 14:50:29 2015 -0400 @@ -43,7 +43,7 @@ (* Effect analysis. *) (* Makes an exception for [EWrite] (which is recorded when caching). *) -fun effectful doPrint (effs : IS.set) (inFunction : bool) (bound : int) : Mono.exp -> bool = +fun effectful doPrint (effs : IS.set) (inFunction : bool) (bound : int) : exp -> bool = (* If result is true, expression is definitely effectful. If result is false, then expression is definitely not effectful if effs is fully populated. The intended pattern is to use this a number of times equal @@ -183,6 +183,7 @@ | Negate f => Negate (mapFormula mf f) | Combo (n, fs) => Combo (n, map (mapFormula mf) fs) + (* SQL analysis. *) val rec chooseTwos : 'a list -> ('a * 'a) list = @@ -365,33 +366,21 @@ (* Program instrumentation. *) -fun stringExp s = (EPrim (Prim.String (Prim.Normal, s)), ErrorMsg.dummySpan) +val dummyLoc = ErrorMsg.dummySpan -val stringTyp = (TFfi ("Basis", "string"), ErrorMsg.dummySpan) +fun stringExp s = (EPrim (Prim.String (Prim.Normal, s)), dummyLoc) + +val stringTyp = (TFfi ("Basis", "string"), dummyLoc) val sequence = fn (exp :: exps) => let - val loc = ErrorMsg.dummySpan + val loc = dummyLoc in List.foldl (fn (e', seq) => ESeq ((seq, loc), (e', loc))) exp exps end | _ => raise Match -(* TODO: factor out. *) -fun ffiAppCache' (func, index, args) : Mono.exp' = - EFfiApp ("Sqlcache", func ^ Int.toString index, args) - -fun ffiAppCache (func, index, args) : Mono.exp = - (ffiAppCache' (func, index, args), ErrorMsg.dummySpan) - -val varPrefix = "queryResult" - -fun indexOfName varName = - if String.isPrefix varPrefix varName - then Int.fromString (String.extract (varName, String.size varPrefix, NONE)) - else NONE - (* Always increments negative indices because that's what we need later. *) fun incRelsBound bound inc = MonoUtil.Exp.mapB @@ -407,13 +396,12 @@ fun cacheWrap (query, i, urlifiedRel0, resultTyp, args) = let val () = ffiInfo := {index = i, params = length args} :: !ffiInfo - val loc = ErrorMsg.dummySpan + val loc = dummyLoc (* 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 argsInc = map (incRels 1) args + val check = (ToyCache.check (i, args), dummyLoc) + val store = (ToyCache.store (i, argsInc, urlifiedRel0), dummyLoc) val rel0 = (ERel 0, loc) in ECase (check, @@ -436,7 +424,7 @@ fun factorOutNontrivial text = let - val loc = ErrorMsg.dummySpan + val loc = dummyLoc fun strcat (e1, e2) = (EStrcat (e1, e2), loc) val chunks = Sql.chunkify text val (newText, newVariables) = @@ -486,10 +474,10 @@ body = body, tables = tables, exps = exps}, - ErrorMsg.dummySpan) + dummyLoc) 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)) + val args = List.tabulate (numArgs, fn n => (ERel n, dummyLoc)) fun bind x f = Option.mapPartial f x fun guard b x = if b then x else NONE (* DEBUG: set first boolean argument to true to turn on printing. *) @@ -516,7 +504,7 @@ fun invalidations ((query, numArgs), dml) = let - val loc = ErrorMsg.dummySpan + val loc = dummyLoc val optionAtomExpToExp = fn NONE => (ENone stringTyp, loc) | SOME e => (ESome (stringTyp, @@ -556,16 +544,8 @@ fun addFlushing (file, (tableToIndices, indexToQueryNumArgs, _)) = let - (* ASK: does this type actually matter? It was wrong before, but things - still seemed to work. *) - val optionStringTyp = (TOption stringTyp, ErrorMsg.dummySpan) val flushes = List.concat o - map (fn (i, argss) => - map (fn args => - ffiAppCache' ("flush", i, - map (fn arg => (arg, optionStringTyp)) - args)) - argss) + map (fn (i, argss) => map (fn args => ToyCache.flush (i, args)) argss) val doExp = fn EDml (origDmlText, failureMode) => let