diff options
author | Adam Chlipala <adamc@hcoop.net> | 2010-04-06 11:07:19 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2010-04-06 11:07:19 -0400 |
commit | 80e769bec359d261a15235f58c951ffdfdc2d0e8 (patch) | |
tree | eb5229cc85480dfe8b7f967e453ecea3db193a0d | |
parent | f91d0356ca6a514852a1dd1332a204cddf8dd1aa (diff) |
Parsing float and string SQL literals
-rw-r--r-- | src/iflow.sml | 60 | ||||
-rw-r--r-- | tests/policy.ur | 4 |
2 files changed, 46 insertions, 18 deletions
diff --git a/src/iflow.sml b/src/iflow.sml index 27655109..58b38e6c 100644 --- a/src/iflow.sml +++ b/src/iflow.sml @@ -585,6 +585,14 @@ fun wrap p f chs = NONE => NONE | SOME (v, chs) => SOME (f v, chs) +fun wrapP p f chs = + case p chs of + NONE => NONE + | SOME (v, chs) => + case f v of + NONE => NONE + | SOME r => SOME (r, chs) + fun alt p1 p2 chs = case p1 chs of NONE => p2 chs @@ -679,24 +687,42 @@ val sqbrel = altL [wrap (const "=") (fn () => Exps (fn (e1, e2) => Reln (Eq, [e1 datatype ('a, 'b) sum = inl of 'a | inr of 'b -fun int chs = +fun string chs = case chs of - String s :: chs' => - let - val (befor, after) = Substring.splitl Char.isDigit (Substring.full s) - in - if Substring.isEmpty befor then - NONE - else case Int64.fromString (Substring.string befor) of - NONE => NONE - | SOME n => SOME (n, if Substring.isEmpty after then - chs' - else - String (Substring.string after) :: chs') - end - | _ => NONE - -val prim = wrap (follow (wrap int Prim.Int) (opt (const "::int8"))) #1 + String s :: chs => + if size s >= 2 andalso String.sub (s, 0) = #"'" then + let + fun loop (cs, acc) = + case cs of + [] => NONE + | c :: cs => + if c = #"'" then + SOME (String.implode (rev acc), cs) + else if c = #"\\" then + case cs of + c :: cs => loop (cs, c :: acc) + | _ => raise Fail "Iflow.string: Unmatched backslash escape" + else + loop (cs, c :: acc) + in + case loop (String.explode (String.extract (s, 1, NONE)), []) of + NONE => NONE + | SOME (s, []) => SOME (s, chs) + | SOME (s, cs) => SOME (s, String (String.implode cs) :: chs) + end + else + NONE + | _ => NONE + +val prim = + altL [wrap (follow (wrapP (follow (keep Char.isDigit) (follow (const ".") (keep Char.isDigit))) + (fn (x, ((), y)) => Option.map Prim.Float (Real64.fromString (x ^ "." ^ y)))) + (opt (const "::float8"))) #1, + wrap (follow (wrapP (keep Char.isDigit) + (Option.map Prim.Int o Int64.fromString)) + (opt (const "::int8"))) #1, + wrap (follow (opt (const "E")) (follow string (opt (const "::text")))) + (Prim.String o #1 o #2)] fun known' chs = case chs of diff --git a/tests/policy.ur b/tests/policy.ur index db89fbe5..6f2d2d5b 100644 --- a/tests/policy.ur +++ b/tests/policy.ur @@ -35,7 +35,9 @@ fun fname r = fun main () = x1 <- queryX (SELECT fruit.Id, fruit.Nam - FROM fruit) + FROM fruit + WHERE fruit.Nam = "apple" + AND fruit.Weight = 1.23) (fn x => <xml><li>{[x.Fruit.Id]}: {[x.Fruit.Nam]}</li></xml>); x2 <- queryX (SELECT fruit.Nam, order.Qty |