Mercurial > urweb

comparison src/urweb.grm @ 1070:e933297c4e24

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tweaking SQL parsing and typing
author Adam Chlipala <adamc@hcoop.net>
date Sun, 13 Dec 2009 10:13:06 -0500
parents 36efaf119b85
children 26197c957ad6
comparison
equal deleted inserted replaced
1069:757397bb9609 1070:e933297c4e24
1167 end) 1167 end)
1168 1168
1169 | LPAREN query RPAREN (query) 1169 | LPAREN query RPAREN (query)
1170 | LPAREN CWHERE sqlexp RPAREN (sqlexp) 1170 | LPAREN CWHERE sqlexp RPAREN (sqlexp)
1171 | LPAREN SQL sqlexp RPAREN (sqlexp) 1171 | LPAREN SQL sqlexp RPAREN (sqlexp)
1172 | LPAREN FROM tables RPAREN (#2 tables)
1172 1173
1173 | LPAREN INSERT INTO texp LPAREN fields RPAREN VALUES LPAREN sqlexps RPAREN RPAREN 1174 | LPAREN INSERT INTO texp LPAREN fields RPAREN VALUES LPAREN sqlexps RPAREN RPAREN
1174 (let 1175 (let
1175 val loc = s (LPAREN1left, RPAREN3right) 1176 val loc = s (LPAREN1left, RPAREN3right)
1176 1177
1447 1448
1448 query1 : SELECT dopt select FROM tables wopt gopt hopt 1449 query1 : SELECT dopt select FROM tables wopt gopt hopt
1449 (let 1450 (let
1450 val loc = s (SELECTleft, tablesright) 1451 val loc = s (SELECTleft, tablesright)
1451 1452
1452 val (sel, exps) = 1453 val (empties, sel, exps) =
1453 case select of 1454 case select of
1454 Star => (map (fn nm => 1455 Star => ([],
1456 map (fn nm =>
1455 (nm, (CTuple [(CWild (KRecord (KType, loc), loc), 1457 (nm, (CTuple [(CWild (KRecord (KType, loc), loc),
1456 loc), 1458 loc),
1457 (CRecord [], loc)], 1459 (CRecord [], loc)],
1458 loc))) (#1 tables), 1460 loc))) (#1 tables),
1459 []) 1461 [])
1460 | Items sis => 1462 | Items sis =>
1461 let 1463 let
1462 val tabs = map (fn nm => (nm, (CRecord [], loc))) (#1 tables) 1464 val tabs = map (fn nm => (nm, (CRecord [], loc))) (#1 tables)
1463 val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis 1465 val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis
1466 val empties = List.mapPartial (fn (nm, (CRecord [], _)) =>
1467 SOME nm
1468 | _ => NONE) tabs
1464 in 1469 in
1465 (map (fn (nm, c) => (nm, 1470 (empties,
1471 map (fn (nm, c) => (nm,
1466 (CTuple [c, 1472 (CTuple [c,
1467 (CWild (KRecord (KType, loc), loc), 1473 (CWild (KRecord (KType, loc), loc),
1468 loc)], loc))) tabs, 1474 loc)], loc))) tabs,
1469 exps) 1475 exps)
1470 end 1476 end
1492 (ECApp ((EVar (["Basis"], "sql_subset", Infer), loc), 1498 (ECApp ((EVar (["Basis"], "sql_subset", Infer), loc),
1493 (CRecord tabs, loc)), loc) 1499 (CRecord tabs, loc)), loc)
1494 end 1500 end
1495 1501
1496 val e = (EVar (["Basis"], "sql_query1", Infer), loc) 1502 val e = (EVar (["Basis"], "sql_query1", Infer), loc)
1503 val e = (ECApp (e, (CRecord (map (fn nm => (nm, (CUnit, loc))) empties),
1504 loc)), loc)
1505 val e = (EDisjointApp e, loc)
1497 val re = (ERecord [((CName "Distinct", loc), 1506 val re = (ERecord [((CName "Distinct", loc),
1498 dopt), 1507 dopt),
1499 ((CName "From", loc), 1508 ((CName "From", loc),
1500 #2 tables), 1509 #2 tables),
1501 ((CName "Where", loc), 1510 ((CName "Where", loc),
1515 e 1524 e
1516 end) 1525 end)
1517 | query1 UNION query1 (sql_relop ("union", query11, query12, s (query11left, query12right))) 1526 | query1 UNION query1 (sql_relop ("union", query11, query12, s (query11left, query12right)))
1518 | query1 INTERSECT query1 (sql_relop ("intersect", query11, query12, s (query11left, query12right))) 1527 | query1 INTERSECT query1 (sql_relop ("intersect", query11, query12, s (query11left, query12right)))
1519 | query1 EXCEPT query1 (sql_relop ("except", query11, query12, s (query11left, query12right))) 1528 | query1 EXCEPT query1 (sql_relop ("except", query11, query12, s (query11left, query12right)))
1529 | LBRACE LBRACE LBRACE eexp RBRACE RBRACE RBRACE (eexp)
1520 1530
1521 tables : fitem (fitem) 1531 tables : fitem (fitem)
1522 | fitem COMMA tables (let 1532 | fitem COMMA tables (let
1523 val loc = s (fitemleft, tablesright) 1533 val loc = s (fitemleft, tablesright)
1524 1534