Mercurial > urweb
comparison src/iflow.sml @ 1209:775357041e48
Parsing float and string SQL literals
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 06 Apr 2010 11:07:19 -0400 |
parents | b5a4c5407ae0 |
children | c5bd970e77a5 |
comparison
equal
deleted
inserted
replaced
1208:b5a4c5407ae0 | 1209:775357041e48 |
---|---|
583 fun wrap p f chs = | 583 fun wrap p f chs = |
584 case p chs of | 584 case p chs of |
585 NONE => NONE | 585 NONE => NONE |
586 | SOME (v, chs) => SOME (f v, chs) | 586 | SOME (v, chs) => SOME (f v, chs) |
587 | 587 |
588 fun wrapP p f chs = | |
589 case p chs of | |
590 NONE => NONE | |
591 | SOME (v, chs) => | |
592 case f v of | |
593 NONE => NONE | |
594 | SOME r => SOME (r, chs) | |
595 | |
588 fun alt p1 p2 chs = | 596 fun alt p1 p2 chs = |
589 case p1 chs of | 597 case p1 chs of |
590 NONE => p2 chs | 598 NONE => p2 chs |
591 | v => v | 599 | v => v |
592 | 600 |
677 wrap (const "AND") (fn () => Props And), | 685 wrap (const "AND") (fn () => Props And), |
678 wrap (const "OR") (fn () => Props Or)] | 686 wrap (const "OR") (fn () => Props Or)] |
679 | 687 |
680 datatype ('a, 'b) sum = inl of 'a | inr of 'b | 688 datatype ('a, 'b) sum = inl of 'a | inr of 'b |
681 | 689 |
682 fun int chs = | 690 fun string chs = |
683 case chs of | 691 case chs of |
684 String s :: chs' => | 692 String s :: chs => |
685 let | 693 if size s >= 2 andalso String.sub (s, 0) = #"'" then |
686 val (befor, after) = Substring.splitl Char.isDigit (Substring.full s) | 694 let |
687 in | 695 fun loop (cs, acc) = |
688 if Substring.isEmpty befor then | 696 case cs of |
689 NONE | 697 [] => NONE |
690 else case Int64.fromString (Substring.string befor) of | 698 | c :: cs => |
691 NONE => NONE | 699 if c = #"'" then |
692 | SOME n => SOME (n, if Substring.isEmpty after then | 700 SOME (String.implode (rev acc), cs) |
693 chs' | 701 else if c = #"\\" then |
694 else | 702 case cs of |
695 String (Substring.string after) :: chs') | 703 c :: cs => loop (cs, c :: acc) |
696 end | 704 | _ => raise Fail "Iflow.string: Unmatched backslash escape" |
697 | _ => NONE | 705 else |
698 | 706 loop (cs, c :: acc) |
699 val prim = wrap (follow (wrap int Prim.Int) (opt (const "::int8"))) #1 | 707 in |
708 case loop (String.explode (String.extract (s, 1, NONE)), []) of | |
709 NONE => NONE | |
710 | SOME (s, []) => SOME (s, chs) | |
711 | SOME (s, cs) => SOME (s, String (String.implode cs) :: chs) | |
712 end | |
713 else | |
714 NONE | |
715 | _ => NONE | |
716 | |
717 val prim = | |
718 altL [wrap (follow (wrapP (follow (keep Char.isDigit) (follow (const ".") (keep Char.isDigit))) | |
719 (fn (x, ((), y)) => Option.map Prim.Float (Real64.fromString (x ^ "." ^ y)))) | |
720 (opt (const "::float8"))) #1, | |
721 wrap (follow (wrapP (keep Char.isDigit) | |
722 (Option.map Prim.Int o Int64.fromString)) | |
723 (opt (const "::int8"))) #1, | |
724 wrap (follow (opt (const "E")) (follow string (opt (const "::text")))) | |
725 (Prim.String o #1 o #2)] | |
700 | 726 |
701 fun known' chs = | 727 fun known' chs = |
702 case chs of | 728 case chs of |
703 Exp (EFfi ("Basis", "sql_known"), _) :: chs => SOME ((), chs) | 729 Exp (EFfi ("Basis", "sql_known"), _) :: chs => SOME ((), chs) |
704 | _ => NONE | 730 | _ => NONE |