From 97115c5f804824c024a0c08c288889d29f743e64 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Mon, 21 Sep 2015 16:45:59 -0400 Subject: Use new refactored urlification in Sqlcache. --- src/cjrize.sml | 2 +- src/iflow.sml | 10 ++++------ src/jscomp.sml | 5 ++--- src/mono.sml | 3 +-- src/mono_opt.sml | 11 ++++------- src/mono_print.sml | 2 +- src/mono_util.sml | 22 +++++++++------------- src/monoize.sig | 2 -- src/monoize.sml | 14 +------------- src/sqlcache.sml | 11 ++++------- 10 files changed, 27 insertions(+), 55 deletions(-) diff --git a/src/cjrize.sml b/src/cjrize.sml index b20d6d22..5f6ae4d8 100644 --- a/src/cjrize.sml +++ b/src/cjrize.sml @@ -431,7 +431,7 @@ fun cifyExp (eAll as (e, loc), sm) = | 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 diff --git a/src/iflow.sml b/src/iflow.sml index b8346baa..f68d8f72 100644 --- a/src/iflow.sml +++ b/src/iflow.sml @@ -1870,15 +1870,14 @@ val namer = MonoUtil.File.map {typ = fn t => t, 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 @@ fun check (file : file) = | 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 => () diff --git a/src/jscomp.sml b/src/jscomp.sml index e5f7d234..4c6bf0a9 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -1178,7 +1178,7 @@ fun process (file : file) = ((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 @@ fun process (file : file) = 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 diff --git a/src/mono.sml b/src/mono.sml index 5185e48c..b05c3dcc 100644 --- a/src/mono.sml +++ b/src/mono.sml @@ -107,8 +107,7 @@ datatype exp' = 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 diff --git a/src/mono_opt.sml b/src/mono_opt.sml index f4cd6895..186f6c62 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -405,20 +405,18 @@ fun exp e = 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 @@ fun exp e = EQuery {exps = exps, tables = tables, query = query, state = (TRecord [], loc), initial = (ERecord [], loc), - body = body, - sqlcacheInfo = Monoize.urlifiedUnit} + body = body} end else e diff --git a/src/mono_print.sml b/src/mono_print.sml index 0ff51f37..3e498d2c 100644 --- a/src/mono_print.sml +++ b/src/mono_print.sml @@ -310,7 +310,7 @@ fun p_exp' par env (e, _) = 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 "] [", diff --git a/src/mono_util.sml b/src/mono_util.sml index ba10ad32..5d7eb164 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -314,7 +314,7 @@ fun mapfoldB {typ = fc, exp = fe, bind} = 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 @@ fun mapfoldB {typ = fc, exp = fe, bind} = 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, diff --git a/src/monoize.sig b/src/monoize.sig index 549bf6ee..951db01b 100644 --- a/src/monoize.sig +++ b/src/monoize.sig @@ -31,6 +31,4 @@ signature MONOIZE = sig val liftExpInExp : int -> Mono.exp -> Mono.exp - val urlifiedUnit : Mono.exp - end diff --git a/src/monoize.sml b/src/monoize.sml index f92d7511..8f6b298d 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -395,16 +395,6 @@ fun fooifyExp fk env = 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (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), diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 8efe999c..6b4216ea 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -493,16 +493,16 @@ fun incRels inc = 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 @@ fun addChecking file = 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 @@ fun addChecking file = (* 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 @@ fun addChecking file = (* 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), -- cgit v1.2.3