Ur/Web: src/sqlcache.sml comparison

comparison src/sqlcache.sml @ 2223:9410959d296f

Remove Sqlcache urlification hack.

author	Ziv Scully <ziv@mit.edu>
date	Sat, 29 Nov 2014 04:34:41 -0500
parents	278e10629ba1
children	adb49db02af4

comparison

equal deleted inserted replaced

-:4d967a4ddb82
+:9410959d296f
 fun getFfiInfo () = !ffiInfo
 (* 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",
 "htmlifyString_w",
 "htmlifyBool_w",
 fun effectful doPrint (effs : IS.set) (inFunction : bool) (bound : int) : Mono.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
 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. *)
 fun tru msg = if doPrint then (print (msg ^ "\n"); true) else true
 val rec eff' =
 | _ => NONE)
 | ((QueryArg n, Prim p), SOME eqs) => SOME (addToEqs (eqs, n, Prim p))
 | ((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)
 o chooseTwos
 fun toAtomExps rel (cmp, e1, e2) =
 List.foldr (fn (SOME eqs, SOME acc) => SOME (IM.unionWith #1 (eqs, acc)) | _ => NONE)
 (SOME IM.empty)
 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
 val rec sqexpToFormula =
 fn Sql.SqTrue => Combo (Cnf, [])
 bind = fn (level, MonoUtil.Exp.RelE _) => level + 1 | (level, _) => level}
 bound
 val incRels = incRelsBound 0
-(* Filled in by instrumentQuery during [Monoize], used during [Sqlcache]. *)
+fun cacheWrap (query, i, urlifiedRel0, resultTyp, args) =
-val urlifiedRel0s : Mono.exp IM.map ref = ref IM.empty
+let
+val () = ffiInfo := {index = i, params = length args} :: !ffiInfo
-(* Used by [Monoize]. *)
+val loc = ErrorMsg.dummySpan
-val instrumentQuery =
+(* We ensure before this step that all arguments aren't effectful.
-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
-in
-iq
-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,
+ECase (check,
 [((PNone stringTyp, loc),
-(ELet ("q", typ, query, (ESeq (store, rel0), loc)), 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, typ, false), loc))],
+(EUnurlify (rel0, resultTyp, false), loc))],
-{disc = stringTyp, result = typ}),
+{disc = stringTyp, result = resultTyp})
-loc)
+end
-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)),
 decl = Search.return2} file start of
 (newText, wrapLets, numArgs)
 end
 fun addChecking file =
 let
-fun doExp (queryInfo as (tableToIndices, indexToQueryNumArgs)) =
+fun doExp (queryInfo as (tableToIndices, indexToQueryNumArgs, index)) =
-fn e' as ELet (v, t,
+fn e' as EQuery {query = origQueryText,
-(EQuery {query = origQueryText,
+sqlcacheInfo = urlifiedRel0,
-initial, body, state, tables, exps, sqlcacheInfo}, queryLoc),
+state = resultTyp,
-letBody) =>
+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,
+exps = exps},
-sqlcacheInfo = sqlcacheInfo},
+ErrorMsg.dummySpan)
-queryLoc)
 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))
 fun bind x f = Option.mapPartial f x
 fun guard b x = if b then x else NONE
 fun safe bound = not o effectful true (effectfulMap file) false bound
 val attempt =
 (* 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 =>
+SOME (wrapLets (cacheWrap (queryExp, index, urlifiedRel0, resultTyp, args)),
-bind (IM.find (!urlifiedRel0s, index)) (fn urlifiedRel0 =>
-SOME (wrapLets (ELet (v, t,
-cacheWrap (queryExp, index, urlifiedRel0, args),
-incRelsBound 1 numArgs letBody)),
 (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 []
 val gunk' : (((Sql.cmp * Sql.sqexp * Sql.sqexp) formula)
 end
 (* 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 *)
 val flushes = List.concat o
 map (fn (i, argss) =>

Mercurial > urweb

comparison src/sqlcache.sml @ 2223:9410959d296f