Mercurial > urweb

comparison src/sqlcache.sml @ 2233:af1585e7d645

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
More work factoring out Sqlcache back end.
author Ziv Scully <ziv@mit.edu>
date Wed, 06 May 2015 23:11:30 -0400
parents a749acc51ae4
children 2f7ed04332a0
comparison
equal deleted inserted replaced
2232:a07b91fa71db 2233:af1585e7d645
1 structure Sqlcache (* :> SQLCACHE *) = struct 1 structure Sqlcache :> SQLCACHE = struct
2 2
3 open Mono 3 open Mono
4 4
5 structure IS = IntBinarySet 5 structure IS = IntBinarySet
6 structure IM = IntBinaryMap 6 structure IM = IntBinaryMap
36 "urlifyChannel_w"] 36 "urlifyChannel_w"]
37 in 37 in
38 fn (m, f) => Settings.isEffectful (m, f) 38 fn (m, f) => Settings.isEffectful (m, f)
39 andalso not (m = "Basis" andalso SS.member (fs, f)) 39 andalso not (m = "Basis" andalso SS.member (fs, f))
40 end 40 end
41
42 val cache = ref ToyCache.cache
43 fun setCache c = cache := c
44 fun getCache () = !cache
41 45
42 46
43 (* Effect analysis. *) 47 (* Effect analysis. *)
44 48
45 (* Makes an exception for [EWrite] (which is recorded when caching). *) 49 (* Makes an exception for [EWrite] (which is recorded when caching). *)
364 | Sql.Update (tab, _, _) => tab 368 | Sql.Update (tab, _, _) => tab
365 369
366 370
367 (* Program instrumentation. *) 371 (* Program instrumentation. *)
368 372
373 val {check, store, flush, ...} = getCache ()
374
369 val dummyLoc = ErrorMsg.dummySpan 375 val dummyLoc = ErrorMsg.dummySpan
370 376
371 fun stringExp s = (EPrim (Prim.String (Prim.Normal, s)), dummyLoc) 377 fun stringExp s = (EPrim (Prim.String (Prim.Normal, s)), dummyLoc)
372 378
373 val stringTyp = (TFfi ("Basis", "string"), dummyLoc) 379 val stringTyp = (TFfi ("Basis", "string"), dummyLoc)
398 val () = ffiInfo := {index = i, params = length args} :: !ffiInfo 404 val () = ffiInfo := {index = i, params = length args} :: !ffiInfo
399 val loc = dummyLoc 405 val loc = dummyLoc
400 (* We ensure before this step that all arguments aren't effectful. 406 (* We ensure before this step that all arguments aren't effectful.
401 by turning them into local variables as needed. *) 407 by turning them into local variables as needed. *)
402 val argsInc = map (incRels 1) args 408 val argsInc = map (incRels 1) args
403 val check = (ToyCache.check (i, args), dummyLoc) 409 val check = (check (i, args), dummyLoc)
404 val store = (ToyCache.store (i, argsInc, urlifiedRel0), dummyLoc) 410 val store = (store (i, argsInc, urlifiedRel0), dummyLoc)
405 val rel0 = (ERel 0, loc) 411 val rel0 = (ERel 0, loc)
406 in 412 in
407 ECase (check, 413 ECase (check,
408 [((PNone stringTyp, loc), 414 [((PNone stringTyp, loc),
409 (ELet ("q", resultTyp, query, (ESeq (store, rel0), loc)), loc)), 415 (ELet ("q", resultTyp, query, (ESeq (store, rel0), loc)), loc)),
543 end 549 end
544 550
545 fun addFlushing (file, (tableToIndices, indexToQueryNumArgs, _)) = 551 fun addFlushing (file, (tableToIndices, indexToQueryNumArgs, _)) =
546 let 552 let
547 val flushes = List.concat o 553 val flushes = List.concat o
548 map (fn (i, argss) => map (fn args => ToyCache.flush (i, args)) argss) 554 map (fn (i, argss) => map (fn args => flush (i, args)) argss)
549 val doExp = 555 val doExp =
550 fn EDml (origDmlText, failureMode) => 556 fn EDml (origDmlText, failureMode) =>
551 let 557 let
552 val (newDmlText, wrapLets, numArgs) = factorOutNontrivial origDmlText 558 val (newDmlText, wrapLets, numArgs) = factorOutNontrivial origDmlText
553 val dmlText = incRels numArgs newDmlText 559 val dmlText = incRels numArgs newDmlText