changeset 2264:bbcf9ba9b39a

Fix another mismatch between expunger SQL generation and SQL parser.
author Ziv Scully <ziv@mit.edu>
date Tue, 13 Oct 2015 20:24:37 -0400
parents dfadb5effdc0
children a647a1560628
files src/monoize.sml src/sqlcache.sml
diffstat 2 files changed, 68 insertions(+), 63 deletions(-) [+]
line wrap: on
line diff
--- a/src/monoize.sml	Tue Oct 13 14:22:05 2015 -0400
+++ b/src/monoize.sml	Tue Oct 13 20:24:37 2015 -0400
@@ -4371,16 +4371,19 @@
                                     [] => e
                                   | eb :: ebs =>
                                     (L'.ESeq (
-                                     (L'.EDml (foldl
-                                                   (fn (eb, s) =>
-                                                       (L'.EStrcat (s,
-                                                                    (L'.EStrcat (str " OR ",
-                                                                                 cond eb), loc)), loc))
-                                                   (L'.EStrcat (str ("DELETE FROM "
-                                                                     ^ Settings.mangleSql tab
-                                                                     ^ " WHERE "),
-                                                                cond eb), loc)
-                                                   ebs, L'.Error), loc),
+                                     (L'.EDml ((L'.EStrcat (str ("DELETE FROM "
+                                                                 ^ Settings.mangleSql tab
+                                                                 ^ " WHERE "),
+                                                            foldl (fn (eb, s) =>
+                                                                      (L'.EStrcat (str "(",
+                                                                       (L'.EStrcat (s,
+                                                                        (L'.EStrcat (str " OR ",
+                                                                         (L'.EStrcat (cond eb,
+                                                                                      str ")"),
+                                                                          loc)), loc)), loc)), loc))
+                                                                  (cond eb)
+                                                                  ebs), loc),
+                                      L'.Error), loc),
                                      e), loc)
                         in
                             e
--- a/src/sqlcache.sml	Tue Oct 13 14:22:05 2015 -0400
+++ b/src/sqlcache.sml	Tue Oct 13 20:24:37 2015 -0400
@@ -604,62 +604,64 @@
         (newText, wrapLets, numArgs)
     end
 
+fun cacheQuery effs env (queryInfo as (tableToIndices, indexToQueryNumArgs, index)) =
+ fn e' as EQuery {query = origQueryText,
+                  state = resultTyp,
+                  initial, body, tables, exps} =>
+    let
+        val (newQueryText, wrapLets, numArgs) = factorOutNontrivial origQueryText
+        (* Increment once for each new variable just made. *)
+        val queryExp = incRels numArgs
+                               (EQuery {query = newQueryText,
+                                        state = resultTyp,
+                                        initial = initial,
+                                        body = body,
+                                        tables = tables,
+                                        exps = exps},
+                                dummyLoc)
+        (* DEBUG *)
+        (* val () = Print.preface ("sqlcache> ", MonoPrint.p_exp MonoEnv.empty queryText) *)
+        val args = List.tabulate (numArgs, fn n => (ERel n, dummyLoc))
+        fun bind x f = Option.mapPartial f x
+        fun guard b x = if b then x else NONE
+        (* We use dummyTyp here. I think this is okay because databases don't
+           store (effectful) functions, but perhaps there's some pathalogical
+           corner case missing.... *)
+        fun safe bound =
+            not
+            o effectful effs
+                        (iterate (fn env => MonoEnv.pushERel env "_" dummyTyp NONE)
+                                 bound
+                                 env)
+        val textOfQuery = fn (EQuery {query, ...}, _) => SOME query | _ => NONE
+        val attempt =
+            (* Ziv misses Haskell's do notation.... *)
+            bind (textOfQuery queryExp) (fn queryText =>
+            guard (safe 0 queryText andalso safe 0 initial andalso safe 2 body) (
+            bind (Sql.parse Sql.query queryText) (fn queryParsed =>
+            bind (cacheWrap (env, queryExp, resultTyp, args, index)) (fn cachedExp =>
+            SOME (wrapLets cachedExp,
+                  (SS.foldr (fn (tab, qi) => SIMM.insert (qi, tab, index))
+                            tableToIndices
+                            (tablesQuery queryParsed),
+                   IM.insert (indexToQueryNumArgs, index, (queryParsed, numArgs)),
+                   index + 1))))))
+    in
+        case attempt of
+            SOME pair => pair
+          (* We have to increment index conservatively. *)
+          (* TODO: just use a reference for current index.... *)
+          | NONE => (e', (tableToIndices, indexToQueryNumArgs, index + 1))
+    end
+  | e' => (e', queryInfo)
+
 fun addChecking file =
     let
         val effs = effectfulDecls file
-        fun doExp env (queryInfo as (tableToIndices, indexToQueryNumArgs, index)) =
-         fn e' as EQuery {query = origQueryText,
-                          state = resultTyp,
-                          initial, body, tables, exps} =>
-            let
-                val (newQueryText, wrapLets, numArgs) = factorOutNontrivial origQueryText
-                (* Increment once for each new variable just made. *)
-                val queryExp = incRels numArgs
-                                       (EQuery {query = newQueryText,
-                                                state = resultTyp,
-                                                initial = initial,
-                                                body = body,
-                                                tables = tables,
-                                                exps = exps},
-                                        dummyLoc)
-                val (EQuery {query = queryText, ...}, _) = queryExp
-                (* DEBUG *)
-                (* val () = Print.preface ("sqlcache> ", MonoPrint.p_exp MonoEnv.empty queryText) *)
-                val args = List.tabulate (numArgs, fn n => (ERel n, dummyLoc))
-                fun bind x f = Option.mapPartial f x
-                fun guard b x = if b then x else NONE
-                (* We use dummyTyp here. I think this is okay because databases
-                   don't store (effectful) functions, but perhaps there's some
-                   pathalogical corner case missing.... *)
-                fun safe bound =
-                    not
-                    o effectful effs
-                                (iterate (fn env => MonoEnv.pushERel env "_" dummyTyp NONE)
-                                         bound
-                                         env)
-                val attempt =
-                    (* 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 =>
-                    bind (cacheWrap (env, queryExp, resultTyp, args, index)) (fn cachedExp =>
-                    SOME (wrapLets cachedExp,
-                          (SS.foldr (fn (tab, qi) => SIMM.insert (qi, tab, index))
-                                    tableToIndices
-                                    (tablesQuery queryParsed),
-                           IM.insert (indexToQueryNumArgs, index, (queryParsed, numArgs)),
-                           index + 1)))))
-            in
-                case attempt of
-                    SOME pair => pair
-                  (* We have to increment index conservatively. *)
-                  (* TODO: just use a reference for current index.... *)
-                  | NONE => (e', (tableToIndices, indexToQueryNumArgs, index + 1))
-            end
-          | e' => (e', queryInfo)
     in
-        (fileAllMapfoldB (fn env => fn exp => fn state => doExp env state exp)
-                      file
-                      (SIMM.empty, IM.empty, 0),
+        (fileAllMapfoldB (fn env => fn exp => fn state => cacheQuery effs env state exp)
+                         file
+                         (SIMM.empty, IM.empty, 0),
          effs)
     end
 
@@ -725,7 +727,7 @@
                 val dmlText = incRels numArgs newDmlText
                 val dmlExp = EDml (dmlText, failureMode)
                 (* DEBUG *)
-                (* val () = Print.preface ("SQLCACHE: ", (MonoPrint.p_exp MonoEnv.empty origDmlText)) *)
+                val () = Print.preface ("SQLCACHE: ", (MonoPrint.p_exp MonoEnv.empty origDmlText))
                 val inval =
                     case Sql.parse Sql.dml dmlText of
                         SOME dmlParsed =>