Mercurial > urweb

comparison src/sqlcache.sml @ 2255:8428c534913a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use new refactored urlification in Sqlcache.
author Ziv Scully <ziv@mit.edu>
date Mon, 21 Sep 2015 16:45:59 -0400
parents e843a04499d4
children 6f2ea4ed573a
comparison
equal deleted inserted replaced
2254:44ae2254f8fb 2255:8428c534913a
491 (fn ERel n => ERel (if n >= bound orelse n < 0 then n + inc else n) 491 (fn ERel n => ERel (if n >= bound orelse n < 0 then n + inc else n)
492 | e' => e'), 492 | e' => e'),
493 bind = fn (bound, MonoUtil.Exp.RelE _) => bound + 1 | (bound, _) => bound} 493 bind = fn (bound, MonoUtil.Exp.RelE _) => bound + 1 | (bound, _) => bound}
494 0 494 0
495 495
496 fun cacheWrap (query, i, urlifiedRel0, resultTyp, args) = 496 fun cacheWrap (env, query, i, resultTyp, args) =
497 let 497 let
498 val () = ffiInfo := {index = i, params = length args} :: !ffiInfo 498 val () = ffiInfo := {index = i, params = length args} :: !ffiInfo
499 val loc = dummyLoc 499 val loc = dummyLoc
500 val rel0 = (ERel 0, loc)
500 (* We ensure before this step that all arguments aren't effectful. 501 (* We ensure before this step that all arguments aren't effectful.
501 by turning them into local variables as needed. *) 502 by turning them into local variables as needed. *)
502 val argsInc = map (incRels 1) args 503 val argsInc = map (incRels 1) args
503 val check = (check (i, args), dummyLoc) 504 val check = (check (i, args), dummyLoc)
504 val store = (store (i, argsInc, urlifiedRel0), dummyLoc) 505 val store = (store (i, argsInc, MonoFooify.urlify env (rel0, resultTyp)), dummyLoc)
505 val rel0 = (ERel 0, loc)
506 in 506 in
507 ECase (check, 507 ECase (check,
508 [((PNone stringTyp, loc), 508 [((PNone stringTyp, loc),
509 (ELet (varName "q", resultTyp, query, (ESeq (store, rel0), loc)), loc)), 509 (ELet (varName "q", resultTyp, query, (ESeq (store, rel0), loc)), loc)),
510 ((PSome (stringTyp, (PVar (varName "hit", stringTyp), loc)), loc), 510 ((PSome (stringTyp, (PVar (varName "hit", stringTyp), loc)), loc),
561 561
562 fun addChecking file = 562 fun addChecking file =
563 let 563 let
564 fun doExp env (queryInfo as (tableToIndices, indexToQueryNumArgs, index)) = 564 fun doExp env (queryInfo as (tableToIndices, indexToQueryNumArgs, index)) =
565 fn e' as EQuery {query = origQueryText, 565 fn e' as EQuery {query = origQueryText,
566 (* ASK: could this get messed up by inlining? *)
567 sqlcacheInfo = urlifiedRel0,
568 state = resultTyp, 566 state = resultTyp,
569 initial, body, tables, exps} => 567 initial, body, tables, exps} =>
570 let 568 let
571 val (newQueryText, wrapLets, numArgs) = factorOutNontrivial origQueryText 569 val (newQueryText, wrapLets, numArgs) = factorOutNontrivial origQueryText
572 (* Increment once for each new variable just made. *) 570 (* Increment once for each new variable just made. *)
573 val queryExp = incRels numArgs 571 val queryExp = incRels numArgs
574 (EQuery {query = newQueryText, 572 (EQuery {query = newQueryText,
575 sqlcacheInfo = urlifiedRel0,
576 state = resultTyp, 573 state = resultTyp,
577 initial = initial, 574 initial = initial,
578 body = body, 575 body = body,
579 tables = tables, 576 tables = tables,
580 exps = exps}, 577 exps = exps},
597 env) 594 env)
598 val attempt = 595 val attempt =
599 (* Ziv misses Haskell's do notation.... *) 596 (* Ziv misses Haskell's do notation.... *)
600 guard (safe 0 queryText andalso safe 0 initial andalso safe 2 body) ( 597 guard (safe 0 queryText andalso safe 0 initial andalso safe 2 body) (
601 bind (Sql.parse Sql.query queryText) (fn queryParsed => 598 bind (Sql.parse Sql.query queryText) (fn queryParsed =>
602 SOME (wrapLets (cacheWrap (queryExp, index, urlifiedRel0, resultTyp, args)), 599 SOME (wrapLets (cacheWrap (env, queryExp, index, resultTyp, args)),
603 (SS.foldr (fn (tab, qi) => SIMM.insert (qi, tab, index)) 600 (SS.foldr (fn (tab, qi) => SIMM.insert (qi, tab, index))
604 tableToIndices 601 tableToIndices
605 (tablesQuery queryParsed), 602 (tablesQuery queryParsed),
606 IM.insert (indexToQueryNumArgs, index, (queryParsed, numArgs)), 603 IM.insert (indexToQueryNumArgs, index, (queryParsed, numArgs)),
607 index + 1)))) 604 index + 1))))