Mercurial > urweb
diff src/iflow.sml @ 1242:4ed556678214
At loop heads, havoc relations that might be changed by the loop
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 17 Apr 2010 14:26:52 -0400 |
| parents | 58f5ac1bb849 |
| children | e754dc92c47c |
line wrap: on
line diff
--- a/src/iflow.sml Thu Apr 15 14:21:12 2010 -0400 +++ b/src/iflow.sml Sat Apr 17 14:26:52 2010 -0400 @@ -1837,36 +1837,34 @@ val r = Var (St.nextVar ()) val acc = Var (St.nextVar ()) + + val touched = MonoUtil.Exp.fold {typ = fn (_, touched) => touched, + exp = fn (e, touched) => + case e of + EDml e => + (case parse dml e of + NONE => touched + | SOME c => + case c of + Insert _ => touched + | Delete (tab, _) => + SS.add (touched, tab) + | Update (tab, _, _) => + SS.add (touched, tab)) + | _ => touched} + SS.empty b in - if MonoUtil.Exp.existsB {typ = fn _ => false, - exp = fn (n, e) => - case e of - ERel n' => n' = n - | _ => false, - bind = fn (n, b) => - case b of - MonoUtil.Exp.RelE _ => n + 1 - | _ => n} - 0 b then - doQuery {Env = env, - NextVar = Var o St.nextVar, - Add = fn a => St.assert [a], - Save = St.stash, - Restore = St.reinstate, - UsedExp = fn (b, e) => St.send b (e, loc), - Cont = AllCols (fn _ => evalExp - (acc :: r :: env) - b (fn _ => default ()))} q - else - doQuery {Env = env, - NextVar = Var o St.nextVar, - Add = fn a => St.assert [a], - Save = St.stash, - Restore = St.reinstate, - UsedExp = fn (b, e) => St.send b (e, loc), - Cont = AllCols (fn x => - (St.assert [AReln (Eq, [r, x])]; - evalExp (acc :: r :: env) b k))} q + SS.app (St.havocReln o Sql) touched; + + doQuery {Env = env, + NextVar = Var o St.nextVar, + Add = fn a => St.assert [a], + Save = St.stash, + Restore = St.reinstate, + UsedExp = fn (b, e) => St.send b (e, loc), + Cont = AllCols (fn x => + (St.assert [AReln (Eq, [r, x])]; + evalExp (acc :: r :: env) b k))} q end) | EDml e => (case parse dml e of