Mercurial > urweb

comparison src/sqlcache.sml @ 2230:a749acc51ae4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Factor out cache implementation from Sqlcache.
author Ziv Scully <ziv@mit.edu>
date Wed, 06 May 2015 14:50:29 -0400
parents adb49db02af4
children af1585e7d645
comparison
equal deleted inserted replaced
2229:54884b28b6c6 2230:a749acc51ae4
41 41
42 42
43 (* Effect analysis. *) 43 (* Effect analysis. *)
44 44
45 (* Makes an exception for [EWrite] (which is recorded when caching). *) 45 (* Makes an exception for [EWrite] (which is recorded when caching). *)
46 fun effectful doPrint (effs : IS.set) (inFunction : bool) (bound : int) : Mono.exp -> bool = 46 fun effectful doPrint (effs : IS.set) (inFunction : bool) (bound : int) : exp -> bool =
47 (* If result is true, expression is definitely effectful. If result is 47 (* If result is true, expression is definitely effectful. If result is
48 false, then expression is definitely not effectful if effs is fully 48 false, then expression is definitely not effectful if effs is fully
49 populated. The intended pattern is to use this a number of times equal 49 populated. The intended pattern is to use this a number of times equal
50 to the number of declarations in a file, Bellman-Ford style. *) 50 to the number of declarations in a file, Bellman-Ford style. *)
51 (* TODO: make incrementing of bound less janky, probably by using [MonoUtil] 51 (* TODO: make incrementing of bound less janky, probably by using [MonoUtil]
180 180
181 fun mapFormula mf = 181 fun mapFormula mf =
182 fn Atom x => Atom (mf x) 182 fn Atom x => Atom (mf x)
183 | Negate f => Negate (mapFormula mf f) 183 | Negate f => Negate (mapFormula mf f)
184 | Combo (n, fs) => Combo (n, map (mapFormula mf) fs) 184 | Combo (n, fs) => Combo (n, map (mapFormula mf) fs)
185
185 186
186 (* SQL analysis. *) 187 (* SQL analysis. *)
187 188
188 val rec chooseTwos : 'a list -> ('a * 'a) list = 189 val rec chooseTwos : 'a list -> ('a * 'a) list =
189 fn [] => [] 190 fn [] => []
363 | Sql.Update (tab, _, _) => tab 364 | Sql.Update (tab, _, _) => tab
364 365
365 366
366 (* Program instrumentation. *) 367 (* Program instrumentation. *)
367 368
368 fun stringExp s = (EPrim (Prim.String (Prim.Normal, s)), ErrorMsg.dummySpan) 369 val dummyLoc = ErrorMsg.dummySpan
369 370
370 val stringTyp = (TFfi ("Basis", "string"), ErrorMsg.dummySpan) 371 fun stringExp s = (EPrim (Prim.String (Prim.Normal, s)), dummyLoc)
372
373 val stringTyp = (TFfi ("Basis", "string"), dummyLoc)
371 374
372 val sequence = 375 val sequence =
373 fn (exp :: exps) => 376 fn (exp :: exps) =>
374 let 377 let
375 val loc = ErrorMsg.dummySpan 378 val loc = dummyLoc
376 in 379 in
377 List.foldl (fn (e', seq) => ESeq ((seq, loc), (e', loc))) exp exps 380 List.foldl (fn (e', seq) => ESeq ((seq, loc), (e', loc))) exp exps
378 end 381 end
379 | _ => raise Match 382 | _ => raise Match
380
381 (* TODO: factor out. *)
382 fun ffiAppCache' (func, index, args) : Mono.exp' =
383 EFfiApp ("Sqlcache", func ^ Int.toString index, args)
384
385 fun ffiAppCache (func, index, args) : Mono.exp =
386 (ffiAppCache' (func, index, args), ErrorMsg.dummySpan)
387
388 val varPrefix = "queryResult"
389
390 fun indexOfName varName =
391 if String.isPrefix varPrefix varName
392 then Int.fromString (String.extract (varName, String.size varPrefix, NONE))
393 else NONE
394 383
395 (* Always increments negative indices because that's what we need later. *) 384 (* Always increments negative indices because that's what we need later. *)
396 fun incRelsBound bound inc = 385 fun incRelsBound bound inc =
397 MonoUtil.Exp.mapB 386 MonoUtil.Exp.mapB
398 {typ = fn x => x, 387 {typ = fn x => x,
405 val incRels = incRelsBound 0 394 val incRels = incRelsBound 0
406 395
407 fun cacheWrap (query, i, urlifiedRel0, resultTyp, args) = 396 fun cacheWrap (query, i, urlifiedRel0, resultTyp, args) =
408 let 397 let
409 val () = ffiInfo := {index = i, params = length args} :: !ffiInfo 398 val () = ffiInfo := {index = i, params = length args} :: !ffiInfo
410 val loc = ErrorMsg.dummySpan 399 val loc = dummyLoc
411 (* We ensure before this step that all arguments aren't effectful. 400 (* We ensure before this step that all arguments aren't effectful.
412 by turning them into local variables as needed. *) 401 by turning them into local variables as needed. *)
413 val argTyps = map (fn e => (e, stringTyp)) args 402 val argsInc = map (incRels 1) args
414 val argTypsInc = map (fn (e, typ) => (incRels 1 e, typ)) argTyps 403 val check = (ToyCache.check (i, args), dummyLoc)
415 val check = ffiAppCache ("check", i, argTyps) 404 val store = (ToyCache.store (i, argsInc, urlifiedRel0), dummyLoc)
416 val store = ffiAppCache ("store", i, (urlifiedRel0, stringTyp) :: argTypsInc)
417 val rel0 = (ERel 0, loc) 405 val rel0 = (ERel 0, loc)
418 in 406 in
419 ECase (check, 407 ECase (check,
420 [((PNone stringTyp, loc), 408 [((PNone stringTyp, loc),
421 (ELet ("q", resultTyp, query, (ESeq (store, rel0), loc)), loc)), 409 (ELet ("q", resultTyp, query, (ESeq (store, rel0), loc)), loc)),
434 422
435 fun fileMap doExp file = #1 (fileMapfold (fn x => fn _ => (doExp x, ())) file ()) 423 fun fileMap doExp file = #1 (fileMapfold (fn x => fn _ => (doExp x, ())) file ())
436 424
437 fun factorOutNontrivial text = 425 fun factorOutNontrivial text =
438 let 426 let
439 val loc = ErrorMsg.dummySpan 427 val loc = dummyLoc
440 fun strcat (e1, e2) = (EStrcat (e1, e2), loc) 428 fun strcat (e1, e2) = (EStrcat (e1, e2), loc)
441 val chunks = Sql.chunkify text 429 val chunks = Sql.chunkify text
442 val (newText, newVariables) = 430 val (newText, newVariables) =
443 (* Important that this is foldr (to oppose foldl below). *) 431 (* Important that this is foldr (to oppose foldl below). *)
444 List.foldr 432 List.foldr
484 state = resultTyp, 472 state = resultTyp,
485 initial = initial, 473 initial = initial,
486 body = body, 474 body = body,
487 tables = tables, 475 tables = tables,
488 exps = exps}, 476 exps = exps},
489 ErrorMsg.dummySpan) 477 dummyLoc)
490 val (EQuery {query = queryText, ...}, _) = queryExp 478 val (EQuery {query = queryText, ...}, _) = queryExp
491 val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty queryText)) 479 val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty queryText))
492 val args = List.tabulate (numArgs, fn n => (ERel n, ErrorMsg.dummySpan)) 480 val args = List.tabulate (numArgs, fn n => (ERel n, dummyLoc))
493 fun bind x f = Option.mapPartial f x 481 fun bind x f = Option.mapPartial f x
494 fun guard b x = if b then x else NONE 482 fun guard b x = if b then x else NONE
495 (* DEBUG: set first boolean argument to true to turn on printing. *) 483 (* DEBUG: set first boolean argument to true to turn on printing. *)
496 fun safe bound = not o effectful true (effectfulMap file) false bound 484 fun safe bound = not o effectful true (effectfulMap file) false bound
497 val attempt = 485 val attempt =
514 fileMapfold (fn exp => fn state => doExp state exp) file (SIMM.empty, IM.empty, 0) 502 fileMapfold (fn exp => fn state => doExp state exp) file (SIMM.empty, IM.empty, 0)
515 end 503 end
516 504
517 fun invalidations ((query, numArgs), dml) = 505 fun invalidations ((query, numArgs), dml) =
518 let 506 let
519 val loc = ErrorMsg.dummySpan 507 val loc = dummyLoc
520 val optionAtomExpToExp = 508 val optionAtomExpToExp =
521 fn NONE => (ENone stringTyp, loc) 509 fn NONE => (ENone stringTyp, loc)
522 | SOME e => (ESome (stringTyp, 510 | SOME e => (ESome (stringTyp,
523 (case e of 511 (case e of
524 DmlRel n => ERel n 512 DmlRel n => ERel n
554 (map (map optionAtomExpToExp) o removeRedundant o map eqsToInvalidation) eqss 542 (map (map optionAtomExpToExp) o removeRedundant o map eqsToInvalidation) eqss
555 end 543 end
556 544
557 fun addFlushing (file, (tableToIndices, indexToQueryNumArgs, _)) = 545 fun addFlushing (file, (tableToIndices, indexToQueryNumArgs, _)) =
558 let 546 let
559 (* ASK: does this type actually matter? It was wrong before, but things
560 still seemed to work. *)
561 val optionStringTyp = (TOption stringTyp, ErrorMsg.dummySpan)
562 val flushes = List.concat o 547 val flushes = List.concat o
563 map (fn (i, argss) => 548 map (fn (i, argss) => map (fn args => ToyCache.flush (i, args)) argss)
564 map (fn args =>
565 ffiAppCache' ("flush", i,
566 map (fn arg => (arg, optionStringTyp))
567 args))
568 argss)
569 val doExp = 549 val doExp =
570 fn EDml (origDmlText, failureMode) => 550 fn EDml (origDmlText, failureMode) =>
571 let 551 let
572 val (newDmlText, wrapLets, numArgs) = factorOutNontrivial origDmlText 552 val (newDmlText, wrapLets, numArgs) = factorOutNontrivial origDmlText
573 val dmlText = incRels numArgs newDmlText 553 val dmlText = incRels numArgs newDmlText