Mercurial > urweb

comparison src/iflow.sml @ 1209:775357041e48

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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