Mercurial > urweb

comparison src/urweb.grm @ 748:5f9b9972e6b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Switch to using sql_from_items
author Adam Chlipala <adamc@hcoop.net>
date Tue, 28 Apr 2009 09:45:17 -0400
parents 2c7244c066f1
children 16bfd9e244cd
comparison
equal deleted inserted replaced
747:e42f08f96eb5 748:5f9b9972e6b8
302 | attr of attr 302 | attr of attr
303 | attrv of exp 303 | attrv of exp
304 304
305 | query of exp 305 | query of exp
306 | query1 of exp 306 | query1 of exp
307 | tables of (con * exp) list 307 | tables of con list * exp
308 | tname of con 308 | tname of con
309 | tnameW of con * con 309 | tnameW of con * con
310 | tnames of (con * con) * (con * con) list 310 | tnames of (con * con) * (con * con) list
311 | tnames' of (con * con) * (con * con) list 311 | tnames' of (con * con) * (con * con) list
312 | table of con * exp 312 | table of con * exp
313 | table' of con * exp
313 | tident of con 314 | tident of con
314 | fident of con 315 | fident of con
315 | seli of select_item 316 | seli of select_item
316 | selis of select_item list 317 | selis of select_item list
317 | select of select 318 | select of select
1354 (let 1355 (let
1355 val loc = s (SELECTleft, tablesright) 1356 val loc = s (SELECTleft, tablesright)
1356 1357
1357 val (sel, exps) = 1358 val (sel, exps) =
1358 case select of 1359 case select of
1359 Star => (map (fn (nm, _) => 1360 Star => (map (fn nm =>
1360 (nm, (CTuple [(CWild (KRecord (KType, loc), loc), 1361 (nm, (CTuple [(CWild (KRecord (KType, loc), loc),
1361 loc), 1362 loc),
1362 (CRecord [], loc)], 1363 (CRecord [], loc)],
1363 loc))) tables, 1364 loc))) (#1 tables),
1364 []) 1365 [])
1365 | Items sis => 1366 | Items sis =>
1366 let 1367 let
1367 val tabs = map (fn (nm, _) => (nm, (CRecord [], loc))) tables 1368 val tabs = map (fn nm => (nm, (CRecord [], loc))) (#1 tables)
1368 val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis 1369 val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis
1369 in 1370 in
1370 (map (fn (nm, c) => (nm, 1371 (map (fn (nm, c) => (nm,
1371 (CTuple [c, 1372 (CTuple [c,
1372 (CWild (KRecord (KType, loc), loc), 1373 (CWild (KRecord (KType, loc), loc),
1381 Infer), loc), 1382 Infer), loc),
1382 (CWild (KRecord (KRecord (KType, loc), loc), 1383 (CWild (KRecord (KRecord (KType, loc), loc),
1383 loc), loc)), loc) 1384 loc), loc)), loc)
1384 | SOME gis => 1385 | SOME gis =>
1385 let 1386 let
1386 val tabs = map (fn (nm, _) => 1387 val tabs = map (fn nm =>
1387 (nm, (CRecord [], loc))) tables 1388 (nm, (CRecord [], loc))) (#1 tables)
1388 val tabs = foldl (amend_group loc) tabs gis 1389 val tabs = foldl (amend_group loc) tabs gis
1389 1390
1390 val tabs = map (fn (nm, c) => 1391 val tabs = map (fn (nm, c) =>
1391 (nm, 1392 (nm,
1392 (CTuple [c, 1393 (CTuple [c,
1398 (CRecord tabs, loc)), loc) 1399 (CRecord tabs, loc)), loc)
1399 end 1400 end
1400 1401
1401 val e = (EVar (["Basis"], "sql_query1", Infer), loc) 1402 val e = (EVar (["Basis"], "sql_query1", Infer), loc)
1402 val re = (ERecord [((CName "From", loc), 1403 val re = (ERecord [((CName "From", loc),
1403 (ERecord tables, loc)), 1404 #2 tables),
1404 ((CName "Where", loc), 1405 ((CName "Where", loc),
1405 wopt), 1406 wopt),
1406 ((CName "GroupBy", loc), 1407 ((CName "GroupBy", loc),
1407 grp), 1408 grp),
1408 ((CName "Having", loc), 1409 ((CName "Having", loc),
1419 end) 1420 end)
1420 | query1 UNION query1 (sql_relop ("union", query11, query12, s (query11left, query12right))) 1421 | query1 UNION query1 (sql_relop ("union", query11, query12, s (query11left, query12right)))
1421 | query1 INTERSECT query1 (sql_relop ("intersect", query11, query12, s (query11left, query12right))) 1422 | query1 INTERSECT query1 (sql_relop ("intersect", query11, query12, s (query11left, query12right)))
1422 | query1 EXCEPT query1 (sql_relop ("except", query11, query12, s (query11left, query12right))) 1423 | query1 EXCEPT query1 (sql_relop ("except", query11, query12, s (query11left, query12right)))
1423 1424
1424 tables : table ([table]) 1425 tables : table' ([#1 table'], #2 table')
1425 | table COMMA tables (table :: tables) 1426 | table' COMMA tables (let
1427 val loc = s (table'left, tablesright)
1428
1429 val e = (EVar (["Basis"], "sql_from_comma", Infer), loc)
1430 val e = (EApp (e, #2 table'), loc)
1431 in
1432 (#1 table' :: #1 tables,
1433 (EApp (e, #2 tables), loc))
1434 end)
1426 1435
1427 tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) 1436 tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
1428 | LBRACE cexp RBRACE (cexp) 1437 | LBRACE cexp RBRACE (cexp)
1429 1438
1430 table : SYMBOL ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)), 1439 table : SYMBOL ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)),
1431 (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright))) 1440 (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)))
1432 | SYMBOL AS tname (tname, (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright))) 1441 | SYMBOL AS tname (tname, (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)))
1433 | LBRACE LBRACE eexp RBRACE RBRACE AS tname (tname, eexp) 1442 | LBRACE LBRACE eexp RBRACE RBRACE AS tname (tname, eexp)
1443
1444 table' : table (let
1445 val loc = s (tableleft, tableright)
1446 val e = (EVar (["Basis"], "sql_from_table", Infer), loc)
1447 val e = (ECApp (e, #1 table), loc)
1448 in
1449 (#1 table, (EApp (e, #2 table), loc))
1450 end)
1434 1451
1435 tident : SYMBOL (CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)) 1452 tident : SYMBOL (CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright))
1436 | CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) 1453 | CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
1437 | LBRACE LBRACE cexp RBRACE RBRACE (cexp) 1454 | LBRACE LBRACE cexp RBRACE RBRACE (cexp)
1438 1455