summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Ziv Scully <ziv@mit.edu>2015-09-21 16:45:59 -0400
committerGravatar Ziv Scully <ziv@mit.edu>2015-09-21 16:45:59 -0400
commit97115c5f804824c024a0c08c288889d29f743e64 (patch)
tree751344ca31d2f79493c53ea4c1bd00b22f1082cc /src
parent59c69b0cebc215599acc25906bd0366af03abf0c (diff)
Use new refactored urlification in Sqlcache.
Diffstat (limited to 'src')
-rw-r--r--src/cjrize.sml2
-rw-r--r--src/iflow.sml10
-rw-r--r--src/jscomp.sml5
-rw-r--r--src/mono.sml3
-rw-r--r--src/mono_opt.sml11
-rw-r--r--src/mono_print.sml2
-rw-r--r--src/mono_util.sml22
-rw-r--r--src/monoize.sig2
-rw-r--r--src/monoize.sml14
-rw-r--r--src/sqlcache.sml11
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),