Mercurial > urweb

comparison src/sqlcache.sml @ 2275:ce96e166d938

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix some table renaming issues.
author Ziv Scully <ziv@mit.edu>
date Sat, 07 Nov 2015 15:16:44 -0500
parents 0730e217fc9c
children c05f9a5e0f0f
comparison
equal deleted inserted replaced
2274:0730e217fc9c 2275:ce96e166d938
1 structure Sqlcache :> SQLCACHE = struct 1 structure Sqlcache (* DEBUG :> SQLCACHE *) = struct
2 2
3 open Mono 3 open Mono
4 4
5 structure IS = IntBinarySet 5 structure IS = IntBinarySet
6 structure IM = IntBinaryMap 6 structure IM = IntBinaryMap
565 ffiInfo = {index = index, params = numArgs} :: #ffiInfo state, 565 ffiInfo = {index = index, params = numArgs} :: #ffiInfo state,
566 index = index + 1} 566 index = index + 1}
567 567
568 end 568 end
569 569
570 (* DEBUG *)
571 val gunk0 : ((Sql.cmp * Sql.sqexp * Sql.sqexp) formula
572 * (Sql.cmp * Sql.sqexp * Sql.sqexp) formula) list ref = ref []
573 val gunk1 : (Sql.cmp * atomExp option * atomExp option) list list list ref = ref []
574 val gunk2 : exp list ref = ref []
575
570 structure UF = UnionFindFn(AtomExpKey) 576 structure UF = UnionFindFn(AtomExpKey)
571 577
572 val rec sqexpToFormula = 578 val rec sqexpToFormula =
573 fn Sql.SqTrue => Combo (Conj, []) 579 fn Sql.SqTrue => Combo (Conj, [])
574 | Sql.SqFalse => Combo (Disj, []) 580 | Sql.SqFalse => Combo (Disj, [])
577 | Sql.Binop (Sql.RLop l, p1, p2) => Combo (case l of Sql.And => Conj | Sql.Or => Disj, 583 | Sql.Binop (Sql.RLop l, p1, p2) => Combo (case l of Sql.And => Conj | Sql.Or => Disj,
578 [sqexpToFormula p1, sqexpToFormula p2]) 584 [sqexpToFormula p1, sqexpToFormula p2])
579 (* ASK: any other sqexps that can be props? *) 585 (* ASK: any other sqexps that can be props? *)
580 | _ => raise Match 586 | _ => raise Match
581 587
588 fun mapSqexpFields f =
589 fn Sql.Field (t, v) => f (t, v)
590 | Sql.SqNot e => Sql.SqNot (mapSqexpFields f e)
591 | Sql.Binop (r, e1, e2) => Sql.Binop (r, mapSqexpFields f e1, mapSqexpFields f e2)
592 | Sql.SqKnown e => Sql.SqKnown (mapSqexpFields f e)
593 | Sql.SqFunc (s, e) => Sql.SqFunc (s, mapSqexpFields f e)
594 | e => e
595
582 fun renameTables tablePairs = 596 fun renameTables tablePairs =
583 let 597 let
584 fun renameString table = 598 fun rename table =
585 case List.find (fn (_, t) => table = t) tablePairs of 599 case List.find (fn (_, t) => table = t) tablePairs of
586 NONE => table 600 NONE => table
587 | SOME (realTable, _) => realTable 601 | SOME (realTable, _) => realTable
588 val renameSqexp = 602 in
589 fn Sql.Field (table, field) => Sql.Field (renameString table, field) 603 mapSqexpFields (fn (t, f) => Sql.Field (rename t, f))
590 | e => e
591 (* fun renameAtom (cmp, e1, e2) = (cmp, renameSqexp e1, renameSqexp e2) *)
592 in
593 mapFormulaExps renameSqexp
594 end 604 end
595 605
596 fun queryToFormula marker = 606 fun queryToFormula marker =
597 fn Sql.Query1 {Select = sitems, From = tablePairs, Where = wher} => 607 fn Sql.Query1 {Select = sitems, From = tablePairs, Where = wher} =>
598 let 608 let
599 val fWhere = case wher of 609 val fWhere = case wher of
600 NONE => Combo (Conj, []) 610 NONE => Combo (Conj, [])
601 | SOME e => sqexpToFormula e 611 | SOME e => sqexpToFormula (renameTables tablePairs e)
602 in 612 in
603 renameTables tablePairs 613 case marker of
604 (case marker of 614 NONE => fWhere
605 NONE => fWhere 615 | SOME markFields =>
606 | SOME markFields => 616 let
607 let 617 val fWhereMarked = mapFormulaExps markFields fWhere
608 val fWhereMarked = mapFormulaExps markFields fWhere 618 val toSqexp =
609 val toSqexp = 619 fn Sql.SqField tf => Sql.Field tf
610 fn Sql.SqField tf => Sql.Field tf 620 | Sql.SqExp (se, _) => se
611 | Sql.SqExp (se, _) => se 621 fun ineq se = Atom (Sql.Ne, se, markFields se)
612 fun ineq se = Atom (Sql.Ne, se, markFields se) 622 val fIneqs = Combo (Disj, map (ineq o renameTables tablePairs o toSqexp) sitems)
613 val fIneqs = Combo (Disj, map (ineq o toSqexp) sitems) 623 in
614 in 624 (Combo (Conj,
615 (Combo (Conj, 625 [fWhere,
616 [fWhere, 626 Combo (Disj,
617 Combo (Disj, 627 [Negate fWhereMarked,
618 [Negate fWhereMarked, 628 Combo (Conj, [fWhereMarked, fIneqs])])]))
619 Combo (Conj, [fWhereMarked, fIneqs])])])) 629 end
620 end)
621 end 630 end
622 | Sql.Union (q1, q2) => Combo (Disj, [queryToFormula marker q1, queryToFormula marker q2]) 631 | Sql.Union (q1, q2) => Combo (Disj, [queryToFormula marker q1, queryToFormula marker q2])
623 632
624 fun valsToFormula (markLeft, markRight) (table, vals) = 633 fun valsToFormula (markLeft, markRight) (table, vals) =
625 Combo (Conj, 634 Combo (Conj,
627 vals) 636 vals)
628 637
629 (* TODO: verify logic for insertion and deletion. *) 638 (* TODO: verify logic for insertion and deletion. *)
630 val rec dmlToFormulaMarker = 639 val rec dmlToFormulaMarker =
631 fn Sql.Insert (table, vals) => (valsToFormula (id, id) (table, vals), NONE) 640 fn Sql.Insert (table, vals) => (valsToFormula (id, id) (table, vals), NONE)
632 | Sql.Delete (table, wher) => (renameTables [(table, "T")] (sqexpToFormula wher), NONE) 641 | Sql.Delete (table, wher) => (sqexpToFormula (renameTables [(table, "T")] wher), NONE)
633 | Sql.Update (table, vals, wher) => 642 | Sql.Update (table, vals, wher) =>
634 let 643 let
635 val fWhere = sqexpToFormula wher 644 val fWhere = sqexpToFormula (renameTables [(table, "T")] wher)
636 fun fVals marks = valsToFormula marks (table, vals) 645 fun fVals marks = valsToFormula marks (table, vals)
637 val modifiedFields = SS.addList (SS.empty, map #1 vals) 646 val modifiedFields = SS.addList (SS.empty, map #1 vals)
638 (* TODO: don't use field name hack. *) 647 (* TODO: don't use field name hack. *)
639 fun markFields table = 648 val markFields =
640 fn e as Sql.Field (t, v) => if t = table andalso SS.member (modifiedFields, v) 649 mapSqexpFields (fn (t, v) => if t = table andalso SS.member (modifiedFields, v)
641 then Sql.Field (t, v ^ "'") 650 then ((* DEBUG *) print ("yep" ^ Int.toString (length (!gunk0)));
642 else e 651 Sql.Field (t, v ^ "'"))
643 | Sql.SqNot e => Sql.SqNot (markFields table e) 652 else ((* DEBUG *) print (table ^ " " ^ t ^ "\n"); Sql.Field (t, v)))
644 | Sql.Binop (r, e1, e2) => Sql.Binop (r, markFields table e1, markFields table e2) 653 val mark = mapFormulaExps markFields
645 | Sql.SqKnown e => Sql.SqKnown (markFields table e) 654 in
646 | Sql.SqFunc (s, e) => Sql.SqFunc (s, markFields table e) 655 ((Combo (Disj, [Combo (Conj, [fVals (id, markFields), mark fWhere]),
647 | e => e 656 Combo (Conj, [fVals (markFields, id), fWhere])])),
648 val mark = mapFormulaExps (markFields "T") 657 SOME markFields)
649 in
650 (* Inside renameTables, we mark with table "T". Outside, we use the real table name. *)
651 (renameTables [(table, "T")]
652 (Combo (Disj, [Combo (Conj, [fVals (id, markFields "T"), mark fWhere]),
653 Combo (Conj, [fVals (markFields "T", id), fWhere])])),
654 SOME (markFields table))
655 end 658 end
656 659
657 fun pairToFormulas (query, dml) = 660 fun pairToFormulas (query, dml) =
658 let 661 let
659 val (fDml, marker) = dmlToFormulaMarker dml 662 val (fDml, marker) = ((* DEBUG *) print "dml\n"; dmlToFormulaMarker dml)
660 in 663 in
664 (* DEBUG *) print "query\n";
661 (queryToFormula marker query, fDml) 665 (queryToFormula marker query, fDml)
662 end 666 end
663
664 (* structure ToFormula = struct *)
665
666 (* val testOfQuery : Sql.query1 -> (Sql.cmp * Sql.sqexp * Sql.sqexp) formula = *)
667 (* fn {From = tablePairs, Where = SOME e, ...} => renameTables tablePairs (sqexpToFormula e) *)
668 (* | {Where = NONE, ...} => Combo (Conj, []) *)
669
670 (* (* If selecting some parsable subset of fields, says which ones. [NONE] *)
671 (* means anything could be selected. *) *)
672 (* fun fieldsOfQuery (q : Sql.query1) = *)
673 (* osequence (map (fn Sql.SqField tf => SOME tf *)
674 (* | Sql.SqExp (Sql.Field tf) => SOME tf *)
675 (* | _ => NONE) (#Select q)) *)
676
677 (* fun fieldsOfVals (table, vals, wher) = *)
678 (* let *)
679 (* val fWhere = renameTables [(table, "T")] (sqexpToFormula wher) *)
680 (* val fVals = valsToFormula (table, vals) *)
681 (* val modifiedFields = SS.addList (SS.empty, map #1 vals) *)
682 (* (* TODO: don't use field name hack. *) *)
683 (* val markField = *)
684 (* fn e as Sql.Field (t, v) => if SS.member (modifiedFields, v) *)
685 (* then Sql.Field (t, v ^ "'") *)
686 (* else e *)
687 (* | e => e *)
688 (* val mark = mapFormula (fn (cmp, e1, e2) => (cmp, markField e1, markField e2)) *)
689 (* in *)
690 (* renameTables [(table, "T")] *)
691 (* (Combo (Disj, [Combo (Conj, [fVals, mark fWhere]), *)
692 (* Combo (Conj, [mark fVals, fWhere])])) *)
693 (* end *)
694 (* end *)
695 667
696 structure ConflictMaps = struct 668 structure ConflictMaps = struct
697 669
698 structure TK = TripleKeyFn(structure I = CmpKey 670 structure TK = TripleKeyFn(structure I = CmpKey
699 structure J = AtomOptionKey 671 structure J = AtomOptionKey
714 val ineqs = List.filter (fn (cmp, _, _) => 686 val ineqs = List.filter (fn (cmp, _, _) =>
715 cmp = Sql.Ne orelse cmp = Sql.Lt orelse cmp = Sql.Gt) 687 cmp = Sql.Ne orelse cmp = Sql.Lt orelse cmp = Sql.Gt)
716 atoms 688 atoms
717 val contradiction = 689 val contradiction =
718 fn (cmp, SOME ae1, SOME ae2) => (cmp = Sql.Ne orelse cmp = Sql.Lt orelse cmp = Sql.Gt) 690 fn (cmp, SOME ae1, SOME ae2) => (cmp = Sql.Ne orelse cmp = Sql.Lt orelse cmp = Sql.Gt)
719 andalso not (UF.together (uf, ae1, ae2)) 691 andalso UF.together (uf, ae1, ae2)
720 (* If we don't know one side of the comparision, not a contradiction. *) 692 (* If we don't know one side of the comparision, not a contradiction. *)
721 | _ => false 693 | _ => false
722 in 694 in
723 not (List.exists contradiction atoms) <\oguard\> SOME (UF.classes uf) 695 not (List.exists contradiction atoms) <\oguard\> SOME (UF.classes uf)
724 end 696 end
812 normalize simplify normalizeAtom Disj (Combo (Conj, [markQuery fQuery, markDml fDml])) 784 normalize simplify normalizeAtom Disj (Combo (Conj, [markQuery fQuery, markDml fDml]))
813 785
814 val conflictMaps = 786 val conflictMaps =
815 List.mapPartial (mergeEqs o map eqsOfClass) 787 List.mapPartial (mergeEqs o map eqsOfClass)
816 o List.mapPartial equivClasses 788 o List.mapPartial equivClasses
789 o (fn x => (gunk1 := x :: !gunk1; x))
817 o dnf 790 o dnf
791 o (fn x => (gunk0 := x :: !gunk0; x))
818 792
819 end 793 end
820 794
821 val conflictMaps = ConflictMaps.conflictMaps 795 val conflictMaps = ConflictMaps.conflictMaps
822 796
1315 1289
1316 end 1290 end
1317 1291
1318 val invalidations = Invalidations.invalidations 1292 val invalidations = Invalidations.invalidations
1319 1293
1320 (* DEBUG *)
1321 (* val gunk : ((Sql.query * int) * Sql.dml) list ref = ref [] *)
1322 (* val gunk' : exp list ref = ref [] *)
1323
1324 fun addFlushing ((file, {tableToIndices, indexToInvalInfo, ffiInfo, ...} : state), effs) = 1294 fun addFlushing ((file, {tableToIndices, indexToInvalInfo, ffiInfo, ...} : state), effs) =
1325 let 1295 let
1326 val flushes = List.concat 1296 val flushes = List.concat
1327 o map (fn (i, argss) => map (fn args => flush (i, args)) argss) 1297 o map (fn (i, argss) => map (fn args => flush (i, args)) argss)
1328 val doExp = 1298 val doExp =
1329 fn dmlExp as EDml (dmlText, failureMode) => 1299 fn dmlExp as EDml (dmlText, failureMode) =>
1330 let 1300 let
1331 (* DEBUG *) 1301 (* DEBUG *)
1332 (* val () = gunk' := origDmlText :: !gunk' *) 1302 (* val () = gunk2 := dmlText :: !gunk2 *)
1333 (* val () = Print.preface ("SQLCACHE: ", (MonoPrint.p_exp MonoEnv.empty origDmlText)) *) 1303 (* val () = Print.preface ("SQLCACHE: ", (MonoPrint.p_exp MonoEnv.empty origDmlText)) *)
1334 val inval = 1304 val inval =
1335 case Sql.parse Sql.dml dmlText of 1305 case Sql.parse Sql.dml dmlText of
1336 SOME dmlParsed => 1306 SOME dmlParsed =>
1337 SOME (map (fn i => (case IM.find (indexToInvalInfo, i) of 1307 SOME (map (fn i => (case IM.find (indexToInvalInfo, i) of
1350 end 1320 end
1351 | e' => e' 1321 | e' => e'
1352 val file = fileMap doExp file 1322 val file = fileMap doExp file
1353 1323
1354 in 1324 in
1355 (* DEBUG *)
1356 (* gunk := []; *)
1357 ffiInfoRef := ffiInfo; 1325 ffiInfoRef := ffiInfo;
1358 file 1326 file
1359 end 1327 end
1360 1328
1361 1329