diff options
| author |  Ziv Scully <ziv@mit.edu> | 2015-11-19 03:45:39 -0500 |
|---|---|---|
| committer | Ziv Scully <ziv@mit.edu> | 2015-11-19 03:45:39 -0500 |
| commit | 0c231060050adf556348b06f078c994f4a0e65b4 (patch) | |
| tree | f88b73ae276f7df0a9a7543b8d9569312d9fb2a5 | |
| parent | bfcd84434ee997b474935aa13ae7bc1f3801d795 (diff) | |
Fix SQL parser JOIN bug and fix ON clause logic in Sqlcache.
| -rw-r--r-- | caching-tests/test.ur | 5 | ||||
| -rw-r--r-- | src/sql.sml | 17 | ||||
| -rw-r--r-- | src/sqlcache.sml | 14 |
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 |