Mercurial > urweb

comparison src/urweb.grm @ 1627:5c1f10cdac63

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
New 't.*' notation for SELECT
author Adam Chlipala <adam@chlipala.net>
date Sat, 03 Dec 2011 17:07:34 -0500
parents da788bd72c9e
children b0720700c36e
comparison
equal deleted inserted replaced
1626:07eed8386f07 1627:5c1f10cdac63
42 42
43 datatype select_item = 43 datatype select_item =
44 Field of con * con 44 Field of con * con
45 | Exp of con option * exp 45 | Exp of con option * exp
46 | Fields of con * con 46 | Fields of con * con
47 | StarFields of con
47 48
48 datatype select = 49 datatype select =
49 Star 50 Star
50 | Items of select_item list 51 | Items of select_item list
51 52
63 case c of 64 case c of
64 CName s => s 65 CName s => s
65 | CVar (_, x) => x 66 | CVar (_, x) => x
66 | _ => "?" 67 | _ => "?"
67 68
69 datatype tableMode =
70 Unknown
71 | Everything
72 | Selective of con
73
68 fun amend_select loc (si, (count, tabs, exps)) = 74 fun amend_select loc (si, (count, tabs, exps)) =
69 case si of 75 case si of
70 Field (tx, fx) => 76 Field (tx, fx) =>
71 let 77 let
72 val c = (CRecord ([(fx, (CWild (KType, loc), loc))]), loc) 78 val c = (CRecord ([(fx, (CWild (KType, loc), loc))]), loc)
73 79
74 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) => 80 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
75 if eqTnames (tx, tx') then 81 if eqTnames (tx, tx') then
76 ((tx', (CConcat (c, c'), loc)), true) 82 case c' of
83 Everything =>
84 (ErrorMsg.errorAt loc
85 "Mixing specific-field and '*' selection of fields from same table";
86 ((tx', c'), found))
87 | Unknown =>
88 ((tx', Selective c), true)
89 | Selective c' =>
90 ((tx', Selective (CConcat (c, c'), loc)), true)
77 else 91 else
78 ((tx', c'), found)) 92 ((tx', c'), found))
79 false tabs 93 false tabs
80 in 94 in
81 if found then 95 if found then
87 end 101 end
88 | Fields (tx, fs) => 102 | Fields (tx, fs) =>
89 let 103 let
90 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) => 104 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
91 if eqTnames (tx, tx') then 105 if eqTnames (tx, tx') then
92 ((tx', (CConcat (fs, c'), loc)), true) 106 case c' of
107 Everything =>
108 (ErrorMsg.errorAt loc
109 "Mixing specific-field and '*' selection of fields from same table";
110 ((tx', c'), found))
111 | Selective c' =>
112 ((tx', Selective (CConcat (fs, c'), loc)), true)
113 | Unknown =>
114 ((tx', Selective fs), true)
93 else 115 else
94 ((tx', c'), found)) 116 ((tx', c'), found))
95 false tabs 117 false tabs
96 in 118 in
97 if found then 119 if found then
99 else 121 else
100 ErrorMsg.errorAt loc "Select of field from unbound table"; 122 ErrorMsg.errorAt loc "Select of field from unbound table";
101 123
102 (count, tabs, exps) 124 (count, tabs, exps)
103 end 125 end
126 | StarFields tx =>
127 if List.exists (fn (tx', c') => eqTnames (tx, tx') andalso case c' of
128 Unknown => false
129 | _ => true) tabs then
130 (ErrorMsg.errorAt loc "Selection with '*' from table already mentioned in same SELECT clause";
131 (count, tabs, exps))
132 else if List.all (fn (tx', c') => not (eqTnames (tx, tx'))) tabs then
133 (ErrorMsg.errorAt loc "Select of all fields from unbound table";
134 (count, tabs, exps))
135 else
136 (count, map (fn (tx', c') => (tx', if eqTnames (tx, tx') then Everything else c')) tabs, exps)
104 | Exp (SOME c, e) => (count, tabs, (c, e) :: exps) 137 | Exp (SOME c, e) => (count, tabs, (c, e) :: exps)
105 | Exp (NONE, e) => (count+1, tabs, ((CName (Int.toString count), loc), e) :: exps) 138 | Exp (NONE, e) => (count+1, tabs, ((CName (Int.toString count), loc), e) :: exps)
106 139
107 fun amend_group loc (gi, tabs) = 140 fun amend_group loc (gi, tabs) =
108 let 141 let
1558 (CRecord [], loc)], 1591 (CRecord [], loc)],
1559 loc))) (#1 tables), 1592 loc))) (#1 tables),
1560 []) 1593 [])
1561 | Items sis => 1594 | Items sis =>
1562 let 1595 let
1563 val tabs = map (fn nm => (nm, (CRecord [], loc))) (#1 tables) 1596 val tabs = map (fn nm => (nm, Unknown)) (#1 tables)
1564 val (_, tabs, exps) = foldl (amend_select loc) 1597 val (_, tabs, exps) = foldl (amend_select loc)
1565 (1, tabs, []) sis 1598 (1, tabs, []) sis
1566 val empties = List.mapPartial (fn (nm, (CRecord [], _)) => 1599 val empties = List.mapPartial (fn (nm, c) =>
1567 SOME nm 1600 case c of
1568 | _ => NONE) tabs 1601 Unknown => SOME nm
1602 | Selective (CRecord [], _) => SOME nm
1603 | _ => NONE) tabs
1569 in 1604 in
1570 (empties, 1605 (empties,
1571 map (fn (nm, c) => (nm, 1606 map (fn (nm, c) => (nm,
1572 (CTuple [c, 1607 case c of
1573 (CWild (KRecord (KType, loc), loc), 1608 Everything =>
1574 loc)], loc))) tabs, 1609 (CTuple [(CWild (KRecord (KType, loc), loc), loc),
1610 (CRecord [], loc)], loc)
1611 | _ =>
1612 let
1613 val c = case c of
1614 Selective c => c
1615 | _ => (CRecord [], loc)
1616 in
1617 (CTuple [c,
1618 (CWild (KRecord (KType, loc), loc),
1619 loc)], loc)
1620 end)) tabs,
1575 exps) 1621 exps)
1576 end 1622 end
1577 1623
1578 val sel = (CRecord sel, loc) 1624 val sel = (CRecord sel, loc)
1579 1625
1768 1814
1769 seli : tident DOT fident (Field (tident, fident)) 1815 seli : tident DOT fident (Field (tident, fident))
1770 | sqlexp (Exp (NONE, sqlexp)) 1816 | sqlexp (Exp (NONE, sqlexp))
1771 | sqlexp AS fident (Exp (SOME fident, sqlexp)) 1817 | sqlexp AS fident (Exp (SOME fident, sqlexp))
1772 | tident DOT LBRACE LBRACE cexp RBRACE RBRACE (Fields (tident, cexp)) 1818 | tident DOT LBRACE LBRACE cexp RBRACE RBRACE (Fields (tident, cexp))
1819 | tident DOT STAR (StarFields tident)
1773 1820
1774 selis : seli ([seli]) 1821 selis : seli ([seli])
1775 | seli COMMA selis (seli :: selis) 1822 | seli COMMA selis (seli :: selis)
1776 1823
1777 select : STAR (Star) 1824 select : STAR (Star)