Fix SQL-parsing and declaration-ordering bugs.

5 files changed, 70 insertions, 44 deletions

diff --git a/src/mono_fooify.sig b/src/mono_fooify.sig
index ef8f09c2..0cc72342 100644
--- a/src/mono_fooify.sig
+++ b/src/mono_fooify.sig
@@ -16,6 +16,7 @@ structure Fm : sig
     val lookup : t -> foo_kind -> int -> (int -> t -> vr * t) -> t * int
     val lookupList : t -> foo_kind -> Mono.typ -> (int -> t -> vr * t) -> t * int
     val enter : t -> t
+    (* This list should be reversed before adding to list of file declarations. *)
     val decls : t -> Mono.decl list
 
     val freshName : t -> int * t
@@ -32,6 +33,7 @@ val fooifyExp : foo_kind
 (* Easy-to-use interface in [Sqlcache]. Uses [Fm.canonical]. *)
 val canonicalFm : Fm.t ref (* Set at the end of [Monoize]. *)
 val urlify : MonoEnv.env -> Mono.exp * Mono.typ -> Mono.exp option
+(* This list should be reversed before adding to list of file declarations. *)
 val getNewFmDecls : unit -> Mono.decl list
 
 end
diff --git a/src/mono_fooify.sml b/src/mono_fooify.sml
index 9bf357fb..b7d0b6c6 100644
--- a/src/mono_fooify.sml
+++ b/src/mono_fooify.sml
@@ -328,7 +328,7 @@ fun getNewFmDecls () =
     let
         val fm = !canonicalFm
     in
-        (* canonicalFm := Fm.enter fm; *)
+        canonicalFm := Fm.enter fm;
         Fm.decls fm
     end
 
diff --git a/src/monoize.sml b/src/monoize.sml
index 4208f594..2e87a70b 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -4344,12 +4344,14 @@ fun monoize env file =
                             val (nullable, notNullable) = calcClientish xts
 
                             fun cond (x, v) =
-                                (L'.EStrcat (str (Settings.mangleSql x
-                                                  ^ (case v of
-                                                         Client => ""
-                                                       | Channel => " >> 32")
-                                                  ^ " = "),
-                                             target), loc)
+                                (L'.EStrcat ((L'.EStrcat (str ("(("
+                                                               ^ Settings.mangleSql x
+                                                               ^ (case v of
+                                                                      Client => ""
+                                                                    | Channel => " >> 32")
+                                                               ^ ") = "),
+                                                          target), loc),
+                                             str ")"), loc)
 
                             val e =
                                 foldl (fn ((x, v), e) =>
@@ -4490,7 +4492,7 @@ fun monoize env file =
         pvars := RM.empty;
         pvarDefs := [];
         pvarOldDefs := [];
-        MonoFooify.canonicalFm := Fm.empty (MonoUtil.File.maxName monoFile);
+        MonoFooify.canonicalFm := Fm.empty (MonoUtil.File.maxName monoFile + 1);
         monoFile
     end
 
diff --git a/src/sql.sml b/src/sql.sml
index da0143b7..08315a16 100644
--- a/src/sql.sml
+++ b/src/sql.sml
@@ -321,7 +321,7 @@ val funcName = altL [constK "COUNT",
 
 fun arithmetic pExp = follow (const "(")
                              (follow pExp
-                                     (follow (altL (map const [" + ", " - ", " * ", " / "]))
+                                     (follow (altL (map const [" + ", " - ", " * ", " / ", " >> ", " << "]))
                                              (follow pExp (const ")"))))
 
 val unmodeled = altL [const "COUNT(*)",
@@ -445,9 +445,11 @@ val insert = log "insert"
 val delete = log "delete"
                  (wrap (follow (const "DELETE FROM ")
                                (follow uw_ident
-                                       (follow (follow (opt (const " AS T_T")) (const " WHERE "))
-                                               sqexp)))
-                       (fn ((), (tab, (_, es))) => (tab, es)))
+                                       (follow (opt (const " AS T_T"))
+                                               (opt (follow (const " WHERE ") sqexp)))))
+                       (fn ((), (tab, (_, wher))) => (tab, case wher of
+                                                               SOME (_, es) => es
+                                                             | NONE => SqTrue)))
 
 val setting = log "setting"
                   (wrap (follow uw_ident (follow (const " = ") sqexp))
diff --git a/src/sqlcache.sml b/src/sqlcache.sml
index 09feeb36..4d4c7d36 100644
--- a/src/sqlcache.sml
+++ b/src/sqlcache.sml
@@ -499,6 +499,8 @@ fun cacheWrap (env, exp, resultTyp, args, i) =
     let
         val loc = dummyLoc
         val rel0 = (ERel 0, loc)
+        (* DEBUG *)
+        val () = print (Int.toString i ^ "\n")
     in
         case MonoFooify.urlify env (rel0, resultTyp) of
             NONE => NONE
@@ -506,7 +508,7 @@ fun cacheWrap (env, exp, resultTyp, args, i) =
             let
                 val () = ffiInfo := {index = i, params = length args} :: !ffiInfo
                 (* We ensure before this step that all arguments aren't effectful.
-               by turning them into local variables as needed. *)
+                   by turning them into local variables as needed. *)
                 val argsInc = map (incRels 1) args
                 val check = (check (i, args), loc)
                 val store = (store (i, argsInc, urlified), loc)
@@ -615,7 +617,9 @@ fun addChecking file =
             in
                 case attempt of
                     SOME pair => pair
-                  | NONE => (e', queryInfo)
+                  (* 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
@@ -672,6 +676,7 @@ val invalidations = Invalidations.invalidations
 
 (* DEBUG *)
 val gunk : ((Sql.query * int) * Sql.dml) list ref = ref []
+val gunk' : exp list ref = ref []
 
 fun addFlushing ((file, (tableToIndices, indexToQueryNumArgs, index)), effs) =
     let
@@ -680,26 +685,30 @@ fun addFlushing ((file, (tableToIndices, indexToQueryNumArgs, index)), effs) =
         val doExp =
          fn EDml (origDmlText, failureMode) =>
             let
+                (* DEBUG *)
+                val () = gunk' := origDmlText :: !gunk'
                 val (newDmlText, wrapLets, numArgs) = factorOutNontrivial origDmlText
                 val dmlText = incRels numArgs newDmlText
                 val dmlExp = EDml (dmlText, failureMode)
                 (* DEBUG *)
-                (* val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty dmlText)) *)
-                val invs =
+                val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty origDmlText))
+                val inval =
                     case Sql.parse Sql.dml dmlText of
                         SOME dmlParsed =>
-                        map (fn i => (case IM.find (indexToQueryNumArgs, i) of
-                                          SOME queryNumArgs =>
-                                          (* DEBUG *)
-                                          (gunk := (queryNumArgs, dmlParsed) :: !gunk;
-                                           (i, invalidations (queryNumArgs, dmlParsed)))
-                                        (* TODO: fail more gracefully. *)
-                                        | NONE => raise Match))
-                            (SIMM.findList (tableToIndices, tableDml dmlParsed))
-                      (* TODO: fail more gracefully. *)
-                      | NONE => raise Match
+                        SOME (map (fn i => (case IM.find (indexToQueryNumArgs, i) of
+                                                SOME queryNumArgs =>
+                                                (* DEBUG *)
+                                                (gunk := (queryNumArgs, dmlParsed) :: !gunk;
+                                                 (i, invalidations (queryNumArgs, dmlParsed)))
+                                              (* TODO: fail more gracefully. *)
+                                              | NONE => raise Match))
+                                  (SIMM.findList (tableToIndices, tableDml dmlParsed)))
+                      | NONE => NONE
             in
-                wrapLets (sequence (flushes invs @ [dmlExp]))
+                case inval of
+                    (* TODO: fail more gracefully. *)
+                    NONE => raise Match
+                  | SOME invs => wrapLets (sequence (flushes invs @ [dmlExp]))
             end
           | e' => e'
     in
@@ -801,6 +810,7 @@ val expSize = MonoUtil.Exp.fold {typ = #2, exp = fn (_, n) => n+1} 0
 
 structure InvalidationInfo :> sig
   type t
+  val empty : t
   val fromList : int list -> t
   val toList : t -> int list
   val union : t * t -> t
@@ -816,14 +826,16 @@ val fromList =
           | (n', SOME (n, ns)) => SOME (Int.min (n, n'), IS.add (ns, n')))
         NONE
 
+val empty = fromList []
+
 val toList =
  fn NONE => []
   | SOME (_, ns) => IS.listItems ns
 
 val union =
  fn (SOME (n1, ns1), SOME (n2, ns2)) => SOME (Int.min (n1, n2), IS.union (ns1, ns2))
-  | (NONE, x) => x
-  | (x, NONE) => x
+  | (NONE, info) => info
+  | (info, NONE) => info
 
 val unbind =
  fn (SOME (n, ns), unbound) =>
@@ -838,6 +850,15 @@ val unbind =
 
 end
 
+val unionUnbind =
+    List.foldl
+        (fn (_, NONE) => NONE
+          | ((info, unbound), SOME infoAcc) =>
+            case InvalidationInfo.unbind (info, unbound) of
+                NONE => NONE
+              | SOME info => SOME (InvalidationInfo.union (info, infoAcc)))
+        (SOME InvalidationInfo.empty)
+
 datatype subexp = Pure of unit -> exp | Impure of exp
 
 val isImpure =
@@ -936,44 +957,43 @@ fun pureCache (effs : IS.set) ((env, exp as (exp', loc)), index) : subexp * int
                        index + 1)
     end
 
-fun addPure ((decls, sideInfo), index, effs) =
+fun addPure ((decls, sideInfo), indexStart, effs) =
     let
-        fun doVal ((x, n, t, exp, s), index) =
+        fun doVal env ((x, n, t, exp, s), index) =
             let
-                val (subexp, index) = pureCache effs ((MonoEnv.empty, exp), index)
+                val (subexp, index) = pureCache effs ((env, exp), index)
             in
                 ((x, n, t, expOfSubexp subexp, s), index)
             end
-        fun doDecl' (decl', index) =
+        fun doDecl' env (decl', index) =
             case decl' of
                 DVal v =>
                 let
-                    val (v, index) = (doVal (v, index))
+                    val (v, index) = doVal env (v, index)
                 in
                     (DVal v, index)
                 end
               | DValRec vs =>
                 let
-                    val (vs, index) = ListUtil.foldlMap doVal index vs
+                    val (vs, index) = ListUtil.foldlMap (doVal env) index vs
                 in
                     (DValRec vs, index)
                 end
               | _ => (decl', index)
-        fun doDecl ((decl', loc), index) =
+        fun doDecl (decl as (decl', loc), (revDecls, env, index)) =
             let
-                val (decl', index) = doDecl' (decl', index)
+                val env = MonoEnv.declBinds env decl
+                val (decl', index) = doDecl' env (decl', index)
+                (* Important that this happens after [MonoFooify.urlify] calls! *)
+                val fmDecls = MonoFooify.getNewFmDecls ()
             in
-                ((decl', loc), index)
+                ((decl', loc) :: (fmDecls @ revDecls), env, index)
             end
-        val decls = #1 (ListUtil.foldlMap doDecl index decls)
-        (* Important that this happens after the MonoFooify.urlify calls! *)
-        val fmDecls = MonoFooify.getNewFmDecls ()
     in
-        (* ASK: fmDecls before or after? *)
-        (fmDecls @ decls, sideInfo)
+        (rev (#1 (List.foldl doDecl ([], MonoEnv.empty, indexStart) decls)), sideInfo)
     end
 
-val go' = addPure o addFlushing o addChecking o inlineSql
+val go' = addPure o addFlushing o addChecking (* DEBUG: add back [o inlineSql]. *)
 
 fun go file =
     let