Ur/Web: src/sqlcache.sml comparison

comparison src/sqlcache.sml @ 2274:0730e217fc9c

First draft of more specific formulas for queries.

author	Ziv Scully <ziv@mit.edu>
date	Thu, 05 Nov 2015 01:48:42 -0500
parents	a3cac6cea625
children	ce96e166d938

comparison

equal deleted inserted replaced

-:a3cac6cea625
+:0730e217fc9c
 structure IM = IntBinaryMap
 structure SK = struct type ord_key = string val compare = String.compare end
 structure SS = BinarySetFn(SK)
 structure SM = BinaryMapFn(SK)
 structure SIMM = MultimapFn(structure KeyMap = SM structure ValSet = IS)
+(* ASK: how do we deal with heap reallocation? *)
+fun id x = x
 fun iterate f n x = if n < 0
 then raise Fail "Can't iterate function negative number of times."
 else if n = 0
 then x
 fun mapFormula mf =
 fn Atom x => Atom (mf x)
 | Negate f => Negate (mapFormula mf f)
 | Combo (j, fs) => Combo (j, map (mapFormula mf) fs)
+fun mapFormulaExps mf = mapFormula (fn (cmp, e1, e2) => (cmp, mf e1, mf e2))
 (****************)
 (* SQL Analysis *)
 (****************)
 NONE => table
 | SOME (realTable, _) => realTable
 val renameSqexp =
 fn Sql.Field (table, field) => Sql.Field (renameString table, field)
 | e => e
-fun renameAtom (cmp, e1, e2) = (cmp, renameSqexp e1, renameSqexp e2)
+(* fun renameAtom (cmp, e1, e2) = (cmp, renameSqexp e1, renameSqexp e2) *)
 in
-mapFormula renameAtom
+mapFormulaExps renameSqexp
 end
-val rec queryToFormula =
+fun queryToFormula marker =
-fn Sql.Query1 {Where = NONE, ...} => Combo (Conj, [])
+fn Sql.Query1 {Select = sitems, From = tablePairs, Where = wher} =>
-| Sql.Query1 {From = tablePairs, Where = SOME e, ...} =>
+let
-renameTables tablePairs (sqexpToFormula e)
+val fWhere = case wher of
-| Sql.Union (q1, q2) => Combo (Disj, [queryToFormula q1, queryToFormula q2])
+NONE => Combo (Conj, [])
+| SOME e => sqexpToFormula e
-fun valsToFormula (table, vals) =
+in
-Combo (Conj, map (fn (field, v) => Atom (Sql.Eq, Sql.Field (table, field), v)) vals)
+renameTables tablePairs
+(case marker of
-val rec dmlToFormula =
+NONE => fWhere
-fn Sql.Insert (table, vals) => valsToFormula (table, vals)
+| SOME markFields =>
-| Sql.Delete (table, wher) => renameTables [(table, "T")] (sqexpToFormula wher)
+let
+val fWhereMarked = mapFormulaExps markFields fWhere
+val toSqexp =
+fn Sql.SqField tf => Sql.Field tf
+| Sql.SqExp (se, _) => se
+fun ineq se = Atom (Sql.Ne, se, markFields se)
+val fIneqs = Combo (Disj, map (ineq o toSqexp) sitems)
+in
+(Combo (Conj,
+[fWhere,
+Combo (Disj,
+[Negate fWhereMarked,
+Combo (Conj, [fWhereMarked, fIneqs])])]))
+end)
+end
+| Sql.Union (q1, q2) => Combo (Disj, [queryToFormula marker q1, queryToFormula marker q2])
+fun valsToFormula (markLeft, markRight) (table, vals) =
+Combo (Conj,
+map (fn (field, v) => Atom (Sql.Eq, markLeft (Sql.Field (table, field)), markRight v))
+vals)
+(* TODO: verify logic for insertion and deletion. *)
+val rec dmlToFormulaMarker =
+fn Sql.Insert (table, vals) => (valsToFormula (id, id) (table, vals), NONE)
+| Sql.Delete (table, wher) => (renameTables [(table, "T")] (sqexpToFormula wher), NONE)
 | Sql.Update (table, vals, wher) =>
 let
 val fWhere = sqexpToFormula wher
-val fVals = valsToFormula (table, vals)
+fun fVals marks = valsToFormula marks (table, vals)
 val modifiedFields = SS.addList (SS.empty, map #1 vals)
 (* TODO: don't use field name hack. *)
-val markField =
+fun markFields table =
-fn e as Sql.Field (t, v) => if SS.member (modifiedFields, v)
+fn e as Sql.Field (t, v) => if t = table andalso SS.member (modifiedFields, v)
 then Sql.Field (t, v ^ "'")
 else e
+| Sql.SqNot e => Sql.SqNot (markFields table e)
+| Sql.Binop (r, e1, e2) => Sql.Binop (r, markFields table e1, markFields table e2)
+| Sql.SqKnown e => Sql.SqKnown (markFields table e)
+| Sql.SqFunc (s, e) => Sql.SqFunc (s, markFields table e)
 | e => e
-val mark = mapFormula (fn (cmp, e1, e2) => (cmp, markField e1, markField e2))
+val mark = mapFormulaExps (markFields "T")
 in
-renameTables [(table, "T")]
+(* Inside renameTables, we mark with table "T". Outside, we use the real table name. *)
-(Combo (Disj, [Combo (Conj, [fVals, mark fWhere]),
+(renameTables [(table, "T")]
-Combo (Conj, [mark fVals, fWhere])]))
+(Combo (Disj, [Combo (Conj, [fVals (id, markFields "T"), mark fWhere]),
-end
+Combo (Conj, [fVals (markFields "T", id), fWhere])])),
+SOME (markFields table))
-(* val rec toFormula = *)
+end
-(*  fn (Sql.Union (q1, q2), d) => Combo (Disj, [toFormula (q1, d), toFormula (q2, d)]) *)
-(*   | (q as Sql.Query1 {Select = items, ...}, d) => *)
+fun pairToFormulas (query, dml) =
-(*     let *)
+let
-(*         val selected = osequence (map (fn )) *)
+val (fDml, marker) = dmlToFormulaMarker dml
-(*     in *)
+in
-(*         case selected of *)
+(queryToFormula marker query, fDml)
-(*             NONE => (Combo (Conj, [markQuery (), markDml fDml])) *)
+end
-(*     end *)
+(* structure ToFormula = struct *)
+(*     val testOfQuery : Sql.query1 -> (Sql.cmp * Sql.sqexp * Sql.sqexp) formula = *)
+(*      fn {From = tablePairs, Where = SOME e, ...} => renameTables tablePairs (sqexpToFormula e) *)
+(*       | {Where = NONE, ...} => Combo (Conj, []) *)
+(*     (* If selecting some parsable subset of fields, says which ones. [NONE] *)
+(*        means anything could be selected. *) *)
+(*     fun fieldsOfQuery (q : Sql.query1) = *)
+(*         osequence (map (fn Sql.SqField tf => SOME tf *)
+(*                          | Sql.SqExp (Sql.Field tf) => SOME tf *)
+(*                          | _ => NONE) (#Select q)) *)
+(*     fun fieldsOfVals (table, vals, wher) = *)
+(*         let *)
+(*             val fWhere = renameTables [(table, "T")] (sqexpToFormula wher) *)
+(*             val fVals = valsToFormula (table, vals) *)
+(*             val modifiedFields = SS.addList (SS.empty, map #1 vals) *)
+(*             (* TODO: don't use field name hack. *) *)
+(*             val markField = *)
+(*              fn e as Sql.Field (t, v) => if SS.member (modifiedFields, v) *)
+(*                                          then Sql.Field (t, v ^ "'") *)
+(*                                          else e *)
+(*               | e => e *)
+(*             val mark = mapFormula (fn (cmp, e1, e2) => (cmp, markField e1, markField e2)) *)
+(*         in *)
+(*             renameTables [(table, "T")] *)
+(*                          (Combo (Disj, [Combo (Conj, [fVals, mark fWhere]), *)
+(*                                         Combo (Conj, [mark fVals, fWhere])])) *)
+(*         end *)
+(* end *)
 structure ConflictMaps = struct
 structure TK = TripleKeyFn(structure I = CmpKey
 structure J = AtomOptionKey
 structure K = AtomOptionKey)
 structure TS : ORD_SET = BinarySetFn(TK)
 val toKnownEquality =
 (* [NONE] here means unkown. Anything that isn't a comparison between two
 knowns shouldn't be used, and simply dropping unused terms is okay in
 disjunctive normal form. *)
 fn (Sql.Eq, SOME e1, SOME e2) => SOME (e1, e2)
 | _ => NONE
-val equivClasses : (Sql.cmp * atomExp option * atomExp option) list -> atomExp list list =
+fun equivClasses atoms : atomExp list list option =
-UF.classes
+let
-o List.foldl UF.union' UF.empty
+val uf = List.foldl UF.union' UF.empty (List.mapPartial toKnownEquality atoms)
-o List.mapPartial toKnownEquality
+val ineqs = List.filter (fn (cmp, _, _) =>
+cmp = Sql.Ne orelse cmp = Sql.Lt orelse cmp = Sql.Gt)
+atoms
+val contradiction =
+fn (cmp, SOME ae1, SOME ae2) => (cmp = Sql.Ne orelse cmp = Sql.Lt orelse cmp = Sql.Gt)
+andalso not (UF.together (uf, ae1, ae2))
+(* If we don't know one side of the comparision, not a contradiction. *)
+| _ => false
+in
+not (List.exists contradiction atoms) <\oguard\> SOME (UF.classes uf)
+end
 fun addToEqs (eqs, n, e) =
 case IM.find (eqs, n) of
 (* Comparing to a constant is probably better than comparing to a
 variable? Checking that existing constants match a new ones is
 o map (fn xs => TS.addList (TS.empty, xs))
 fun dnf (fQuery, fDml) =
 normalize simplify normalizeAtom Disj (Combo (Conj, [markQuery fQuery, markDml fDml]))
-val conflictMaps = List.mapPartial (mergeEqs o map eqsOfClass o equivClasses) o dnf
+val conflictMaps =
+List.mapPartial (mergeEqs o map eqsOfClass)
+o List.mapPartial equivClasses
+o dnf
 end
 val conflictMaps = ConflictMaps.conflictMaps
 in
 (map (map optionAtomExpToExp)
 o removeRedundant madeRedundantBy
 o map (eqsToInvalidation numArgs)
 o conflictMaps)
-(queryToFormula query, dmlToFormula dml)
+(pairToFormulas (query, dml))
 end
 end
 val invalidations = Invalidations.invalidations
 (* TODO: fail more gracefully. *)
 NONE => raise Match
 | SOME invs => sequence (flushes invs @ [dmlExp])
 end
 | e' => e'
+val file = fileMap doExp file
 in
 (* DEBUG *)
 (* gunk := []; *)
 ffiInfoRef := ffiInfo;
-fileMap doExp file
+file
 end
 (************************)
 (* Compiler Entry Point *)

Mercurial > urweb

comparison src/sqlcache.sml @ 2274:0730e217fc9c