Mercurial > urweb
changeset 2255:8428c534913a
Use new refactored urlification in Sqlcache.
| author | Ziv Scully <ziv@mit.edu> |
|---|---|
| date | Mon, 21 Sep 2015 16:45:59 -0400 |
| parents | 44ae2254f8fb |
| children | 6f2ea4ed573a |
| files | src/cjrize.sml src/iflow.sml src/jscomp.sml src/mono.sml src/mono_opt.sml src/mono_print.sml src/mono_util.sml src/monoize.sig src/monoize.sml src/sqlcache.sml |
| diffstat | 10 files changed, 27 insertions(+), 55 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjrize.sml Mon Sep 21 16:07:35 2015 -0400 +++ b/src/cjrize.sml Mon Sep 21 16:45:59 2015 -0400 @@ -431,7 +431,7 @@ | L.EClosure _ => (ErrorMsg.errorAt loc "Nested closure remains in code generation"; (dummye, sm)) - | L.EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | L.EQuery {exps, tables, state, query, body, initial} => let val (exps', sm) = ListUtil.foldlMap (fn ((x, t), sm) => let
--- a/src/iflow.sml Mon Sep 21 16:07:35 2015 -0400 +++ b/src/iflow.sml Mon Sep 21 16:45:59 2015 -0400 @@ -1870,15 +1870,14 @@ case e of EDml (e, fm) => nameSubexps (fn (_, e') => (EDml (e', fm), #2 e)) e - | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | EQuery {exps, tables, state, query, body, initial} => nameSubexps (fn (liftBy, e') => (EQuery {exps = exps, tables = tables, state = state, query = e', body = mliftExpInExp liftBy 2 body, - initial = mliftExpInExp liftBy 0 initial, - sqlcacheInfo = sqlcacheInfo}, + initial = mliftExpInExp liftBy 0 initial}, #2 query)) query | _ => e, decl = fn d => d} @@ -2071,12 +2070,11 @@ | ESeq (e1, e2) => (ESeq (doExp env e1, doExp env e2), loc) | ELet (x, t, e1, e2) => (ELet (x, t, doExp env e1, doExp (Unknown :: env) e2), loc) | EClosure (n, es) => (EClosure (n, map (doExp env) es), loc) - | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | EQuery {exps, tables, state, query, body, initial} => (EQuery {exps = exps, tables = tables, state = state, query = doExp env query, body = doExp (Unknown :: Unknown :: env) body, - initial = doExp env initial, - sqlcacheInfo = sqlcacheInfo}, loc) + initial = doExp env initial}, loc) | EDml (e1, mode) => (case parse dml e1 of NONE => ()
--- a/src/jscomp.sml Mon Sep 21 16:07:35 2015 -0400 +++ b/src/jscomp.sml Mon Sep 21 16:45:59 2015 -0400 @@ -1178,7 +1178,7 @@ ((EClosure (n, es), loc), st) end - | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | EQuery {exps, tables, state, query, body, initial} => let val row = exps @ map (fn (x, xts) => (x, (TRecord xts, loc))) tables val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row @@ -1189,8 +1189,7 @@ val (initial, st) = exp outer (initial, st) in ((EQuery {exps = exps, tables = tables, state = state, - query = query, body = body, initial = initial, - sqlcacheInfo = sqlcacheInfo}, loc), st) + query = query, body = body, initial = initial}, loc), st) end | EDml (e, mode) => let
--- a/src/mono.sml Mon Sep 21 16:07:35 2015 -0400 +++ b/src/mono.sml Mon Sep 21 16:45:59 2015 -0400 @@ -107,8 +107,7 @@ state : typ, query : exp, (* exp of string type containing sql query *) body : exp, - initial : exp, - sqlcacheInfo : exp } + initial : exp } | EDml of exp * failure_mode | ENextval of exp | ESetval of exp * exp
--- a/src/mono_opt.sml Mon Sep 21 16:07:35 2015 -0400 +++ b/src/mono_opt.sml Mon Sep 21 16:45:59 2015 -0400 @@ -405,20 +405,18 @@ initial = (EPrim (Prim.String (k, "")), _), body = (EStrcat ((EPrim (Prim.String (_, s)), _), (EStrcat ((ERel 0, _), - e'), _)), _), - sqlcacheInfo}, loc) => + e'), _)), _)}, loc) => if (case k of Prim.Normal => s = "" | Prim.Html => CharVector.all Char.isSpace s) then EQuery {exps = exps, tables = tables, query = query, state = (TRecord [], loc), initial = (ERecord [], loc), - body = (optExp (EWrite e', loc), loc), - sqlcacheInfo = Monoize.urlifiedUnit} + body = (optExp (EWrite e', loc), loc)} else e | EWrite (EQuery {exps, tables, state, query, initial = (EPrim (Prim.String (_, "")), _), - body, sqlcacheInfo}, loc) => + body}, loc) => let fun passLets (depth, (e', _), lets) = case e' of @@ -433,8 +431,7 @@ EQuery {exps = exps, tables = tables, query = query, state = (TRecord [], loc), initial = (ERecord [], loc), - body = body, - sqlcacheInfo = Monoize.urlifiedUnit} + body = body} end else e
--- a/src/mono_print.sml Mon Sep 21 16:07:35 2015 -0400 +++ b/src/mono_print.sml Mon Sep 21 16:45:59 2015 -0400 @@ -310,7 +310,7 @@ p_exp env e]) es, string ")"] - | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | EQuery {exps, tables, state, query, body, initial} => box [string "query[", p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) exps, string "] [",
--- a/src/mono_util.sml Mon Sep 21 16:07:35 2015 -0400 +++ b/src/mono_util.sml Mon Sep 21 16:45:59 2015 -0400 @@ -314,7 +314,7 @@ fn es' => (EClosure (n, es'), loc)) - | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | EQuery {exps, tables, state, query, body, initial} => S.bind2 (ListUtil.mapfold (fn (x, t) => S.map2 (mft t, fn t' => (x, t'))) exps, @@ -335,19 +335,15 @@ body, fn body' => (* ASK: is this the right thing to do? *) - S.bind2 (mfe ctx initial, + S.map2 (mfe ctx initial, fn initial' => - S.map2 (mfe (bind (ctx, RelE ("queryResult", dummyt))) - sqlcacheInfo, - fn sqlcacheInfo' => - (EQuery {exps = exps', - tables = tables', - state = state', - query = query', - body = body', - initial = initial', - sqlcacheInfo = sqlcacheInfo}, - loc)))))))) + (EQuery {exps = exps', + tables = tables', + state = state', + query = query', + body = body', + initial = initial'}, + loc))))))) | EDml (e, fm) => S.map2 (mfe ctx e,
--- a/src/monoize.sig Mon Sep 21 16:07:35 2015 -0400 +++ b/src/monoize.sig Mon Sep 21 16:45:59 2015 -0400 @@ -31,6 +31,4 @@ val liftExpInExp : int -> Mono.exp -> Mono.exp - val urlifiedUnit : Mono.exp - end
--- a/src/monoize.sml Mon Sep 21 16:07:35 2015 -0400 +++ b/src/monoize.sml Mon Sep 21 16:45:59 2015 -0400 @@ -395,16 +395,6 @@ val attrifyExp = fooifyExp MonoFooify.Attr val urlifyExp = fooifyExp MonoFooify.Url -val urlifiedUnit = - let - val loc = ErrorMsg.dummySpan - (* Urlifies [ERel 0] to match the [sqlcacheInfo] field of [EQuery]s. *) - val (urlified, _) = urlifyExp CoreEnv.empty (Fm.empty 0) - ((L'.ERel 0, loc), (L'.TRecord [], loc)) - in - urlified - end - datatype 'a failable_search = Found of 'a | NotFound @@ -1687,14 +1677,12 @@ (L'.ERel 1, loc)), loc), (L'.ERel 0, loc)), loc), (L'.ERecord [], loc)), loc) - val (urlifiedRel0, fm) = urlifyExp env fm ((L'.ERel 0, loc), state) val body = (L'.EQuery {exps = exps, tables = tables, state = state, query = (L'.ERel 3, loc), body = body', - initial = (L'.ERel 1, loc), - sqlcacheInfo = urlifiedRel0}, + initial = (L'.ERel 1, loc)}, loc) in ((L'.EAbs ("q", s, (L'.TFun (ft, (L'.TFun (state, (L'.TFun (un, state), loc)), loc)), loc),
--- a/src/sqlcache.sml Mon Sep 21 16:07:35 2015 -0400 +++ b/src/sqlcache.sml Mon Sep 21 16:45:59 2015 -0400 @@ -493,16 +493,16 @@ bind = fn (bound, MonoUtil.Exp.RelE _) => bound + 1 | (bound, _) => bound} 0 -fun cacheWrap (query, i, urlifiedRel0, resultTyp, args) = +fun cacheWrap (env, query, i, resultTyp, args) = let val () = ffiInfo := {index = i, params = length args} :: !ffiInfo val loc = dummyLoc + val rel0 = (ERel 0, loc) (* We ensure before this step that all arguments aren't effectful. by turning them into local variables as needed. *) val argsInc = map (incRels 1) args val check = (check (i, args), dummyLoc) - val store = (store (i, argsInc, urlifiedRel0), dummyLoc) - val rel0 = (ERel 0, loc) + val store = (store (i, argsInc, MonoFooify.urlify env (rel0, resultTyp)), dummyLoc) in ECase (check, [((PNone stringTyp, loc), @@ -563,8 +563,6 @@ let fun doExp env (queryInfo as (tableToIndices, indexToQueryNumArgs, index)) = fn e' as EQuery {query = origQueryText, - (* ASK: could this get messed up by inlining? *) - sqlcacheInfo = urlifiedRel0, state = resultTyp, initial, body, tables, exps} => let @@ -572,7 +570,6 @@ (* Increment once for each new variable just made. *) val queryExp = incRels numArgs (EQuery {query = newQueryText, - sqlcacheInfo = urlifiedRel0, state = resultTyp, initial = initial, body = body, @@ -599,7 +596,7 @@ (* 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 => - SOME (wrapLets (cacheWrap (queryExp, index, urlifiedRel0, resultTyp, args)), + SOME (wrapLets (cacheWrap (env, queryExp, index, resultTyp, args)), (SS.foldr (fn (tab, qi) => SIMM.insert (qi, tab, index)) tableToIndices (tablesQuery queryParsed),