comparison src/lacweb.grm @ 204:241c9a0e3397

Parsing the simplest SQL query
author Adam Chlipala <adamc@hcoop.net>
date Thu, 14 Aug 2008 13:59:11 -0400
parents dd82457fda82
children cc68da3801bc
comparison
equal deleted inserted replaced
203:dd82457fda82 204:241c9a0e3397
29 29
30 open Source 30 open Source
31 31
32 val s = ErrorMsg.spanOf 32 val s = ErrorMsg.spanOf
33 33
34 fun uppercaseFirst "" = "" 34 fun capitalize "" = ""
35 | uppercaseFirst s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) 35 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
36 36
37 fun entable t = 37 fun entable t =
38 case #1 t of 38 case #1 t of
39 TRecord c => c 39 TRecord c => c
40 | _ => t 40 | _ => t
60 60
61 | XML_BEGIN of string | XML_END 61 | XML_BEGIN of string | XML_END
62 | NOTAGS of string 62 | NOTAGS of string
63 | BEGIN_TAG of string | END_TAG of string 63 | BEGIN_TAG of string | END_TAG of string
64 64
65 | SELECT | FROM | AS
66
65 %nonterm 67 %nonterm
66 file of decl list 68 file of decl list
67 | decls of decl list 69 | decls of decl list
68 | decl of decl 70 | decl of decl
69 | vali of string * con option * exp 71 | vali of string * con option * exp
117 | ptuple of pat list 119 | ptuple of pat list
118 120
119 | attrs of (con * exp) list 121 | attrs of (con * exp) list
120 | attr of con * exp 122 | attr of con * exp
121 | attrv of exp 123 | attrv of exp
124
125 | query of exp
126 | tables of (con * exp) list
127 | tname of con
128 | table of con * exp
122 129
123 %verbose (* print summary of errors *) 130 %verbose (* print summary of errors *)
124 %pos int (* positions *) 131 %pos int (* positions *)
125 %start file 132 %start file
126 %pure 133 %pure
388 395
389 | XML_BEGIN xml XML_END (xml) 396 | XML_BEGIN xml XML_END (xml)
390 | XML_BEGIN XML_END (EApp ((EVar (["Basis"], "cdata"), s (XML_BEGINleft, XML_ENDright)), 397 | XML_BEGIN XML_END (EApp ((EVar (["Basis"], "cdata"), s (XML_BEGINleft, XML_ENDright)),
391 (EPrim (Prim.String ""), s (XML_BEGINleft, XML_ENDright))), 398 (EPrim (Prim.String ""), s (XML_BEGINleft, XML_ENDright))),
392 s (XML_BEGINleft, XML_ENDright)) 399 s (XML_BEGINleft, XML_ENDright))
400 | LPAREN query RPAREN (query)
393 401
394 idents : ident ([ident]) 402 idents : ident ([ident])
395 | ident DOT idents (ident :: idents) 403 | ident DOT idents (ident :: idents)
396 404
397 etuple : eexp COMMA eexp ([eexp1, eexp2]) 405 etuple : eexp COMMA eexp ([eexp1, eexp2])
486 | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright))) 494 | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
487 495
488 attrs : ([]) 496 attrs : ([])
489 | attr attrs (attr :: attrs) 497 | attr attrs (attr :: attrs)
490 498
491 attr : SYMBOL EQ attrv ((CName (uppercaseFirst SYMBOL), s (SYMBOLleft, SYMBOLright)), attrv) 499 attr : SYMBOL EQ attrv ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)), attrv)
492 500
493 attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright)) 501 attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright))
494 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) 502 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
495 | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright)) 503 | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
496 | LBRACE eexp RBRACE (eexp) 504 | LBRACE eexp RBRACE (eexp)
505
506 query : SELECT STAR FROM tables (let
507 val loc = s (SELECTleft, tablesright)
508 in
509 (EApp ((EVar (["Basis"], "sql_query"), loc),
510 (ERecord tables, loc)), loc)
511 end)
512
513 tables : table ([table])
514 | table COMMA tables (table :: tables)
515
516 tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
517 | LBRACE cexp RBRACE (cexp)
518
519 table : SYMBOL ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)),
520 (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)))
521 | SYMBOL AS tname (tname, (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)))
522 | LBRACE eexp RBRACE AS tname (tname, eexp)