# HG changeset patch # User Adam Chlipala # Date 1270415482 14400 # Node ID 7af5e2af64f49b397b8338a25d74e56ae9a5fd39 # Parent a75c66dd2aebe17389e28647928bdf2b6abfc27d Parsed a WHERE clause diff -r a75c66dd2aeb -r 7af5e2af64f4 src/iflow.sml --- a/src/iflow.sml Sun Apr 04 16:44:34 2010 -0400 +++ b/src/iflow.sml Sun Apr 04 17:11:22 2010 -0400 @@ -385,6 +385,11 @@ NONE => p2 chs | v => v +fun opt p chs = + case p chs of + NONE => SOME (NONE, chs) + | SOME (v, chs) => SOME (SOME v, chs) + fun skip cp chs = case chs of String "" :: chs => skip cp chs @@ -412,7 +417,14 @@ end | _ => NONE -fun ws p = wrap (follow p (skip (fn ch => ch = #" "))) #1 +fun ws p = wrap (follow (skip (fn ch => ch = #" ")) + (follow p (skip (fn ch => ch = #" ")))) (#1 o #2) + +fun log name p chs = + (case chs of + String s :: [] => print (name ^ ": " ^ s ^ "\n") + | _ => print (name ^ ": blocked!\n"); + p chs) fun list p chs = (alt (wrap (follow p (follow (ws (const ",")) (list p))) @@ -436,6 +448,34 @@ uw_ident)) (fn (t, ((), f)) => (t, f)) +datatype sqexp = + Field of string * string + | Binop of string * sqexp * sqexp + +val sqbrel = wrap (const "=") (fn () => "=") + +datatype ('a, 'b) sum = inl of 'a | inr of 'b + +fun sqexp chs = + alt + (wrap (follow (ws (const "(")) + (follow (ws sqexp) + (ws (const ")")))) + (fn ((), (e, ())) => e)) + (wrap + (follow (wrap sitem Field) + (alt + (wrap + (follow (ws sqbrel) + (ws sqexp)) + inl) + (always (inr ())))) + (fn (e1, sm) => + case sm of + inl (bo, e2) => Binop (bo, e1, e2) + | inr () => e1)) + chs + val select = wrap (follow (const "SELECT ") (list sitem)) (fn ((), ls) => ls) @@ -447,12 +487,15 @@ val from = wrap (follow (const "FROM ") (list fitem)) (fn ((), ls) => ls) -val query = wrap (follow select from) - (fn (fs, ts) => {Select = fs, From = ts}) +val wher = wrap (follow (ws (const "WHERE ")) sqexp) + (fn ((), ls) => ls) + +val query = wrap (follow (follow select from) (opt wher)) + (fn ((fs, ts), wher) => {Select = fs, From = ts, Where = wher}) fun queryProp rv oe e = case parse query e of - NONE => Unknown + NONE => (print "Crap\n"; Unknown) | SOME r => let val p = diff -r a75c66dd2aeb -r 7af5e2af64f4 tests/policy.ur --- a/tests/policy.ur Sun Apr 04 16:44:34 2010 -0400 +++ b/tests/policy.ur Sun Apr 04 17:11:22 2010 -0400 @@ -1,12 +1,27 @@ -table fruit : { Id : int, Nam : string, Weight : float, Secret : string } +type fruit = int +table fruit : { Id : fruit, Nam : string, Weight : float, Secret : string } + PRIMARY KEY Id, + CONSTRAINT Nam UNIQUE Nam + +type order = int +table order : { Id : order, Fruit : fruit, Qty : int, Code : int } + PRIMARY KEY Id, + CONSTRAINT Fruit FOREIGN KEY Fruit REFERENCES fruit(Id) policy query_policy (SELECT fruit.Id, fruit.Nam, fruit.Weight FROM fruit) +policy query_policy (SELECT order.Id, order.Fruit, order.Qty FROM order) fun main () = - xml <- queryX (SELECT fruit.Id, fruit.Nam - FROM fruit) - (fn x =>

{[x.Fruit.Id]}: {[x.Fruit.Nam]}

); + x1 <- queryX (SELECT fruit.Id, fruit.Nam + FROM fruit) + (fn x =>

{[x.Fruit.Id]}: {[x.Fruit.Nam]}

); + + x2 <- queryX (SELECT fruit.Nam, order.Qty + FROM fruit, order + WHERE order.Fruit = fruit.Id) + (fn x =>

{[x.Fruit.Nam]}: {[x.Order.Qty]}

); return - {xml} +

{x1} +

{x2}