summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--caching-tests/test.ur5
-rw-r--r--src/sql.sml17
-rw-r--r--src/sqlcache.sml14
3 files changed, 19 insertions, 17 deletions
diff --git a/caching-tests/test.ur b/caching-tests/test.ur
index ea64bb2d..e0dab927 100644
--- a/caching-tests/test.ur
+++ b/caching-tests/test.ur
@@ -1,12 +1,13 @@
table tab : {Id : int, Val : int, Foo : int} PRIMARY KEY Id
fun cache id =
- res <- oneOrNoRows (SELECT tab.Val FROM tab WHERE tab.Id = {[id]});
+ res <- oneOrNoRows (SELECT A.Val FROM (tab AS A JOIN tab AS B ON A.Id = B.Id)
+ WHERE B.Id = {[id]});
return <xml><body>
cache
{case res of
None => <xml>?</xml>
- | Some row => <xml>{[row.Tab.Val]}</xml>}
+ | Some row => <xml>{[row.A.Val]}</xml>}
</body></xml>
(* fun cacheAlt id = *)
diff --git a/src/sql.sml b/src/sql.sml
index 16d4210c..dfe2f968 100644
--- a/src/sql.sml
+++ b/src/sql.sml
@@ -384,12 +384,6 @@ val select = log "select"
datatype jtype = Inner | Left | Right | Full
-val jtype = wrap (ws (follow (opt (altL [wrap (const "LEFT") (fn () => Left),
- wrap (const "RIGHT") (fn () => Right),
- wrap (const "FULL") (fn () => Full)]))
- (const " JOIN ")))
- (fn (SOME jt, ()) => jt | (NONE, ()) => Inner)
-
datatype fitem =
Table of string * string (* table AS name *)
| Join of jtype * fitem * fitem * sqexp
@@ -404,17 +398,22 @@ val wher = wrap (follow (ws (const "WHERE ")) sqexp)
val orderby = log "orderby"
(wrap (follow (ws (const "ORDER BY "))
- (follow (list sqexp)
- (opt (ws (const "DESC")))))
+ (list (follow sqexp
+ (opt (ws (const "DESC"))))))
ignore)
+val jtype = altL [wrap (const "JOIN") (fn () => Inner),
+ wrap (const "LEFT JOIN") (fn () => Left),
+ wrap (const "RIGHT JOIN") (fn () => Right),
+ wrap (const "FULL JOIN") (fn () => Full)]
+
fun fitem chs = altL [wrap (follow uw_ident
(follow (const " AS ")
t_ident))
(fn (t, ((), f)) => Table (t, f)),
wrap (follow (const "(")
(follow fitem
- (follow jtype
+ (follow (ws jtype)
(follow fitem
(follow (const " ON ")
(follow sqexp
diff --git a/src/sqlcache.sml b/src/sqlcache.sml
index 9ff7c61d..ce5ad5f5 100644
--- a/src/sqlcache.sml
+++ b/src/sqlcache.sml
@@ -823,9 +823,12 @@ structure FlattenQuery = struct
| Sql.Join (jt, fi1, fi2, se) =>
concatMap (fn ((wher1, subst1)) =>
map (fn (wher2, subst2) =>
- (sqlAnd (wher1, wher2),
- (* There should be no name conflicts... Ziv hopes? *)
- unionSubst (subst1, subst2)))
+ let
+ val subst = unionSubst (subst1, subst2)
+ in
+ (* ON clause becomes part of the accumulated WHERE. *)
+ (sqlAnd (sqlAnd (wher1, wher2), applySubst subst se), subst)
+ end)
(flattenFitem fi2))
(flattenFitem fi1)
@@ -1362,14 +1365,13 @@ fun cacheQuery (effs, env, q) : subexp =
val {query = queryText, initial, body, ...} = q
val attempt =
(* Ziv misses Haskell's do notation.... *)
- (safe 0 (printExp "attempt" queryText) andalso safe 0 initial andalso safe 2 body)
+ (safe 0 queryText andalso safe 0 initial andalso safe 2 body)
<\oguard\>
(fn _ =>
- Sql.parse Sql.query (printExp "safe" queryText)
+ Sql.parse Sql.query queryText
<\obind\>
(fn queryParsed =>
let
- val _ = (printExp "parsed" queryText)
val invalInfo = InvalInfo.singleton queryParsed
fun mkExp state =
case cacheExp (env, EQuery q, invalInfo, state) of