Mercurial > urweb

comparison src/lacweb.grm @ 226:b0041cc7e5f7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Basic GROUP BY
author Adam Chlipala <adamc@hcoop.net>
date Thu, 21 Aug 2008 13:59:49 -0400
parents 5ac2cf59b839
children 524e10c91478
comparison
equal deleted inserted replaced
225:5ac2cf59b839 226:b0041cc7e5f7
44 44
45 datatype select = 45 datatype select =
46 Star 46 Star
47 | Items of select_item list 47 | Items of select_item list
48 48
49 datatype group_item =
50 GField of con * con
51
49 fun eqTnames ((c1, _), (c2, _)) = 52 fun eqTnames ((c1, _), (c2, _)) =
50 case (c1, c2) of 53 case (c1, c2) of
51 (CVar (ms1, x1), CVar (ms2, x2)) => ms1 = ms2 andalso x1 = x2 54 (CVar (ms1, x1), CVar (ms2, x2)) => ms1 = ms2 andalso x1 = x2
52 | (CName x1, CName x2) => x1 = x2 55 | (CName x1, CName x2) => x1 = x2
53 | _ => false 56 | _ => false
54 57
55 fun amend_select loc (si, tabs) = 58 fun amend_select loc (si, tabs) =
56 let 59 let
57 val (tx, c) = case si of 60 val (tx, c) = case si of
58 Field (tx, fx) => (tx, (CRecord ([(fx, (CWild (KType, loc), loc))]), loc)) 61 Field (tx, fx) => (tx, (CRecord ([(fx, (CWild (KType, loc), loc))]), loc))
62
63 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
64 if eqTnames (tx, tx') then
65 ((tx', (CConcat (c, c'), loc)), true)
66 else
67 ((tx', c'), found))
68 false tabs
69 in
70 if found then
71 ()
72 else
73 ErrorMsg.errorAt loc "Select of field from unbound table";
74
75 tabs
76 end
77
78 fun amend_group loc (gi, tabs) =
79 let
80 val (tx, c) = case gi of
81 GField (tx, fx) => (tx, (CRecord ([(fx, (CWild (KType, loc), loc))]), loc))
59 82
60 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) => 83 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
61 if eqTnames (tx, tx') then 84 if eqTnames (tx, tx') then
62 ((tx', (CConcat (c, c'), loc)), true) 85 ((tx', (CConcat (c, c'), loc)), true)
63 else 86 else
127 150
128 | XML_BEGIN of string | XML_END 151 | XML_BEGIN of string | XML_END
129 | NOTAGS of string 152 | NOTAGS of string
130 | BEGIN_TAG of string | END_TAG of string 153 | BEGIN_TAG of string | END_TAG of string
131 154
132 | SELECT | FROM | AS | CWHERE 155 | SELECT | FROM | AS | CWHERE | GROUP | BY
133 | TRUE | FALSE | CAND | OR | NOT 156 | TRUE | FALSE | CAND | OR | NOT
134 | NE | LT | LE | GT | GE 157 | NE | LT | LE | GT | GE
135 158
136 %nonterm 159 %nonterm
137 file of decl list 160 file of decl list
192 | attrs of (con * exp) list 215 | attrs of (con * exp) list
193 | attr of con * exp 216 | attr of con * exp
194 | attrv of exp 217 | attrv of exp
195 218
196 | query of exp 219 | query of exp
220 | query1 of exp
197 | tables of (con * exp) list 221 | tables of (con * exp) list
198 | tname of con 222 | tname of con
199 | table of con * exp 223 | table of con * exp
200 | tident of con 224 | tident of con
201 | fident of con 225 | fident of con
202 | seli of select_item 226 | seli of select_item
203 | selis of select_item list 227 | selis of select_item list
204 | select of select 228 | select of select
205 | sqlexp of exp 229 | sqlexp of exp
206 | wopt of exp 230 | wopt of exp
231 | groupi of group_item
232 | groupis of group_item list
233 | gopt of group_item list option
207 234
208 235
209 %verbose (* print summary of errors *) 236 %verbose (* print summary of errors *)
210 %pos int (* positions *) 237 %pos int (* positions *)
211 %start file 238 %start file
613 640
614 attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright)) 641 attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright))
615 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) 642 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
616 | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright)) 643 | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
617 | LBRACE eexp RBRACE (eexp) 644 | LBRACE eexp RBRACE (eexp)
645
646 query : query1 (query1)
618 647
619 query : SELECT select FROM tables wopt 648 query1 : SELECT select FROM tables wopt gopt
620 (let 649 (let
621 val loc = s (SELECTleft, tablesright) 650 val loc = s (SELECTleft, tablesright)
622 651
623 val sel = 652 val sel =
624 case select of 653 case select of
638 loc)], loc))) tabs 667 loc)], loc))) tabs
639 end 668 end
640 669
641 val sel = (CRecord sel, loc) 670 val sel = (CRecord sel, loc)
642 671
672 val grp = case gopt of
673 NONE => (ECApp ((EVar (["Basis"], "sql_subset_all"), loc),
674 (CWild (KRecord (KRecord (KType, loc), loc),
675 loc), loc)), loc)
676 | SOME gis =>
677 let
678 val tabs = map (fn (nm, _) =>
679 (nm, (CRecord [], loc))) tables
680 val tabs = foldl (amend_group loc) tabs gis
681
682 val tabs = map (fn (nm, c) =>
683 (nm,
684 (CTuple [c,
685 (CWild (KRecord (KType, loc),
686 loc),
687 loc)], loc))) tabs
688 in
689 (ECApp ((EVar (["Basis"], "sql_subset"), loc),
690 (CRecord tabs, loc)), loc)
691 end
692
643 val hopt = (sql_inject (EVar (["Basis"], "True"), 693 val hopt = (sql_inject (EVar (["Basis"], "True"),
644 EVar (["Basis"], "sql_bool"), 694 EVar (["Basis"], "sql_bool"),
645 loc)) 695 loc))
646 696
647 val e = (EVar (["Basis"], "sql_query"), loc) 697 val e = (EVar (["Basis"], "sql_query"), loc)
648 val re = (ERecord [((CName "From", loc), 698 val re = (ERecord [((CName "From", loc),
649 (ERecord tables, loc)), 699 (ERecord tables, loc)),
650 ((CName "Where", loc), 700 ((CName "Where", loc),
651 wopt), 701 wopt),
652 ((CName "GroupBy", loc), 702 ((CName "GroupBy", loc),
653 (ECApp ((EVar (["Basis"], "sql_subset_all"), loc), 703 grp),
654 (CWild (KRecord (KRecord (KType, loc), loc),
655 loc), loc)), loc)),
656 ((CName "Having", loc), 704 ((CName "Having", loc),
657 hopt), 705 hopt),
658 ((CName "SelectFields", loc), 706 ((CName "SelectFields", loc),
659 (ECApp ((EVar (["Basis"], "sql_subset"), loc), 707 (ECApp ((EVar (["Basis"], "sql_subset"), loc),
660 sel), loc))], loc) 708 sel), loc))], loc)
730 778
731 wopt : (sql_inject (EVar (["Basis"], "True"), 779 wopt : (sql_inject (EVar (["Basis"], "True"),
732 EVar (["Basis"], "sql_bool"), 780 EVar (["Basis"], "sql_bool"),
733 ErrorMsg.dummySpan)) 781 ErrorMsg.dummySpan))
734 | CWHERE sqlexp (sqlexp) 782 | CWHERE sqlexp (sqlexp)
783
784 groupi : tident DOT fident (GField (tident, fident))
785
786 groupis: groupi ([groupi])
787 | groupi COMMA groupis (groupi :: groupis)
788
789 gopt : (NONE)
790 | GROUP BY groupis (SOME groupis)