adam@1643
|
1 (* Copyright (c) 2008-2011, Adam Chlipala
|
adamc@1
|
2 * All rights reserved.
|
adamc@1
|
3 *
|
adamc@1
|
4 * Redistribution and use in source and binary forms, with or without
|
adamc@1
|
5 * modification, are permitted provided that the following conditions are met:
|
adamc@1
|
6 *
|
adamc@1
|
7 * - Redistributions of source code must retain the above copyright notice,
|
adamc@1
|
8 * this list of conditions and the following disclaimer.
|
adamc@1
|
9 * - Redistributions in binary form must reproduce the above copyright notice,
|
adamc@1
|
10 * this list of conditions and the following disclaimer in the documentation
|
adamc@1
|
11 * and/or other materials provided with the distribution.
|
adamc@1
|
12 * - The names of contributors may not be used to endorse or promote products
|
adamc@1
|
13 * derived from this software without specific prior written permission.
|
adamc@1
|
14 *
|
adamc@339
|
15 * THIS SOFTARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
adamc@1
|
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
adamc@1
|
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
adamc@1
|
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
adamc@1
|
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
adamc@1
|
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
adamc@1
|
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
adamc@1
|
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
adamc@1
|
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
adamc@1
|
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
adamc@1
|
25 * POSSIBILITY OF SUCH DAMAGE.
|
adamc@1
|
26 *)
|
adamc@1
|
27
|
adamc@244
|
28 (* Grammar for Ur/Web programs *)
|
adamc@1
|
29
|
adamc@4
|
30 open Source
|
adamc@1
|
31
|
adamc@1
|
32 val s = ErrorMsg.spanOf
|
adamc@230
|
33 val dummy = ErrorMsg.dummySpan
|
adamc@1
|
34
|
adamc@204
|
35 fun capitalize "" = ""
|
adamc@204
|
36 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
|
adamc@104
|
37
|
adamc@203
|
38 fun entable t =
|
adamc@203
|
39 case #1 t of
|
adamc@203
|
40 TRecord c => c
|
adamc@203
|
41 | _ => t
|
adamc@203
|
42
|
adamc@207
|
43 datatype select_item =
|
adamc@207
|
44 Field of con * con
|
adamc@1194
|
45 | Exp of con option * exp
|
adamc@341
|
46 | Fields of con * con
|
adam@1627
|
47 | StarFields of con
|
adamc@207
|
48
|
adamc@207
|
49 datatype select =
|
adamc@207
|
50 Star
|
adamc@207
|
51 | Items of select_item list
|
adamc@207
|
52
|
adamc@226
|
53 datatype group_item =
|
adamc@226
|
54 GField of con * con
|
adam@1425
|
55 | GFields of con * con
|
adamc@226
|
56
|
adamc@207
|
57 fun eqTnames ((c1, _), (c2, _)) =
|
adamc@207
|
58 case (c1, c2) of
|
adamc@207
|
59 (CVar (ms1, x1), CVar (ms2, x2)) => ms1 = ms2 andalso x1 = x2
|
adamc@207
|
60 | (CName x1, CName x2) => x1 = x2
|
adamc@207
|
61 | _ => false
|
adamc@207
|
62
|
adam@1424
|
63 fun nameString (c, _) =
|
adam@1424
|
64 case c of
|
adam@1424
|
65 CName s => s
|
adam@1424
|
66 | CVar (_, x) => x
|
adam@1424
|
67 | _ => "?"
|
adam@1424
|
68
|
adam@1627
|
69 datatype tableMode =
|
adam@1627
|
70 Unknown
|
adam@1627
|
71 | Everything
|
adam@1627
|
72 | Selective of con
|
adam@1627
|
73
|
adamc@1194
|
74 fun amend_select loc (si, (count, tabs, exps)) =
|
adamc@233
|
75 case si of
|
adamc@233
|
76 Field (tx, fx) =>
|
adamc@233
|
77 let
|
adamc@233
|
78 val c = (CRecord ([(fx, (CWild (KType, loc), loc))]), loc)
|
adamc@207
|
79
|
adamc@233
|
80 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
|
adamc@233
|
81 if eqTnames (tx, tx') then
|
adam@1627
|
82 case c' of
|
adam@1627
|
83 Everything =>
|
adam@1627
|
84 (ErrorMsg.errorAt loc
|
adam@1627
|
85 "Mixing specific-field and '*' selection of fields from same table";
|
adam@1627
|
86 ((tx', c'), found))
|
adam@1627
|
87 | Unknown =>
|
adam@1627
|
88 ((tx', Selective c), true)
|
adam@1627
|
89 | Selective c' =>
|
adam@1627
|
90 ((tx', Selective (CConcat (c, c'), loc)), true)
|
adamc@233
|
91 else
|
adamc@233
|
92 ((tx', c'), found))
|
adamc@233
|
93 false tabs
|
adamc@233
|
94 in
|
adamc@233
|
95 if found then
|
adamc@233
|
96 ()
|
adamc@233
|
97 else
|
adam@1424
|
98 ErrorMsg.errorAt loc ("Select of field " ^ nameString fx ^ " from unbound table " ^ nameString tx);
|
adamc@233
|
99
|
adamc@1194
|
100 (count, tabs, exps)
|
adamc@233
|
101 end
|
adamc@341
|
102 | Fields (tx, fs) =>
|
adamc@341
|
103 let
|
adamc@341
|
104 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
|
adamc@341
|
105 if eqTnames (tx, tx') then
|
adam@1627
|
106 case c' of
|
adam@1627
|
107 Everything =>
|
adam@1627
|
108 (ErrorMsg.errorAt loc
|
adam@1627
|
109 "Mixing specific-field and '*' selection of fields from same table";
|
adam@1627
|
110 ((tx', c'), found))
|
adam@1627
|
111 | Selective c' =>
|
adam@1627
|
112 ((tx', Selective (CConcat (fs, c'), loc)), true)
|
adam@1627
|
113 | Unknown =>
|
adam@1627
|
114 ((tx', Selective fs), true)
|
adamc@341
|
115 else
|
adamc@341
|
116 ((tx', c'), found))
|
adamc@341
|
117 false tabs
|
adamc@341
|
118 in
|
adamc@341
|
119 if found then
|
adamc@341
|
120 ()
|
adamc@341
|
121 else
|
adamc@341
|
122 ErrorMsg.errorAt loc "Select of field from unbound table";
|
adamc@341
|
123
|
adamc@1194
|
124 (count, tabs, exps)
|
adamc@341
|
125 end
|
adam@1627
|
126 | StarFields tx =>
|
adam@1627
|
127 if List.exists (fn (tx', c') => eqTnames (tx, tx') andalso case c' of
|
adam@1627
|
128 Unknown => false
|
adam@1627
|
129 | _ => true) tabs then
|
adam@1627
|
130 (ErrorMsg.errorAt loc "Selection with '*' from table already mentioned in same SELECT clause";
|
adam@1627
|
131 (count, tabs, exps))
|
adam@1627
|
132 else if List.all (fn (tx', c') => not (eqTnames (tx, tx'))) tabs then
|
adam@1627
|
133 (ErrorMsg.errorAt loc "Select of all fields from unbound table";
|
adam@1627
|
134 (count, tabs, exps))
|
adam@1627
|
135 else
|
adam@1627
|
136 (count, map (fn (tx', c') => (tx', if eqTnames (tx, tx') then Everything else c')) tabs, exps)
|
adamc@1194
|
137 | Exp (SOME c, e) => (count, tabs, (c, e) :: exps)
|
adamc@1194
|
138 | Exp (NONE, e) => (count+1, tabs, ((CName (Int.toString count), loc), e) :: exps)
|
adamc@207
|
139
|
adamc@226
|
140 fun amend_group loc (gi, tabs) =
|
adamc@226
|
141 let
|
adamc@226
|
142 val (tx, c) = case gi of
|
adamc@226
|
143 GField (tx, fx) => (tx, (CRecord ([(fx, (CWild (KType, loc), loc))]), loc))
|
adam@1425
|
144 | GFields (tx, fxs) => (tx, fxs)
|
adamc@226
|
145
|
adamc@226
|
146 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
|
adamc@226
|
147 if eqTnames (tx, tx') then
|
adamc@226
|
148 ((tx', (CConcat (c, c'), loc)), true)
|
adamc@226
|
149 else
|
adamc@226
|
150 ((tx', c'), found))
|
adam@1425
|
151 false tabs
|
adamc@226
|
152 in
|
adamc@226
|
153 if found then
|
adamc@226
|
154 ()
|
adamc@226
|
155 else
|
adamc@226
|
156 ErrorMsg.errorAt loc "Select of field from unbound table";
|
adamc@226
|
157
|
adamc@226
|
158 tabs
|
adamc@226
|
159 end
|
adamc@226
|
160
|
adamc@403
|
161 fun sql_inject (v, loc) =
|
adamc@403
|
162 (EApp ((EVar (["Basis"], "sql_inject", Infer), loc), (v, loc)), loc)
|
adamc@209
|
163
|
adamc@220
|
164 fun sql_binary (oper, sqlexp1, sqlexp2, loc) =
|
adamc@220
|
165 let
|
adamc@403
|
166 val e = (EVar (["Basis"], "sql_binary", Infer), loc)
|
adamc@403
|
167 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
|
adamc@220
|
168 val e = (EApp (e, sqlexp1), loc)
|
adamc@220
|
169 in
|
adamc@220
|
170 (EApp (e, sqlexp2), loc)
|
adamc@220
|
171 end
|
adamc@220
|
172
|
adamc@220
|
173 fun sql_unary (oper, sqlexp, loc) =
|
adamc@220
|
174 let
|
adamc@403
|
175 val e = (EVar (["Basis"], "sql_unary", Infer), loc)
|
adamc@403
|
176 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
|
adamc@220
|
177 in
|
adamc@220
|
178 (EApp (e, sqlexp), loc)
|
adamc@219
|
179 end
|
adamc@219
|
180
|
adam@1427
|
181 fun sql_relop (oper, all, sqlexp1, sqlexp2, loc) =
|
adamc@229
|
182 let
|
adamc@403
|
183 val e = (EVar (["Basis"], "sql_relop", Infer), loc)
|
adamc@403
|
184 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
|
adam@1427
|
185 val e = (EApp (e, (EVar (["Basis"], if all then "True" else "False", Infer), loc)), loc)
|
adamc@229
|
186 val e = (EApp (e, sqlexp1), loc)
|
adamc@229
|
187 in
|
adamc@229
|
188 (EApp (e, sqlexp2), loc)
|
adamc@229
|
189 end
|
adamc@229
|
190
|
adamc@441
|
191 fun sql_nfunc (oper, loc) =
|
adamc@441
|
192 let
|
adamc@441
|
193 val e = (EVar (["Basis"], "sql_nfunc", Infer), loc)
|
adamc@441
|
194 in
|
adamc@441
|
195 (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
|
adamc@441
|
196 end
|
adamc@441
|
197
|
adamc@389
|
198 fun native_unop (oper, e1, loc) =
|
adamc@389
|
199 let
|
adamc@403
|
200 val e = (EVar (["Basis"], oper, Infer), loc)
|
adamc@389
|
201 in
|
adamc@389
|
202 (EApp (e, e1), loc)
|
adamc@389
|
203 end
|
adamc@389
|
204
|
adamc@256
|
205 fun native_op (oper, e1, e2, loc) =
|
adamc@256
|
206 let
|
adamc@403
|
207 val e = (EVar (["Basis"], oper, Infer), loc)
|
adamc@256
|
208 val e = (EApp (e, e1), loc)
|
adamc@256
|
209 in
|
adamc@256
|
210 (EApp (e, e2), loc)
|
adamc@256
|
211 end
|
adamc@256
|
212
|
adamc@310
|
213 val inDml = ref false
|
adamc@310
|
214
|
adamc@325
|
215 fun tagIn bt =
|
adamc@325
|
216 case bt of
|
adamc@325
|
217 "table" => "tabl"
|
adamc@325
|
218 | _ => bt
|
adamc@325
|
219
|
adamc@709
|
220 datatype prop_kind = Delete | Update
|
adamc@709
|
221
|
adam@1750
|
222 datatype attr = Class of exp | DynClass of exp | Style of exp | Normal of con * exp
|
adamc@721
|
223
|
adamc@822
|
224 fun patType loc (p : pat) =
|
adamc@822
|
225 case #1 p of
|
adamc@822
|
226 PAnnot (_, t) => t
|
adamc@822
|
227 | _ => (CWild (KType, loc), loc)
|
adamc@822
|
228
|
adamc@1265
|
229 fun tnamesOf (e, _) =
|
adamc@1265
|
230 case e of
|
adamc@1265
|
231 EApp (e1, e2) => tnamesOf e1 @ tnamesOf e2
|
adamc@1265
|
232 | ECApp (e, c as (CName _, _)) =>
|
adamc@1265
|
233 let
|
adamc@1265
|
234 fun isFt (e, _) =
|
adamc@1265
|
235 case e of
|
adamc@1265
|
236 EVar (["Basis"], "sql_from_table", _) => true
|
adamc@1265
|
237 | EVar ([], "sql_from_table", _) => true
|
adamc@1265
|
238 | ECApp (e, _) => isFt e
|
adamc@1265
|
239 | EApp (e, _) => isFt e
|
adamc@1265
|
240 | EDisjointApp e => isFt e
|
adamc@1265
|
241 | _ => false
|
adamc@1265
|
242 in
|
adamc@1265
|
243 (if isFt e then [c] else []) @ tnamesOf e
|
adamc@1265
|
244 end
|
adamc@1265
|
245 | ECApp (e, _) => tnamesOf e
|
adamc@1265
|
246 | EDisjointApp e => tnamesOf e
|
adamc@1265
|
247 | _ => []
|
adamc@1265
|
248
|
adam@1749
|
249 fun classOut (s, pos) = (EVar ([], String.translate (fn #"-" => "_" | ch => str ch) s, Infer), pos)
|
adam@1749
|
250
|
adam@1749
|
251 fun parseClass s pos =
|
adam@1749
|
252 case String.tokens Char.isSpace s of
|
adam@1749
|
253 [] => (EVar (["Basis"], "null", Infer), pos)
|
adam@1749
|
254 | class :: classes =>
|
adam@1749
|
255 foldl (fn (s, e) => (EApp ((EApp ((EVar (["Basis"], "classes", Infer), pos), e), pos), classOut (s, pos)), pos))
|
adam@1749
|
256 (classOut (class, pos)) classes
|
adam@1749
|
257
|
adam@1750
|
258 fun parseValue s pos =
|
adam@1750
|
259 if String.isPrefix "url(" s andalso String.isSuffix ")" s then
|
adam@1750
|
260 let
|
adam@1750
|
261 val s = String.substring (s, 4, size s - 5)
|
adam@1750
|
262
|
adam@1750
|
263 val s = if size s >= 2
|
adam@1750
|
264 andalso ((String.isPrefix "\"" s andalso String.isSuffix "\"" s)
|
adam@1750
|
265 orelse (String.isPrefix "'" s andalso String.isSuffix "'" s)) then
|
adam@1750
|
266 String.substring (s, 1, size s - 2)
|
adam@1750
|
267 else
|
adam@1750
|
268 s
|
adam@1750
|
269 in
|
adam@1750
|
270 (EApp ((EVar (["Basis"], "css_url", Infer), pos),
|
adam@1750
|
271 (EApp ((EVar (["Basis"], "bless", Infer), pos),
|
adam@1750
|
272 (EPrim (Prim.String s), pos)), pos)), pos)
|
adam@1750
|
273 end
|
adam@1750
|
274 else
|
adam@1750
|
275 (EApp ((EVar (["Basis"], "atom", Infer), pos),
|
adam@1750
|
276 (EPrim (Prim.String s), pos)), pos)
|
adam@1750
|
277
|
adam@1750
|
278 fun parseProperty s pos =
|
adam@1750
|
279 let
|
adam@1750
|
280 val (befor, after) = Substring.splitl (fn ch => ch <> #":") (Substring.full s)
|
adam@1750
|
281 in
|
adam@1750
|
282 if Substring.isEmpty after then
|
adam@1750
|
283 (ErrorMsg.errorAt pos ("Invalid CSS property syntax: " ^ s);
|
adam@1750
|
284 (EPrim (Prim.String ""), pos))
|
adam@1750
|
285 else
|
adam@1750
|
286 foldl (fn (value, e) => (EApp ((EApp ((EVar (["Basis"], "value", Infer), pos), e), pos), parseValue value pos), pos))
|
adam@1750
|
287 (EApp ((EVar (["Basis"], "property", Infer), pos),
|
adam@1750
|
288 (EPrim (Prim.String (Substring.string (#2 (Substring.splitl Char.isSpace befor)))), pos)), pos)
|
adam@1750
|
289 (String.tokens Char.isSpace (Substring.string (Substring.slice (after, 1, NONE))))
|
adam@1750
|
290 end
|
adam@1750
|
291
|
adam@1750
|
292 fun parseStyle s pos =
|
adam@1750
|
293 case String.tokens (fn ch => ch = #";") s of
|
adam@1750
|
294 [] => (EVar (["Basis"], "noStyle", Infer), pos)
|
adam@1750
|
295 | props =>
|
adam@1750
|
296 foldl (fn (s, e) => (EApp ((EApp ((EVar (["Basis"], "oneProperty", Infer), pos), e), pos), parseProperty s pos), pos))
|
adam@1750
|
297 (EVar (["Basis"], "noStyle", Infer), pos) props
|
adam@1750
|
298
|
adamc@1
|
299 %%
|
adamc@244
|
300 %header (functor UrwebLrValsFn(structure Token : TOKEN))
|
adamc@1
|
301
|
adamc@1
|
302 %term
|
adamc@1
|
303 EOF
|
adamc@821
|
304 | STRING of string | INT of Int64.int | FLOAT of Real64.real | CHAR of char
|
adamc@1
|
305 | SYMBOL of string | CSYMBOL of string
|
adamc@1
|
306 | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
|
adam@1306
|
307 | EQ | COMMA | COLON | DCOLON | DCOLONWILD | TCOLON | TCOLONWILD | DOT | HASH | UNDER | UNDERUNDER | BAR
|
adamc@403
|
308 | PLUS | MINUS | DIVIDE | DOTDOTDOT | MOD | AT
|
adamc@623
|
309 | CON | LTYPE | VAL | REC | AND | FUN | MAP | UNIT | KUNIT | CLASS
|
adamc@156
|
310 | DATATYPE | OF
|
adamc@7
|
311 | TYPE | NAME
|
adamc@629
|
312 | ARROW | LARROW | DARROW | STAR | SEMI | KARROW | DKARROW | BANG
|
adamc@674
|
313 | FN | PLUSPLUS | MINUSMINUS | MINUSMINUSMINUS | DOLLAR | TWIDDLE | CARET
|
adamc@446
|
314 | LET | IN
|
adam@1732
|
315 | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | SQL | SELECT1
|
adamc@754
|
316 | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE | SEQUENCE | VIEW
|
adamc@1199
|
317 | COOKIE | STYLE | TASK | POLICY
|
adamc@842
|
318 | CASE | IF | THEN | ELSE | ANDALSO | ORELSE
|
adamc@1
|
319
|
adamc@360
|
320 | XML_BEGIN of string | XML_END | XML_BEGIN_END of string
|
adamc@91
|
321 | NOTAGS of string
|
adamc@91
|
322 | BEGIN_TAG of string | END_TAG of string
|
adamc@91
|
323
|
adamc@993
|
324 | SELECT | DISTINCT | FROM | AS | CWHERE | GROUP | ORDER | BY | HAVING
|
adamc@229
|
325 | UNION | INTERSECT | EXCEPT
|
adamc@232
|
326 | LIMIT | OFFSET | ALL
|
adamc@220
|
327 | TRUE | FALSE | CAND | OR | NOT
|
adamc@236
|
328 | COUNT | AVG | SUM | MIN | MAX
|
adam@1682
|
329 | ASC | DESC | RANDOM
|
kkallio@1607
|
330 | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS | COALESCE | LIKE
|
adamc@441
|
331 | CURRENT_TIMESTAMP
|
adamc@219
|
332 | NE | LT | LE | GT | GE
|
adamc@714
|
333 | CCONSTRAINT | UNIQUE | CHECK | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES
|
adamc@751
|
334 | JOIN | INNER | CROSS | OUTER | LEFT | RIGHT | FULL
|
kkallio@1572
|
335 | CIF | CTHEN | CELSE
|
adamc@204
|
336
|
adamc@30
|
337 %nonterm
|
adamc@1
|
338 file of decl list
|
adamc@1
|
339 | decls of decl list
|
adamc@325
|
340 | decl of decl list
|
adamc@123
|
341 | vali of string * con option * exp
|
adamc@123
|
342 | valis of (string * con option * exp) list
|
adamc@242
|
343 | copt of con option
|
adamc@1
|
344
|
adamc@191
|
345 | dargs of string list
|
adamc@156
|
346 | barOpt of unit
|
adamc@156
|
347 | dcons of (string * con option) list
|
adamc@805
|
348 | dtype of string * string list * (string * con option) list
|
adamc@805
|
349 | dtypes of (string * string list * (string * con option) list) list
|
adamc@156
|
350 | dcon of string * con option
|
adamc@156
|
351
|
adamc@707
|
352 | pkopt of exp
|
adam@1722
|
353 | pk of exp
|
adamc@707
|
354 | commaOpt of unit
|
adamc@707
|
355
|
adamc@704
|
356 | cst of exp
|
adamc@704
|
357 | csts of exp
|
adamc@704
|
358 | cstopt of exp
|
adamc@704
|
359
|
adamc@1001
|
360 | ckl of (string * kind option) list
|
adamc@1001
|
361
|
adamc@709
|
362 | pmode of prop_kind * exp
|
adamc@709
|
363 | pkind of prop_kind
|
adamc@709
|
364 | prule of exp
|
adamc@709
|
365 | pmodes of (prop_kind * exp) list
|
adamc@709
|
366
|
adamc@30
|
367 | sgn of sgn
|
adamc@42
|
368 | sgntm of sgn
|
adamc@30
|
369 | sgi of sgn_item
|
adamc@30
|
370 | sgis of sgn_item list
|
adamc@30
|
371
|
adamc@30
|
372 | str of str
|
adamc@30
|
373
|
adamc@1
|
374 | kind of kind
|
adamc@207
|
375 | ktuple of kind list
|
adamc@1
|
376 | kcolon of explicitness
|
adamc@240
|
377 | kopt of kind option
|
adamc@1
|
378
|
adamc@34
|
379 | path of string list * string
|
adamc@156
|
380 | cpath of string list * string
|
adamc@34
|
381 | spath of str
|
adamc@59
|
382 | mpath of string list
|
adamc@34
|
383
|
adamc@1
|
384 | cexp of con
|
adam@1577
|
385 | cexpO of con option
|
adamc@1
|
386 | capps of con
|
adamc@1
|
387 | cterm of con
|
adamc@195
|
388 | ctuple of con list
|
adamc@207
|
389 | ctuplev of con list
|
adamc@1
|
390 | ident of con
|
adamc@200
|
391 | idents of con list
|
adamc@1
|
392 | rcon of (con * con) list
|
adamc@83
|
393 | rconn of (con * con) list
|
adamc@1
|
394 | rcone of (con * con) list
|
adamc@239
|
395 | cargs of con * kind -> con * kind
|
adamc@239
|
396 | cargl of con * kind -> con * kind
|
adamc@240
|
397 | cargl2 of con * kind -> con * kind
|
adamc@239
|
398 | carg of con * kind -> con * kind
|
adamc@239
|
399 | cargp of con * kind -> con * kind
|
adamc@1
|
400
|
adamc@8
|
401 | eexp of exp
|
adamc@8
|
402 | eapps of exp
|
adamc@8
|
403 | eterm of exp
|
adamc@195
|
404 | etuple of exp list
|
adamc@12
|
405 | rexp of (con * exp) list
|
adamc@91
|
406 | xml of exp
|
adamc@91
|
407 | xmlOne of exp
|
adamc@1045
|
408 | xmlOpt of exp
|
adam@1643
|
409 | tag of (string * exp) * exp option * exp option * exp
|
adamc@141
|
410 | tagHead of string * exp
|
adamc@434
|
411 | bind of string * con option * exp
|
adamc@446
|
412 | edecl of edecl
|
adamc@446
|
413 | edecls of edecl list
|
adamc@8
|
414
|
adamc@241
|
415 | earg of exp * con -> exp * con
|
adamc@241
|
416 | eargp of exp * con -> exp * con
|
adamc@822
|
417 | earga of exp * con -> exp * con
|
adamc@241
|
418 | eargs of exp * con -> exp * con
|
adamc@241
|
419 | eargl of exp * con -> exp * con
|
adamc@242
|
420 | eargl2 of exp * con -> exp * con
|
adamc@241
|
421
|
adamc@170
|
422 | branch of pat * exp
|
adamc@170
|
423 | branchs of (pat * exp) list
|
adamc@170
|
424 | pat of pat
|
adamc@822
|
425 | patS of pat
|
adamc@170
|
426 | pterm of pat
|
adamc@174
|
427 | rpat of (string * pat) list * bool
|
adamc@195
|
428 | ptuple of pat list
|
adamc@170
|
429
|
adam@1750
|
430 | attrs of exp option * exp option * exp option * (con * exp) list
|
adamc@721
|
431 | attr of attr
|
adamc@104
|
432 | attrv of exp
|
adamc@104
|
433
|
adamc@204
|
434 | query of exp
|
adamc@226
|
435 | query1 of exp
|
adamc@993
|
436 | dopt of exp
|
adamc@748
|
437 | tables of con list * exp
|
adamc@749
|
438 | fitem of con list * exp
|
adamc@204
|
439 | tname of con
|
adamc@705
|
440 | tnameW of con * con
|
adamc@705
|
441 | tnames of (con * con) * (con * con) list
|
adamc@705
|
442 | tnames' of (con * con) * (con * con) list
|
adamc@204
|
443 | table of con * exp
|
adamc@748
|
444 | table' of con * exp
|
adamc@207
|
445 | tident of con
|
adamc@207
|
446 | fident of con
|
adamc@207
|
447 | seli of select_item
|
adamc@207
|
448 | selis of select_item list
|
adamc@207
|
449 | select of select
|
adamc@209
|
450 | sqlexp of exp
|
adamc@209
|
451 | wopt of exp
|
adamc@226
|
452 | groupi of group_item
|
adamc@226
|
453 | groupis of group_item list
|
adamc@226
|
454 | gopt of group_item list option
|
adamc@227
|
455 | hopt of exp
|
adamc@230
|
456 | obopt of exp
|
adamc@268
|
457 | obitem of exp * exp
|
adamc@230
|
458 | obexps of exp
|
adam@1682
|
459 | popt of unit
|
adamc@268
|
460 | diropt of exp
|
adamc@231
|
461 | lopt of exp
|
adamc@232
|
462 | ofopt of exp
|
adamc@231
|
463 | sqlint of exp
|
adamc@236
|
464 | sqlagg of string
|
adamc@746
|
465 | fname of exp
|
adamc@207
|
466
|
adamc@302
|
467 | texp of exp
|
adamc@302
|
468 | fields of con list
|
adamc@302
|
469 | sqlexps of exp list
|
adamc@303
|
470 | fsets of (con * exp) list
|
adamc@310
|
471 | enterDml of unit
|
adamc@310
|
472 | leaveDml of unit
|
adamc@302
|
473
|
adamc@204
|
474
|
adamc@1
|
475 %verbose (* print summary of errors *)
|
adamc@1
|
476 %pos int (* positions *)
|
adamc@1
|
477 %start file
|
adamc@1
|
478 %pure
|
adamc@1
|
479 %eop EOF
|
adamc@1
|
480 %noshift EOF
|
adamc@1
|
481
|
adamc@244
|
482 %name Urweb
|
adamc@1
|
483
|
adamc@623
|
484 %right KARROW
|
adamc@623
|
485 %nonassoc DKARROW
|
adamc@243
|
486 %right SEMI
|
adamc@243
|
487 %nonassoc LARROW
|
adamc@195
|
488 %nonassoc IF THEN ELSE
|
adamc@843
|
489 %nonassoc DARROW
|
adamc@842
|
490 %left ANDALSO
|
adamc@842
|
491 %left ORELSE
|
adamc@1
|
492 %nonassoc COLON
|
adam@1306
|
493 %nonassoc DCOLON TCOLON DCOLONWILD TCOLONWILD
|
adam@1427
|
494 %left UNION INTERSECT EXCEPT ALL
|
adamc@1
|
495 %right COMMA
|
adamc@751
|
496 %right JOIN INNER CROSS OUTER LEFT RIGHT FULL
|
adamc@220
|
497 %right OR
|
adamc@220
|
498 %right CAND
|
adamc@470
|
499 %nonassoc EQ NE LT LE GT GE IS
|
adamc@243
|
500 %right ARROW
|
adamc@837
|
501 %right CARET PLUSPLUS
|
adamc@837
|
502 %left MINUSMINUS MINUSMINUSMINUS
|
adamc@389
|
503 %left PLUS MINUS
|
adamc@389
|
504 %left STAR DIVIDE MOD
|
adamc@220
|
505 %left NOT
|
adamc@84
|
506 %nonassoc TWIDDLE
|
adamc@1
|
507 %nonassoc DOLLAR
|
adamc@1
|
508 %left DOT
|
adamc@221
|
509 %nonassoc LBRACE RBRACE
|
adamc@1
|
510
|
adamc@1
|
511 %%
|
adamc@1
|
512
|
adamc@1
|
513 file : decls (decls)
|
adamc@54
|
514 | SIG sgis ([(DSgn ("?", (SgnConst sgis, s (SIGleft, sgisright))),
|
adamc@54
|
515 s (SIGleft, sgisright))])
|
adamc@1
|
516
|
adamc@1
|
517 decls : ([])
|
adamc@325
|
518 | decl decls (decl @ decls)
|
adamc@1
|
519
|
adamc@240
|
520 decl : CON SYMBOL cargl2 kopt EQ cexp (let
|
adamc@240
|
521 val loc = s (CONleft, cexpright)
|
adamc@240
|
522
|
adamc@240
|
523 val k = Option.getOpt (kopt, (KWild, loc))
|
adamc@240
|
524 val (c, k) = cargl2 (cexp, k)
|
adamc@240
|
525 in
|
adamc@325
|
526 [(DCon (SYMBOL, SOME k, c), loc)]
|
adamc@240
|
527 end)
|
adam@1654
|
528 | LTYPE SYMBOL cargl2 EQ cexp (let
|
adam@1654
|
529 val loc = s (LTYPEleft, cexpright)
|
adam@1654
|
530
|
adam@1654
|
531 val k = (KWild, loc)
|
adam@1654
|
532 val (c, k) = cargl2 (cexp, k)
|
adam@1654
|
533 in
|
adam@1654
|
534 [(DCon (SYMBOL, SOME k, c), loc)]
|
adam@1654
|
535 end)
|
adamc@805
|
536 | DATATYPE dtypes ([(DDatatype dtypes, s (DATATYPEleft, dtypesright))])
|
adamc@191
|
537 | DATATYPE SYMBOL dargs EQ DATATYPE CSYMBOL DOT path
|
adamc@191
|
538 (case dargs of
|
adamc@325
|
539 [] => [(DDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))]
|
adamc@191
|
540 | _ => raise Fail "Arguments specified for imported datatype")
|
adamc@325
|
541 | VAL vali ([(DVal vali, s (VALleft, valiright))])
|
adamc@325
|
542 | VAL REC valis ([(DValRec valis, s (VALleft, valisright))])
|
adamc@325
|
543 | FUN valis ([(DValRec valis, s (FUNleft, valisright))])
|
adamc@1
|
544
|
adamc@325
|
545 | SIGNATURE CSYMBOL EQ sgn ([(DSgn (CSYMBOL, sgn), s (SIGNATUREleft, sgnright))])
|
adam@1732
|
546 | STRUCTURE CSYMBOL EQ str ([(DStr (CSYMBOL, NONE, NONE, str), s (STRUCTUREleft, strright))])
|
adam@1732
|
547 | STRUCTURE CSYMBOL COLON sgn EQ str ([(DStr (CSYMBOL, SOME sgn, NONE, str), s (STRUCTUREleft, strright))])
|
adamc@42
|
548 | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN EQ str
|
adam@1732
|
549 ([(DStr (CSYMBOL1, NONE, NONE,
|
adamc@325
|
550 (StrFun (CSYMBOL2, sgn1, NONE, str), s (FUNCTORleft, strright))),
|
adamc@325
|
551 s (FUNCTORleft, strright))])
|
adamc@42
|
552 | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN COLON sgn EQ str
|
adam@1732
|
553 ([(DStr (CSYMBOL1, NONE, NONE,
|
adamc@325
|
554 (StrFun (CSYMBOL2, sgn1, SOME sgn2, str), s (FUNCTORleft, strright))),
|
adamc@325
|
555 s (FUNCTORleft, strright))])
|
adamc@61
|
556 | OPEN mpath (case mpath of
|
adamc@61
|
557 [] => raise Fail "Impossible mpath parse [1]"
|
adamc@325
|
558 | m :: ms => [(DOpen (m, ms), s (OPENleft, mpathright))])
|
adamc@325
|
559 | OPEN mpath LPAREN str RPAREN (let
|
adamc@325
|
560 val loc = s (OPENleft, RPARENright)
|
adamc@325
|
561
|
adamc@325
|
562 val m = case mpath of
|
adamc@325
|
563 [] => raise Fail "Impossible mpath parse [4]"
|
adamc@325
|
564 | m :: ms =>
|
adamc@325
|
565 foldl (fn (m, str) => (StrProj (str, m), loc))
|
adamc@325
|
566 (StrVar m, loc) ms
|
adamc@325
|
567 in
|
adam@1732
|
568 [(DStr ("anon", NONE, NONE, (StrApp (m, str), loc)), loc),
|
adamc@325
|
569 (DOpen ("anon", []), loc)]
|
adamc@325
|
570 end)
|
adamc@88
|
571 | OPEN CONSTRAINTS mpath (case mpath of
|
adamc@88
|
572 [] => raise Fail "Impossible mpath parse [3]"
|
adamc@325
|
573 | m :: ms => [(DOpenConstraints (m, ms), s (OPENleft, mpathright))])
|
adamc@325
|
574 | CONSTRAINT cterm TWIDDLE cterm ([(DConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright))])
|
adamc@325
|
575 | EXPORT spath ([(DExport spath, s (EXPORTleft, spathright))])
|
adamc@707
|
576 | TABLE SYMBOL COLON cterm pkopt commaOpt cstopt([(DTable (SYMBOL, entable cterm, pkopt, cstopt),
|
adamc@707
|
577 s (TABLEleft, cstoptright))])
|
adamc@338
|
578 | SEQUENCE SYMBOL ([(DSequence SYMBOL, s (SEQUENCEleft, SYMBOLright))])
|
adamc@754
|
579 | VIEW SYMBOL EQ query ([(DView (SYMBOL, query),
|
adamc@754
|
580 s (VIEWleft, queryright))])
|
adamc@754
|
581 | VIEW SYMBOL EQ LBRACE eexp RBRACE ([(DView (SYMBOL, eexp),
|
adamc@754
|
582 s (VIEWleft, RBRACEright))])
|
adamc@563
|
583 | CLASS SYMBOL EQ cexp (let
|
adamc@563
|
584 val loc = s (CLASSleft, cexpright)
|
adamc@563
|
585 in
|
adamc@563
|
586 [(DClass (SYMBOL, (KWild, loc), cexp), loc)]
|
adamc@563
|
587 end)
|
adamc@563
|
588 | CLASS SYMBOL DCOLON kind EQ cexp ([(DClass (SYMBOL, kind, cexp), s (CLASSleft, cexpright))])
|
adamc@211
|
589 | CLASS SYMBOL SYMBOL EQ cexp (let
|
adamc@211
|
590 val loc = s (CLASSleft, cexpright)
|
adamc@563
|
591 val k = (KWild, loc)
|
adamc@211
|
592 val c = (CAbs (SYMBOL2, SOME k, cexp), loc)
|
adamc@211
|
593 in
|
adamc@563
|
594 [(DClass (SYMBOL1, k, c), s (CLASSleft, cexpright))]
|
adamc@563
|
595 end)
|
adamc@563
|
596 | CLASS SYMBOL LPAREN SYMBOL DCOLON kind RPAREN EQ cexp (let
|
adamc@563
|
597 val loc = s (CLASSleft, cexpright)
|
adamc@563
|
598 val c = (CAbs (SYMBOL2, SOME kind, cexp), loc)
|
adamc@563
|
599 in
|
adamc@563
|
600 [(DClass (SYMBOL1, kind, c), s (CLASSleft, cexpright))]
|
adamc@211
|
601 end)
|
adamc@459
|
602 | COOKIE SYMBOL COLON cexp ([(DCookie (SYMBOL, cexp), s (COOKIEleft, cexpright))])
|
adamc@720
|
603 | STYLE SYMBOL ([(DStyle SYMBOL, s (STYLEleft, SYMBOLright))])
|
adamc@1075
|
604 | TASK eapps EQ eexp ([(DTask (eapps, eexp), s (TASKleft, eexpright))])
|
adamc@1199
|
605 | POLICY eexp ([(DPolicy eexp, s (POLICYleft, eexpright))])
|
adamc@30
|
606
|
adamc@805
|
607 dtype : SYMBOL dargs EQ barOpt dcons (SYMBOL, dargs, dcons)
|
adamc@805
|
608
|
adamc@805
|
609 dtypes : dtype ([dtype])
|
adamc@805
|
610 | dtype AND dtypes (dtype :: dtypes)
|
adamc@805
|
611
|
adamc@240
|
612 kopt : (NONE)
|
adamc@240
|
613 | DCOLON kind (SOME kind)
|
adam@1302
|
614 | DCOLONWILD (SOME (KWild, s (DCOLONWILDleft, DCOLONWILDright)))
|
adamc@240
|
615
|
adamc@191
|
616 dargs : ([])
|
adamc@191
|
617 | SYMBOL dargs (SYMBOL :: dargs)
|
adamc@191
|
618
|
adamc@156
|
619 barOpt : ()
|
adamc@156
|
620 | BAR ()
|
adamc@156
|
621
|
adamc@156
|
622 dcons : dcon ([dcon])
|
adamc@156
|
623 | dcon BAR dcons (dcon :: dcons)
|
adamc@156
|
624
|
adamc@156
|
625 dcon : CSYMBOL (CSYMBOL, NONE)
|
adamc@156
|
626 | CSYMBOL OF cexp (CSYMBOL, SOME cexp)
|
adamc@156
|
627
|
adamc@242
|
628 vali : SYMBOL eargl2 copt EQ eexp (let
|
adamc@242
|
629 val loc = s (SYMBOLleft, eexpright)
|
adamc@242
|
630 val t = Option.getOpt (copt, (CWild (KType, loc), loc))
|
adamc@242
|
631
|
adamc@242
|
632 val (e, t) = eargl2 (eexp, t)
|
adamc@242
|
633 in
|
adamc@242
|
634 (SYMBOL, SOME t, e)
|
adamc@242
|
635 end)
|
adamc@242
|
636
|
adamc@242
|
637 copt : (NONE)
|
adamc@242
|
638 | COLON cexp (SOME cexp)
|
adamc@123
|
639
|
adamc@704
|
640 cstopt : (EVar (["Basis"], "no_constraint", Infer), dummy)
|
adamc@704
|
641 | csts (csts)
|
adamc@704
|
642
|
adamc@704
|
643 csts : CCONSTRAINT tname cst (let
|
adamc@704
|
644 val loc = s (CCONSTRAINTleft, cstright)
|
adamc@704
|
645
|
adamc@704
|
646 val e = (EVar (["Basis"], "one_constraint", Infer), loc)
|
adamc@704
|
647 val e = (ECApp (e, tname), loc)
|
adamc@704
|
648 in
|
adamc@704
|
649 (EApp (e, cst), loc)
|
adamc@704
|
650 end)
|
adamc@704
|
651 | csts COMMA csts (let
|
adamc@704
|
652 val loc = s (csts1left, csts2right)
|
adamc@704
|
653
|
adamc@704
|
654 val e = (EVar (["Basis"], "join_constraints", Infer), loc)
|
adamc@704
|
655 val e = (EApp (e, csts1), loc)
|
adamc@704
|
656 in
|
adamc@704
|
657 (EApp (e, csts2), loc)
|
adamc@704
|
658 end)
|
adamc@704
|
659 | LBRACE LBRACE eexp RBRACE RBRACE (eexp)
|
adamc@704
|
660
|
adamc@704
|
661 cst : UNIQUE tnames (let
|
adamc@704
|
662 val loc = s (UNIQUEleft, tnamesright)
|
adamc@704
|
663
|
adamc@704
|
664 val e = (EVar (["Basis"], "unique", Infer), loc)
|
adamc@705
|
665 val e = (ECApp (e, #1 (#1 tnames)), loc)
|
adamc@705
|
666 val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc)
|
adamc@704
|
667 in
|
adamc@1093
|
668 e
|
adamc@704
|
669 end)
|
adamc@709
|
670
|
adamc@714
|
671 | CHECK sqlexp (let
|
adamc@714
|
672 val loc = s (CHECKleft, sqlexpright)
|
adamc@714
|
673 in
|
adamc@714
|
674 (EApp ((EVar (["Basis"], "check", Infer), loc),
|
adamc@714
|
675 sqlexp), loc)
|
adamc@714
|
676 end)
|
adamc@714
|
677
|
adamc@709
|
678 | FOREIGN KEY tnames REFERENCES texp LPAREN tnames' RPAREN pmodes
|
adamc@709
|
679 (let
|
adamc@709
|
680 val loc = s (FOREIGNleft, pmodesright)
|
adamc@709
|
681
|
adamc@709
|
682 val mat = ListPair.foldrEq
|
adamc@709
|
683 (fn ((nm1, _), (nm2, _), mat) =>
|
adamc@709
|
684 let
|
adamc@709
|
685 val e = (EVar (["Basis"], "mat_cons", Infer), loc)
|
adamc@709
|
686 val e = (ECApp (e, nm1), loc)
|
adamc@709
|
687 val e = (ECApp (e, nm2), loc)
|
adamc@709
|
688 in
|
adamc@709
|
689 (EApp (e, mat), loc)
|
adamc@709
|
690 end)
|
adamc@709
|
691 (EVar (["Basis"], "mat_nil", Infer), loc)
|
adamc@709
|
692 (#1 tnames :: #2 tnames, #1 tnames' :: #2 tnames')
|
adam@1401
|
693 handle ListPair.UnequalLengths =>
|
adam@1401
|
694 (ErrorMsg.errorAt loc ("Unequal foreign key list lengths ("
|
adam@1401
|
695 ^ Int.toString (1 + length (#2 tnames))
|
adam@1401
|
696 ^ " vs. "
|
adam@1401
|
697 ^ Int.toString (1 + length (#2 tnames'))
|
adam@1401
|
698 ^ ")");
|
adam@1401
|
699 (EVar (["Basis"], "mat_nil", Infer), loc))
|
adamc@709
|
700
|
adamc@709
|
701 fun findMode mode =
|
adamc@709
|
702 let
|
adamc@709
|
703 fun findMode' pmodes =
|
adamc@709
|
704 case pmodes of
|
adamc@709
|
705 [] => (EVar (["Basis"], "no_action", Infer), loc)
|
adamc@709
|
706 | (mode', rule) :: pmodes' =>
|
adamc@709
|
707 if mode' = mode then
|
adamc@709
|
708 (if List.exists (fn (mode', _) => mode' = mode)
|
adamc@709
|
709 pmodes' then
|
adamc@709
|
710 ErrorMsg.errorAt loc "Duplicate propagation rule"
|
adamc@709
|
711 else
|
adamc@709
|
712 ();
|
adamc@709
|
713 rule)
|
adamc@709
|
714 else
|
adamc@709
|
715 findMode' pmodes'
|
adamc@709
|
716 in
|
adamc@709
|
717 findMode' pmodes
|
adamc@709
|
718 end
|
adamc@709
|
719
|
adamc@709
|
720 val e = (EVar (["Basis"], "foreign_key", Infer), loc)
|
adamc@709
|
721 val e = (EApp (e, mat), loc)
|
adamc@709
|
722 val e = (EApp (e, texp), loc)
|
adamc@709
|
723 in
|
adamc@709
|
724 (EApp (e, (ERecord [((CName "OnDelete", loc),
|
adamc@709
|
725 findMode Delete),
|
adamc@709
|
726 ((CName "OnUpdate", loc),
|
adamc@709
|
727 findMode Update)], loc)), loc)
|
adamc@709
|
728 end)
|
adamc@709
|
729
|
adamc@704
|
730 | LBRACE eexp RBRACE (eexp)
|
adamc@704
|
731
|
adamc@704
|
732 tnameW : tname (let
|
adamc@704
|
733 val loc = s (tnameleft, tnameright)
|
adamc@704
|
734 in
|
adamc@704
|
735 (tname, (CWild (KType, loc), loc))
|
adamc@704
|
736 end)
|
adamc@704
|
737
|
adamc@705
|
738 tnames : tnameW (tnameW, [])
|
adamc@705
|
739 | LPAREN tnames' RPAREN (tnames')
|
adamc@704
|
740
|
adamc@705
|
741 tnames': tnameW (tnameW, [])
|
adamc@705
|
742 | tnameW COMMA tnames' (#1 tnames', tnameW :: #2 tnames')
|
adamc@704
|
743
|
adamc@709
|
744 pmode : ON pkind prule (pkind, prule)
|
adamc@709
|
745
|
adamc@709
|
746 pkind : DELETE (Delete)
|
adamc@709
|
747 | UPDATE (Update)
|
adamc@709
|
748
|
adamc@709
|
749 prule : NO ACTION (EVar (["Basis"], "no_action", Infer), s (NOleft, ACTIONright))
|
adamc@709
|
750 | RESTRICT (EVar (["Basis"], "restrict", Infer), s (RESTRICTleft, RESTRICTright))
|
adamc@709
|
751 | CASCADE (EVar (["Basis"], "cascade", Infer), s (CASCADEleft, CASCADEright))
|
adamc@709
|
752 | SET NULL (EVar (["Basis"], "set_null", Infer), s (SETleft, NULLright))
|
adamc@709
|
753
|
adamc@709
|
754 pmodes : ([])
|
adamc@709
|
755 | pmode pmodes (pmode :: pmodes)
|
adamc@709
|
756
|
adamc@707
|
757 commaOpt: ()
|
adamc@707
|
758 | COMMA ()
|
adamc@707
|
759
|
adam@1722
|
760 pk : LBRACE LBRACE eexp RBRACE RBRACE (eexp)
|
adam@1722
|
761 | tnames (let
|
adam@1722
|
762 val loc = s (tnamesleft, tnamesright)
|
adamc@707
|
763
|
adamc@1093
|
764 val e = (EVar (["Basis"], "primary_key", TypesOnly), loc)
|
adamc@707
|
765 val e = (ECApp (e, #1 (#1 tnames)), loc)
|
adamc@707
|
766 val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc)
|
adamc@707
|
767 val e = (EDisjointApp e, loc)
|
adamc@707
|
768 val e = (EDisjointApp e, loc)
|
adamc@707
|
769
|
adamc@707
|
770 val witness = map (fn (c, _) =>
|
adamc@707
|
771 (c, (EWild, loc)))
|
adamc@707
|
772 (#1 tnames :: #2 tnames)
|
adamc@707
|
773 val witness = (ERecord witness, loc)
|
adamc@707
|
774 in
|
adamc@707
|
775 (EApp (e, witness), loc)
|
adamc@707
|
776 end)
|
adamc@707
|
777
|
adam@1722
|
778 pkopt : (EVar (["Basis"], "no_primary_key", Infer), dummy)
|
adam@1722
|
779 | PRIMARY KEY pk (pk)
|
adam@1722
|
780
|
adamc@123
|
781 valis : vali ([vali])
|
adamc@123
|
782 | vali AND valis (vali :: valis)
|
adamc@123
|
783
|
adamc@42
|
784 sgn : sgntm (sgntm)
|
adamc@40
|
785 | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN COLON sgn
|
adamc@40
|
786 (SgnFun (CSYMBOL, sgn1, sgn2), s (FUNCTORleft, sgn2right))
|
adamc@30
|
787
|
adamc@42
|
788 sgntm : SIG sgis END (SgnConst sgis, s (SIGleft, ENDright))
|
adamc@59
|
789 | mpath (case mpath of
|
adamc@61
|
790 [] => raise Fail "Impossible mpath parse [2]"
|
adamc@59
|
791 | [x] => SgnVar x
|
adamc@59
|
792 | m :: ms => SgnProj (m,
|
adamc@59
|
793 List.take (ms, length ms - 1),
|
adamc@59
|
794 List.nth (ms, length ms - 1)),
|
adamc@59
|
795 s (mpathleft, mpathright))
|
adamc@42
|
796 | sgntm WHERE CON SYMBOL EQ cexp (SgnWhere (sgntm, SYMBOL, cexp), s (sgntmleft, cexpright))
|
adamc@42
|
797 | sgntm WHERE LTYPE SYMBOL EQ cexp(SgnWhere (sgntm, SYMBOL, cexp), s (sgntmleft, cexpright))
|
adamc@42
|
798 | LPAREN sgn RPAREN (sgn)
|
adamc@42
|
799
|
adam@1577
|
800 cexpO : (NONE)
|
adam@1577
|
801 | EQ cexp (SOME cexp)
|
adam@1577
|
802
|
adam@1577
|
803 sgi : LTYPE SYMBOL ((SgiConAbs (SYMBOL, (KType, s (LTYPEleft, SYMBOLright))),
|
adamc@706
|
804 s (LTYPEleft, SYMBOLright)))
|
adam@1577
|
805 | CON SYMBOL cargl2 kopt cexpO (let
|
adam@1577
|
806 val loc = s (CONleft, cexpOright)
|
adam@1574
|
807
|
adam@1574
|
808 val k = Option.getOpt (kopt, (KWild, loc))
|
adam@1574
|
809 in
|
adam@1577
|
810 case cexpO of
|
adam@1577
|
811 NONE => (SgiConAbs (SYMBOL, k), loc)
|
adam@1577
|
812 | SOME cexp =>
|
adam@1577
|
813 let
|
adam@1577
|
814 val (c, k) = cargl2 (cexp, k)
|
adam@1577
|
815 in
|
adam@1577
|
816 (SgiCon (SYMBOL, SOME k, c), loc)
|
adam@1577
|
817 end
|
adam@1574
|
818 end)
|
adam@1654
|
819 | LTYPE SYMBOL cargl2 cexpO (let
|
adam@1654
|
820 val loc = s (LTYPEleft, cexpOright)
|
adam@1654
|
821
|
adam@1654
|
822 val k = (KWild, loc)
|
adam@1654
|
823 in
|
adam@1654
|
824 case cexpO of
|
adam@1654
|
825 NONE => (SgiConAbs (SYMBOL, k), loc)
|
adam@1654
|
826 | SOME cexp =>
|
adam@1654
|
827 let
|
adam@1654
|
828 val (c, k) = cargl2 (cexp, k)
|
adam@1654
|
829 in
|
adam@1654
|
830 (SgiCon (SYMBOL, SOME k, c), loc)
|
adam@1654
|
831 end
|
adam@1654
|
832 end)
|
adamc@805
|
833 | DATATYPE dtypes ((SgiDatatype dtypes, s (DATATYPEleft, dtypesright)))
|
adamc@191
|
834 | DATATYPE SYMBOL dargs EQ DATATYPE CSYMBOL DOT path
|
adamc@191
|
835 (case dargs of
|
adamc@191
|
836 [] => (SgiDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))
|
adamc@191
|
837 | _ => raise Fail "Arguments specified for imported datatype")
|
adamc@706
|
838 | VAL SYMBOL COLON cexp ((SgiVal (SYMBOL, cexp), s (VALleft, cexpright)))
|
adamc@30
|
839
|
adamc@706
|
840 | STRUCTURE CSYMBOL COLON sgn ((SgiStr (CSYMBOL, sgn), s (STRUCTUREleft, sgnright)))
|
adamc@706
|
841 | SIGNATURE CSYMBOL EQ sgn ((SgiSgn (CSYMBOL, sgn), s (SIGNATUREleft, sgnright)))
|
adamc@42
|
842 | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN COLON sgn
|
adamc@706
|
843 ((SgiStr (CSYMBOL1,
|
adamc@706
|
844 (SgnFun (CSYMBOL2, sgn1, sgn2), s (FUNCTORleft, sgn2right))),
|
adamc@706
|
845 s (FUNCTORleft, sgn2right)))
|
adamc@706
|
846 | INCLUDE sgn ((SgiInclude sgn, s (INCLUDEleft, sgnright)))
|
adamc@706
|
847 | CONSTRAINT cterm TWIDDLE cterm ((SgiConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright)))
|
adamc@707
|
848 | TABLE SYMBOL COLON cterm pkopt commaOpt cstopt (let
|
adamc@707
|
849 val loc = s (TABLEleft, ctermright)
|
adamc@707
|
850 in
|
adamc@707
|
851 (SgiTable (SYMBOL, entable cterm, pkopt, cstopt), loc)
|
adamc@707
|
852 end)
|
adamc@460
|
853 | SEQUENCE SYMBOL (let
|
adamc@460
|
854 val loc = s (SEQUENCEleft, SYMBOLright)
|
adamc@460
|
855 val t = (CVar (["Basis"], "sql_sequence"), loc)
|
adamc@460
|
856 in
|
adamc@460
|
857 (SgiVal (SYMBOL, t), loc)
|
adamc@460
|
858 end)
|
adamc@754
|
859 | VIEW SYMBOL COLON cexp (let
|
adamc@754
|
860 val loc = s (VIEWleft, cexpright)
|
adamc@754
|
861 val t = (CVar (["Basis"], "sql_view"), loc)
|
adamc@1076
|
862 val t = (CApp (t, entable cexp), loc)
|
adamc@754
|
863 in
|
adamc@754
|
864 (SgiVal (SYMBOL, t), loc)
|
adamc@754
|
865 end)
|
adamc@563
|
866 | CLASS SYMBOL (let
|
adamc@563
|
867 val loc = s (CLASSleft, SYMBOLright)
|
adamc@711
|
868 val k = (KArrow ((KType, loc), (KType, loc)), loc)
|
adamc@563
|
869 in
|
adamc@711
|
870 (SgiClassAbs (SYMBOL, k), loc)
|
adamc@563
|
871 end)
|
adamc@563
|
872 | CLASS SYMBOL DCOLON kind (let
|
adamc@563
|
873 val loc = s (CLASSleft, kindright)
|
adamc@563
|
874 in
|
adamc@563
|
875 (SgiClassAbs (SYMBOL, kind), loc)
|
adamc@563
|
876 end)
|
adamc@563
|
877 | CLASS SYMBOL EQ cexp (let
|
adamc@563
|
878 val loc = s (CLASSleft, cexpright)
|
adamc@563
|
879 in
|
adamc@563
|
880 (SgiClass (SYMBOL, (KWild, loc), cexp), loc)
|
adamc@563
|
881 end)
|
adamc@563
|
882 | CLASS SYMBOL DCOLON kind EQ cexp (let
|
adamc@563
|
883 val loc = s (CLASSleft, cexpright)
|
adamc@563
|
884 in
|
adamc@563
|
885 (SgiClass (SYMBOL, kind, cexp), loc)
|
adamc@563
|
886 end)
|
adamc@211
|
887 | CLASS SYMBOL SYMBOL EQ cexp (let
|
adamc@211
|
888 val loc = s (CLASSleft, cexpright)
|
adamc@563
|
889 val k = (KWild, loc)
|
adamc@211
|
890 val c = (CAbs (SYMBOL2, SOME k, cexp), loc)
|
adamc@211
|
891 in
|
adamc@563
|
892 (SgiClass (SYMBOL1, k, c), s (CLASSleft, cexpright))
|
adamc@563
|
893 end)
|
adamc@563
|
894 | CLASS SYMBOL LPAREN SYMBOL DCOLON kind RPAREN EQ cexp (let
|
adamc@563
|
895 val loc = s (CLASSleft, cexpright)
|
adamc@563
|
896 val c = (CAbs (SYMBOL2, SOME kind, cexp), loc)
|
adamc@563
|
897 in
|
adamc@563
|
898 (SgiClass (SYMBOL1, kind, c), s (CLASSleft, cexpright))
|
adamc@211
|
899 end)
|
adamc@460
|
900 | COOKIE SYMBOL COLON cexp (let
|
adamc@460
|
901 val loc = s (COOKIEleft, cexpright)
|
adamc@460
|
902 val t = (CApp ((CVar (["Basis"], "http_cookie"), loc),
|
adamc@460
|
903 entable cexp), loc)
|
adamc@460
|
904 in
|
adamc@460
|
905 (SgiVal (SYMBOL, t), loc)
|
adamc@460
|
906 end)
|
adamc@720
|
907 | STYLE SYMBOL (let
|
adamc@720
|
908 val loc = s (STYLEleft, SYMBOLright)
|
adamc@720
|
909 val t = (CVar (["Basis"], "css_class"), loc)
|
adamc@718
|
910 in
|
adamc@718
|
911 (SgiVal (SYMBOL, t), loc)
|
adamc@718
|
912 end)
|
adamc@30
|
913
|
adamc@30
|
914 sgis : ([])
|
adamc@30
|
915 | sgi sgis (sgi :: sgis)
|
adamc@30
|
916
|
adamc@30
|
917 str : STRUCT decls END (StrConst decls, s (STRUCTleft, ENDright))
|
adamc@34
|
918 | spath (spath)
|
adamc@40
|
919 | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN DARROW str
|
adamc@40
|
920 (StrFun (CSYMBOL, sgn, NONE, str), s (FUNCTORleft, strright))
|
adamc@40
|
921 | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN COLON sgn DARROW str
|
adamc@40
|
922 (StrFun (CSYMBOL, sgn1, SOME sgn2, str), s (FUNCTORleft, strright))
|
adamc@44
|
923 | spath LPAREN str RPAREN (StrApp (spath, str), s (spathleft, RPARENright))
|
adamc@34
|
924
|
adamc@34
|
925 spath : CSYMBOL (StrVar CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
|
adamc@34
|
926 | spath DOT CSYMBOL (StrProj (spath, CSYMBOL), s (spathleft, CSYMBOLright))
|
adamc@30
|
927
|
adamc@1
|
928 kind : TYPE (KType, s (TYPEleft, TYPEright))
|
adamc@1
|
929 | NAME (KName, s (NAMEleft, NAMEright))
|
adamc@1
|
930 | LBRACE kind RBRACE (KRecord kind, s (LBRACEleft, RBRACEright))
|
adamc@1
|
931 | kind ARROW kind (KArrow (kind1, kind2), s (kind1left, kind2right))
|
adamc@1
|
932 | LPAREN kind RPAREN (#1 kind, s (LPARENleft, RPARENright))
|
adamc@82
|
933 | KUNIT (KUnit, s (KUNITleft, KUNITright))
|
adamc@18
|
934 | UNDERUNDER (KWild, s (UNDERUNDERleft, UNDERUNDERright))
|
adamc@207
|
935 | LPAREN ktuple RPAREN (KTuple ktuple, s (LPARENleft, RPARENright))
|
adamc@623
|
936 | CSYMBOL (KVar CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
|
adamc@623
|
937 | CSYMBOL KARROW kind (KFun (CSYMBOL, kind), s (CSYMBOLleft, kindright))
|
adamc@207
|
938
|
adamc@207
|
939 ktuple : kind STAR kind ([kind1, kind2])
|
adamc@207
|
940 | kind STAR ktuple (kind :: ktuple)
|
adamc@1
|
941
|
adamc@1
|
942 capps : cterm (cterm)
|
adamc@1
|
943 | capps cterm (CApp (capps, cterm), s (cappsleft, ctermright))
|
adamc@1
|
944
|
adamc@1
|
945 cexp : capps (capps)
|
adamc@1
|
946 | cexp ARROW cexp (TFun (cexp1, cexp2), s (cexp1left, cexp2right))
|
adamc@15
|
947 | SYMBOL kcolon kind ARROW cexp (TCFun (kcolon, SYMBOL, kind, cexp), s (SYMBOLleft, cexpright))
|
adamc@623
|
948 | CSYMBOL KARROW cexp (TKFun (CSYMBOL, cexp), s (CSYMBOLleft, cexpright))
|
adamc@1
|
949
|
adamc@1
|
950 | cexp PLUSPLUS cexp (CConcat (cexp1, cexp2), s (cexp1left, cexp1right))
|
adamc@1
|
951
|
adamc@239
|
952 | FN cargs DARROW cexp (#1 (cargs (cexp, (KWild, s (FNleft, cexpright)))))
|
adamc@628
|
953 | LBRACK cexp TWIDDLE cexp RBRACK DARROW cexp (TDisjoint (cexp1, cexp2, cexp3), s (LBRACKleft, cexp3right))
|
adamc@623
|
954 | CSYMBOL DKARROW cexp (CKAbs (CSYMBOL, cexp), s (CSYMBOLleft, cexpright))
|
adamc@1
|
955
|
adamc@8
|
956 | LPAREN cexp RPAREN DCOLON kind (CAnnot (cexp, kind), s (LPARENleft, kindright))
|
adamc@6
|
957
|
adamc@18
|
958 | UNDER DCOLON kind (CWild kind, s (UNDERleft, UNDERright))
|
adamc@195
|
959 | ctuple (let
|
adamc@195
|
960 val loc = s (ctupleleft, ctupleright)
|
adamc@195
|
961 in
|
adamc@195
|
962 (TRecord (CRecord (ListUtil.mapi (fn (i, c) =>
|
adamc@195
|
963 ((CName (Int.toString (i + 1)), loc),
|
adamc@195
|
964 c)) ctuple),
|
adamc@195
|
965 loc), loc)
|
adamc@195
|
966 end)
|
adamc@18
|
967
|
adamc@1
|
968 kcolon : DCOLON (Explicit)
|
adamc@1
|
969 | TCOLON (Implicit)
|
adamc@1
|
970
|
adamc@239
|
971 cargs : carg (carg)
|
adamc@239
|
972 | cargl (cargl)
|
adamc@239
|
973
|
adamc@239
|
974 cargl : cargp cargp (cargp1 o cargp2)
|
adamc@239
|
975 | cargp cargl (cargp o cargl)
|
adamc@239
|
976
|
adamc@240
|
977 cargl2 : (fn x => x)
|
adamc@240
|
978 | cargp cargl2 (cargp o cargl2)
|
adamc@240
|
979
|
adamc@241
|
980 carg : SYMBOL DCOLON kind (fn (c, k) =>
|
adamc@239
|
981 let
|
adamc@239
|
982 val loc = s (SYMBOLleft, kindright)
|
adamc@239
|
983 in
|
adamc@239
|
984 ((CAbs (SYMBOL, SOME kind, c), loc),
|
adamc@239
|
985 (KArrow (kind, k), loc))
|
adamc@239
|
986 end)
|
adamc@329
|
987 | UNDER DCOLON kind (fn (c, k) =>
|
adamc@329
|
988 let
|
adamc@329
|
989 val loc = s (UNDERleft, kindright)
|
adamc@329
|
990 in
|
adamc@329
|
991 ((CAbs ("_", SOME kind, c), loc),
|
adamc@329
|
992 (KArrow (kind, k), loc))
|
adamc@329
|
993 end)
|
adam@1302
|
994 | SYMBOL DCOLONWILD (fn (c, k) =>
|
adam@1302
|
995 let
|
adam@1302
|
996 val loc = s (SYMBOLleft, DCOLONWILDright)
|
adam@1302
|
997 val kind = (KWild, loc)
|
adam@1302
|
998 in
|
adam@1302
|
999 ((CAbs (SYMBOL, NONE, c), loc),
|
adam@1302
|
1000 (KArrow (kind, k), loc))
|
adam@1302
|
1001 end)
|
adam@1302
|
1002 | UNDER DCOLONWILD (fn (c, k) =>
|
adam@1302
|
1003 let
|
adam@1302
|
1004 val loc = s (UNDERleft, DCOLONWILDright)
|
adam@1302
|
1005 val kind = (KWild, loc)
|
adam@1302
|
1006 in
|
adam@1302
|
1007 ((CAbs ("_", NONE, c), loc),
|
adam@1302
|
1008 (KArrow (kind, k), loc))
|
adam@1302
|
1009 end)
|
adamc@241
|
1010 | cargp (cargp)
|
adamc@239
|
1011
|
adamc@239
|
1012 cargp : SYMBOL (fn (c, k) =>
|
adamc@239
|
1013 let
|
adamc@239
|
1014 val loc = s (SYMBOLleft, SYMBOLright)
|
adamc@239
|
1015 in
|
adamc@239
|
1016 ((CAbs (SYMBOL, NONE, c), loc),
|
adamc@239
|
1017 (KArrow ((KWild, loc), k), loc))
|
adamc@239
|
1018 end)
|
adamc@329
|
1019 | UNDER (fn (c, k) =>
|
adamc@329
|
1020 let
|
adamc@329
|
1021 val loc = s (UNDERleft, UNDERright)
|
adamc@329
|
1022 in
|
adamc@329
|
1023 ((CAbs ("_", NONE, c), loc),
|
adamc@329
|
1024 (KArrow ((KWild, loc), k), loc))
|
adamc@329
|
1025 end)
|
adamc@1001
|
1026 | LPAREN SYMBOL kopt ckl RPAREN (fn (c, k) =>
|
adamc@239
|
1027 let
|
adamc@239
|
1028 val loc = s (LPARENleft, RPARENright)
|
adamc@1001
|
1029 val ckl = (SYMBOL, kopt) :: ckl
|
adamc@1001
|
1030 val ckl = map (fn (x, ko) => (x, case ko of
|
adamc@1001
|
1031 NONE => (KWild, loc)
|
adamc@1001
|
1032 | SOME k => k)) ckl
|
adamc@239
|
1033 in
|
adamc@1001
|
1034 case ckl of
|
adamc@1001
|
1035 [(x, k')] => ((CAbs (SYMBOL, SOME k', c), loc),
|
adamc@1001
|
1036 (KArrow (k', k), loc))
|
adamc@1001
|
1037 | _ =>
|
adamc@1001
|
1038 let
|
adamc@1001
|
1039 val k' = (KTuple (map #2 ckl), loc)
|
adamc@1001
|
1040
|
adamc@1001
|
1041 val c = foldr (fn ((x, k), c) =>
|
adamc@1001
|
1042 (CAbs (x, SOME k, c), loc)) c ckl
|
adamc@1001
|
1043 val v = (CVar ([], "$x"), loc)
|
adamc@1001
|
1044 val c = ListUtil.foldli (fn (i, _, c) =>
|
adamc@1001
|
1045 (CApp (c, (CProj (v, i + 1), loc)),
|
adamc@1001
|
1046 loc)) c ckl
|
adamc@1001
|
1047 in
|
adamc@1001
|
1048 ((CAbs ("$x", SOME k', c), loc),
|
adamc@1001
|
1049 (KArrow (k', k), loc))
|
adamc@1001
|
1050 end
|
adamc@239
|
1051 end)
|
adamc@628
|
1052
|
adamc@1001
|
1053 ckl : ([])
|
adamc@1001
|
1054 | COMMA SYMBOL kopt ckl ((SYMBOL, kopt) :: ckl)
|
adamc@239
|
1055
|
adamc@34
|
1056 path : SYMBOL ([], SYMBOL)
|
adamc@34
|
1057 | CSYMBOL DOT path (let val (ms, x) = path in (CSYMBOL :: ms, x) end)
|
adamc@34
|
1058
|
adamc@156
|
1059 cpath : CSYMBOL ([], CSYMBOL)
|
adamc@156
|
1060 | CSYMBOL DOT cpath (let val (ms, x) = cpath in (CSYMBOL :: ms, x) end)
|
adamc@156
|
1061
|
adamc@59
|
1062 mpath : CSYMBOL ([CSYMBOL])
|
adamc@59
|
1063 | CSYMBOL DOT mpath (CSYMBOL :: mpath)
|
adamc@59
|
1064
|
adamc@1
|
1065 cterm : LPAREN cexp RPAREN (#1 cexp, s (LPARENleft, RPARENright))
|
adamc@1
|
1066 | LBRACK rcon RBRACK (CRecord rcon, s (LBRACKleft, RBRACKright))
|
adamc@83
|
1067 | LBRACK rconn RBRACK (CRecord rconn, s (LBRACKleft, RBRACKright))
|
adamc@1
|
1068 | LBRACE rcone RBRACE (TRecord (CRecord rcone, s (LBRACEleft, RBRACEright)),
|
adamc@1
|
1069 s (LBRACEleft, RBRACEright))
|
adamc@1
|
1070 | DOLLAR cterm (TRecord cterm, s (DOLLARleft, ctermright))
|
adamc@1
|
1071 | HASH CSYMBOL (CName CSYMBOL, s (HASHleft, CSYMBOLright))
|
adamc@195
|
1072 | HASH INT (CName (Int64.toString INT), s (HASHleft, INTright))
|
adamc@1
|
1073
|
adamc@34
|
1074 | path (CVar path, s (pathleft, pathright))
|
adamc@207
|
1075 | path DOT INT (CProj ((CVar path, s (pathleft, pathright)), Int64.toInt INT),
|
adamc@207
|
1076 s (pathleft, INTright))
|
adamc@18
|
1077 | UNDER (CWild (KWild, s (UNDERleft, UNDERright)), s (UNDERleft, UNDERright))
|
adamc@621
|
1078 | MAP (CMap, s (MAPleft, MAPright))
|
adamc@82
|
1079 | UNIT (CUnit, s (UNITleft, UNITright))
|
adamc@207
|
1080 | LPAREN ctuplev RPAREN (CTuple ctuplev, s (LPARENleft, RPARENright))
|
adamc@207
|
1081
|
adamc@207
|
1082 ctuplev: cexp COMMA cexp ([cexp1, cexp2])
|
adamc@207
|
1083 | cexp COMMA ctuplev (cexp :: ctuplev)
|
adamc@1
|
1084
|
adamc@196
|
1085 ctuple : capps STAR capps ([capps1, capps2])
|
adamc@196
|
1086 | capps STAR ctuple (capps :: ctuple)
|
adamc@195
|
1087
|
adamc@1
|
1088 rcon : ([])
|
adamc@1
|
1089 | ident EQ cexp ([(ident, cexp)])
|
adamc@1
|
1090 | ident EQ cexp COMMA rcon ((ident, cexp) :: rcon)
|
adamc@1
|
1091
|
adamc@83
|
1092 rconn : ident ([(ident, (CUnit, s (identleft, identright)))])
|
adamc@83
|
1093 | ident COMMA rconn ((ident, (CUnit, s (identleft, identright))) :: rconn)
|
adamc@83
|
1094
|
adamc@1
|
1095 rcone : ([])
|
adamc@1
|
1096 | ident COLON cexp ([(ident, cexp)])
|
adamc@1
|
1097 | ident COLON cexp COMMA rcone ((ident, cexp) :: rcone)
|
adamc@1
|
1098
|
adamc@1
|
1099 ident : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
|
adamc@195
|
1100 | INT (CName (Int64.toString INT), s (INTleft, INTright))
|
adamc@200
|
1101 | SYMBOL (CVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright))
|
adamc@8
|
1102
|
adamc@8
|
1103 eapps : eterm (eterm)
|
adamc@8
|
1104 | eapps eterm (EApp (eapps, eterm), s (eappsleft, etermright))
|
adamc@8
|
1105 | eapps LBRACK cexp RBRACK (ECApp (eapps, cexp), s (eappsleft, RBRACKright))
|
adamc@629
|
1106 | eapps BANG (EDisjointApp eapps, s (eappsleft, BANGright))
|
adamc@8
|
1107
|
adamc@8
|
1108 eexp : eapps (eapps)
|
adamc@241
|
1109 | FN eargs DARROW eexp (let
|
adamc@93
|
1110 val loc = s (FNleft, eexpright)
|
adamc@93
|
1111 in
|
adamc@241
|
1112 #1 (eargs (eexp, (CWild (KType, loc), loc)))
|
adamc@93
|
1113 end)
|
adamc@623
|
1114 | CSYMBOL DKARROW eexp (EKAbs (CSYMBOL, eexp), s (CSYMBOLleft, eexpright))
|
adamc@196
|
1115 | eexp COLON cexp (EAnnot (eexp, cexp), s (eexpleft, cexpright))
|
adamc@149
|
1116 | eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright))
|
adamc@493
|
1117 | eexp MINUSMINUSMINUS cexp (ECutMulti (eexp, cexp), s (eexpleft, cexpright))
|
adamc@170
|
1118 | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright))
|
adamc@190
|
1119 | IF eexp THEN eexp ELSE eexp (let
|
adamc@190
|
1120 val loc = s (IFleft, eexp3right)
|
adamc@190
|
1121 in
|
adamc@190
|
1122 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2),
|
adamc@190
|
1123 ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc)
|
adamc@190
|
1124 end)
|
adamc@434
|
1125 | bind SEMI eexp (let
|
adamc@434
|
1126 val loc = s (bindleft, eexpright)
|
adamc@434
|
1127 val (v, to, e1) = bind
|
adamc@403
|
1128 val e = (EVar (["Basis"], "bind", Infer), loc)
|
adamc@434
|
1129 val e = (EApp (e, e1), loc)
|
adamc@243
|
1130 in
|
adamc@434
|
1131 (EApp (e, (EAbs (v, to, eexp), loc)), loc)
|
adamc@299
|
1132 end)
|
adamc@256
|
1133 | eexp EQ eexp (native_op ("eq", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@257
|
1134 | eexp NE eexp (native_op ("ne", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@389
|
1135 | MINUS eterm (native_unop ("neg", eterm, s (MINUSleft, etermright)))
|
adamc@389
|
1136 | eexp PLUS eexp (native_op ("plus", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@389
|
1137 | eexp MINUS eexp (native_op ("minus", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@1116
|
1138 | eapps STAR eexp (native_op ("times", eapps, eexp, s (eappsleft, eexpright)))
|
adamc@964
|
1139 | eexp DIVIDE eexp (native_op ("divide", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@389
|
1140 | eexp MOD eexp (native_op ("mod", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@391
|
1141
|
adamc@391
|
1142 | eexp LT eexp (native_op ("lt", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@391
|
1143 | eexp LE eexp (native_op ("le", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@391
|
1144 | eexp GT eexp (native_op ("gt", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@391
|
1145 | eexp GE eexp (native_op ("ge", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@391
|
1146
|
adamc@842
|
1147 | eexp ANDALSO eexp (let
|
adamc@842
|
1148 val loc = s (eexp1left, eexp2right)
|
adamc@842
|
1149 in
|
adamc@842
|
1150 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc),
|
adamc@842
|
1151 eexp2),
|
adamc@842
|
1152 ((PCon (["Basis"], "False", NONE), loc),
|
adamc@842
|
1153 (EVar (["Basis"], "False", Infer), loc))]), loc)
|
adamc@842
|
1154 end)
|
adamc@842
|
1155 | eexp ORELSE eexp (let
|
adamc@842
|
1156 val loc = s (eexp1left, eexp2right)
|
adamc@842
|
1157 in
|
adamc@842
|
1158 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc),
|
adamc@842
|
1159 (EVar (["Basis"], "True", Infer), loc)),
|
adamc@842
|
1160 ((PCon (["Basis"], "False", NONE), loc),
|
adamc@842
|
1161 eexp2)]), loc)
|
adamc@842
|
1162 end)
|
adamc@842
|
1163
|
adamc@445
|
1164 | eexp PLUSPLUS eexp (EConcat (eexp1, eexp2), s (eexp1left, eexp2right))
|
adamc@8
|
1165
|
adamc@674
|
1166 | eexp CARET eexp (native_op ("strcat", eexp1, eexp2, s (eexp1left, eexp2right)))
|
adamc@674
|
1167
|
adamc@794
|
1168 | eapps DCOLON eexp (let
|
adamc@794
|
1169 val loc = s (eappsleft, eexpright)
|
adamc@762
|
1170 in
|
adamc@762
|
1171 (EApp ((EVar (["Basis"], "Cons", Infer), loc),
|
adamc@762
|
1172 (ERecord [((CName "1", loc),
|
adamc@794
|
1173 eapps),
|
adamc@762
|
1174 ((CName "2", loc),
|
adamc@762
|
1175 eexp)], loc)), loc)
|
adamc@762
|
1176 end)
|
adamc@762
|
1177
|
adamc@434
|
1178 bind : SYMBOL LARROW eapps (SYMBOL, NONE, eapps)
|
adamc@434
|
1179 | eapps (let
|
adamc@434
|
1180 val loc = s (eappsleft, eappsright)
|
adamc@434
|
1181 in
|
adamc@434
|
1182 ("_", SOME (TRecord (CRecord [], loc), loc), eapps)
|
adamc@434
|
1183 end)
|
adamc@434
|
1184
|
adamc@241
|
1185 eargs : earg (earg)
|
adamc@241
|
1186 | eargl (eargl)
|
adamc@241
|
1187
|
adamc@241
|
1188 eargl : eargp eargp (eargp1 o eargp2)
|
adamc@241
|
1189 | eargp eargl (eargp o eargl)
|
adamc@241
|
1190
|
adamc@242
|
1191 eargl2 : (fn x => x)
|
adamc@242
|
1192 | eargp eargl2 (eargp o eargl2)
|
adamc@242
|
1193
|
adamc@822
|
1194 earg : patS (fn (e, t) =>
|
adamc@241
|
1195 let
|
adamc@822
|
1196 val loc = s (patSleft, patSright)
|
adamc@822
|
1197 val pt = patType loc patS
|
adamc@822
|
1198
|
adamc@822
|
1199 val e' = case #1 patS of
|
adamc@822
|
1200 PVar x => (EAbs (x, NONE, e), loc)
|
adamc@823
|
1201 | PAnnot ((PVar x, _), t) => (EAbs (x, SOME t, e), loc)
|
adamc@822
|
1202 | _ => (EAbs ("$x", SOME pt,
|
adamc@822
|
1203 (ECase ((EVar ([], "$x", DontInfer),
|
adamc@822
|
1204 loc),
|
adamc@822
|
1205 [(patS, e)]), loc)), loc)
|
adamc@241
|
1206 in
|
adamc@822
|
1207 (e', (TFun (pt, t), loc))
|
adamc@241
|
1208 end)
|
adamc@822
|
1209 | earga (earga)
|
adamc@822
|
1210
|
adamc@822
|
1211 eargp : pterm (fn (e, t) =>
|
adamc@241
|
1212 let
|
adamc@822
|
1213 val loc = s (ptermleft, ptermright)
|
adamc@822
|
1214 val pt = patType loc pterm
|
adamc@822
|
1215
|
adamc@822
|
1216 val e' = case #1 pterm of
|
adamc@822
|
1217 PVar x => (EAbs (x, NONE, e), loc)
|
adamc@823
|
1218 | PAnnot ((PVar x, _), t) => (EAbs (x, SOME t, e), loc)
|
adamc@822
|
1219 | _ => (EAbs ("$x", SOME pt,
|
adamc@822
|
1220 (ECase ((EVar ([], "$x", DontInfer),
|
adamc@822
|
1221 loc),
|
adamc@822
|
1222 [(pterm, e)]), loc)), loc)
|
adamc@241
|
1223 in
|
adamc@822
|
1224 (e', (TFun (pt, t), loc))
|
adamc@241
|
1225 end)
|
adamc@822
|
1226 | earga (earga)
|
adamc@241
|
1227
|
adamc@822
|
1228 earga : LBRACK SYMBOL RBRACK (fn (e, t) =>
|
adamc@241
|
1229 let
|
adamc@822
|
1230 val loc = s (LBRACKleft, RBRACKright)
|
adamc@822
|
1231 val kind = (KWild, loc)
|
adamc@822
|
1232 in
|
adamc@822
|
1233 ((ECAbs (Implicit, SYMBOL, kind, e), loc),
|
adamc@822
|
1234 (TCFun (Implicit, SYMBOL, kind, t), loc))
|
adamc@822
|
1235 end)
|
adam@1302
|
1236 | LBRACK SYMBOL DCOLONWILD RBRACK (fn (e, t) =>
|
adam@1302
|
1237 let
|
adam@1302
|
1238 val loc = s (LBRACKleft, RBRACKright)
|
adam@1302
|
1239 val kind = (KWild, loc)
|
adam@1302
|
1240 in
|
adam@1302
|
1241 ((ECAbs (Explicit, SYMBOL, kind, e), loc),
|
adam@1302
|
1242 (TCFun (Explicit, SYMBOL, kind, t), loc))
|
adam@1302
|
1243 end)
|
adamc@822
|
1244 | LBRACK SYMBOL kcolon kind RBRACK(fn (e, t) =>
|
adamc@822
|
1245 let
|
adamc@822
|
1246 val loc = s (LBRACKleft, RBRACKright)
|
adamc@241
|
1247 in
|
adamc@241
|
1248 ((ECAbs (kcolon, SYMBOL, kind, e), loc),
|
adamc@241
|
1249 (TCFun (kcolon, SYMBOL, kind, t), loc))
|
adamc@241
|
1250 end)
|
adam@1306
|
1251 | LBRACK SYMBOL TCOLONWILD RBRACK (fn (e, t) =>
|
adam@1306
|
1252 let
|
adam@1306
|
1253 val loc = s (LBRACKleft, RBRACKright)
|
adam@1306
|
1254 val kind = (KWild, loc)
|
adam@1306
|
1255 in
|
adam@1306
|
1256 ((ECAbs (Implicit, SYMBOL, kind, e), loc),
|
adam@1306
|
1257 (TCFun (Implicit, SYMBOL, kind, t), loc))
|
adam@1306
|
1258 end)
|
adamc@478
|
1259 | LBRACK cexp TWIDDLE cexp RBRACK(fn (e, t) =>
|
adamc@356
|
1260 let
|
adamc@356
|
1261 val loc = s (LBRACKleft, RBRACKright)
|
adamc@356
|
1262 in
|
adamc@478
|
1263 ((EDisjoint (cexp1, cexp2, e), loc),
|
adamc@628
|
1264 (TDisjoint (cexp1, cexp2, t), loc))
|
adamc@356
|
1265 end)
|
adamc@822
|
1266 | LBRACK CSYMBOL RBRACK (fn (e, t) =>
|
adamc@623
|
1267 let
|
adamc@623
|
1268 val loc = s (CSYMBOLleft, CSYMBOLright)
|
adamc@623
|
1269 in
|
adamc@623
|
1270 ((EKAbs (CSYMBOL, e), loc),
|
adamc@623
|
1271 (TKFun (CSYMBOL, t), loc))
|
adamc@623
|
1272 end)
|
adamc@241
|
1273
|
adamc@8
|
1274 eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
|
adamc@195
|
1275 | LPAREN etuple RPAREN (let
|
adamc@195
|
1276 val loc = s (LPARENleft, RPARENright)
|
adamc@195
|
1277 in
|
adamc@195
|
1278 (ERecord (ListUtil.mapi (fn (i, e) =>
|
adamc@195
|
1279 ((CName (Int.toString (i + 1)), loc),
|
adamc@195
|
1280 e)) etuple), loc)
|
adamc@195
|
1281 end)
|
adamc@8
|
1282
|
adamc@403
|
1283 | path (EVar (#1 path, #2 path, Infer), s (pathleft, pathright))
|
adamc@403
|
1284 | cpath (EVar (#1 cpath, #2 cpath, Infer), s (cpathleft, cpathright))
|
adamc@403
|
1285 | AT path (EVar (#1 path, #2 path, TypesOnly), s (ATleft, pathright))
|
adamc@403
|
1286 | AT AT path (EVar (#1 path, #2 path, DontInfer), s (AT1left, pathright))
|
adamc@403
|
1287 | AT cpath (EVar (#1 cpath, #2 cpath, TypesOnly), s (ATleft, cpathright))
|
adamc@403
|
1288 | AT AT cpath (EVar (#1 cpath, #2 cpath, DontInfer), s (AT1left, cpathright))
|
adamc@12
|
1289 | LBRACE rexp RBRACE (ERecord rexp, s (LBRACEleft, RBRACEright))
|
adamc@110
|
1290 | UNIT (ERecord [], s (UNITleft, UNITright))
|
adamc@12
|
1291
|
adamc@14
|
1292 | INT (EPrim (Prim.Int INT), s (INTleft, INTright))
|
adamc@14
|
1293 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
|
adamc@14
|
1294 | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
|
adamc@821
|
1295 | CHAR (EPrim (Prim.Char CHAR), s (CHARleft, CHARright))
|
adamc@14
|
1296
|
adamc@200
|
1297 | path DOT idents (let
|
adamc@200
|
1298 val loc = s (pathleft, identsright)
|
adamc@200
|
1299 in
|
adamc@200
|
1300 foldl (fn (ident, e) =>
|
adamc@200
|
1301 (EField (e, ident), loc))
|
adamc@403
|
1302 (EVar (#1 path, #2 path, Infer), s (pathleft, pathright)) idents
|
adamc@403
|
1303 end)
|
adamc@910
|
1304 | LPAREN eexp RPAREN DOT idents (let
|
adamc@910
|
1305 val loc = s (LPARENleft, identsright)
|
adamc@910
|
1306 in
|
adamc@910
|
1307 foldl (fn (ident, e) =>
|
adamc@910
|
1308 (EField (e, ident), loc))
|
adamc@910
|
1309 eexp idents
|
adamc@910
|
1310 end)
|
adamc@403
|
1311 | AT path DOT idents (let
|
adamc@403
|
1312 val loc = s (ATleft, identsright)
|
adamc@403
|
1313 in
|
adamc@403
|
1314 foldl (fn (ident, e) =>
|
adamc@403
|
1315 (EField (e, ident), loc))
|
adamc@403
|
1316 (EVar (#1 path, #2 path, TypesOnly), s (pathleft, pathright)) idents
|
adamc@403
|
1317 end)
|
adamc@403
|
1318 | AT AT path DOT idents (let
|
adamc@403
|
1319 val loc = s (AT1left, identsright)
|
adamc@403
|
1320 in
|
adamc@403
|
1321 foldl (fn (ident, e) =>
|
adamc@403
|
1322 (EField (e, ident), loc))
|
adamc@403
|
1323 (EVar (#1 path, #2 path, DontInfer), s (pathleft, pathright)) idents
|
adamc@200
|
1324 end)
|
adamc@71
|
1325
|
adamc@360
|
1326 | XML_BEGIN xml XML_END (let
|
adamc@360
|
1327 val loc = s (XML_BEGINleft, XML_ENDright)
|
adamc@360
|
1328 in
|
adamc@360
|
1329 if XML_BEGIN = "xml" then
|
adamc@360
|
1330 ()
|
adamc@360
|
1331 else
|
adamc@360
|
1332 ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\".";
|
adamc@360
|
1333 xml
|
adamc@360
|
1334 end)
|
adamc@360
|
1335 | XML_BEGIN XML_END (let
|
adamc@360
|
1336 val loc = s (XML_BEGINleft, XML_ENDright)
|
adamc@360
|
1337 in
|
adamc@360
|
1338 if XML_BEGIN = "xml" then
|
adamc@360
|
1339 ()
|
adamc@360
|
1340 else
|
adamc@360
|
1341 ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\".";
|
adamc@403
|
1342 (EApp ((EVar (["Basis"], "cdata", Infer), loc),
|
adamc@360
|
1343 (EPrim (Prim.String ""), loc)),
|
adamc@360
|
1344 loc)
|
adamc@360
|
1345 end)
|
adamc@360
|
1346 | XML_BEGIN_END (let
|
adamc@360
|
1347 val loc = s (XML_BEGIN_ENDleft, XML_BEGIN_ENDright)
|
adamc@360
|
1348 in
|
adamc@360
|
1349 if XML_BEGIN_END = "xml" then
|
adamc@360
|
1350 ()
|
adamc@360
|
1351 else
|
adamc@360
|
1352 ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\".";
|
adamc@403
|
1353 (EApp ((EVar (["Basis"], "cdata", Infer), loc),
|
adamc@360
|
1354 (EPrim (Prim.String ""), loc)),
|
adamc@360
|
1355 loc)
|
adamc@360
|
1356 end)
|
adamc@302
|
1357
|
adamc@204
|
1358 | LPAREN query RPAREN (query)
|
adamc@300
|
1359 | LPAREN CWHERE sqlexp RPAREN (sqlexp)
|
adamc@339
|
1360 | LPAREN SQL sqlexp RPAREN (sqlexp)
|
adamc@1070
|
1361 | LPAREN FROM tables RPAREN (#2 tables)
|
adamc@1071
|
1362 | LPAREN SELECT1 query1 RPAREN (query1)
|
adamc@302
|
1363
|
adamc@302
|
1364 | LPAREN INSERT INTO texp LPAREN fields RPAREN VALUES LPAREN sqlexps RPAREN RPAREN
|
adamc@302
|
1365 (let
|
adamc@302
|
1366 val loc = s (LPAREN1left, RPAREN3right)
|
adamc@302
|
1367
|
adamc@403
|
1368 val e = (EVar (["Basis"], "insert", Infer), loc)
|
adamc@302
|
1369 val e = (EApp (e, texp), loc)
|
adamc@302
|
1370 in
|
adamc@302
|
1371 if length fields <> length sqlexps then
|
adam@1360
|
1372 ErrorMsg.errorAt loc ("Length mismatch in INSERT field specification ("
|
adam@1360
|
1373 ^ Int.toString (length fields)
|
adam@1360
|
1374 ^ " vs. " ^ Int.toString (length sqlexps) ^ ")")
|
adamc@302
|
1375 else
|
adamc@302
|
1376 ();
|
adamc@302
|
1377 (EApp (e, (ERecord (ListPair.zip (fields, sqlexps)), loc)), loc)
|
adamc@302
|
1378 end)
|
adamc@310
|
1379 | LPAREN enterDml UPDATE texp SET fsets CWHERE sqlexp leaveDml RPAREN
|
adamc@303
|
1380 (let
|
adamc@303
|
1381 val loc = s (LPARENleft, RPARENright)
|
adamc@303
|
1382
|
adamc@403
|
1383 val e = (EVar (["Basis"], "update", Infer), loc)
|
adamc@342
|
1384 val e = (ECApp (e, (CWild (KRecord (KType, loc), loc), loc)), loc)
|
adamc@306
|
1385 val e = (EApp (e, (ERecord fsets, loc)), loc)
|
adamc@305
|
1386 val e = (EApp (e, texp), loc)
|
adamc@303
|
1387 in
|
adamc@303
|
1388 (EApp (e, sqlexp), loc)
|
adamc@303
|
1389 end)
|
adamc@310
|
1390 | LPAREN enterDml DELETE FROM texp CWHERE sqlexp leaveDml RPAREN
|
adamc@304
|
1391 (let
|
adamc@304
|
1392 val loc = s (LPARENleft, RPARENright)
|
adamc@304
|
1393
|
adamc@403
|
1394 val e = (EVar (["Basis"], "delete", Infer), loc)
|
adamc@304
|
1395 val e = (EApp (e, texp), loc)
|
adamc@304
|
1396 in
|
adamc@304
|
1397 (EApp (e, sqlexp), loc)
|
adamc@304
|
1398 end)
|
adamc@302
|
1399
|
adamc@211
|
1400 | UNDER (EWild, s (UNDERleft, UNDERright))
|
adamc@91
|
1401
|
adamc@446
|
1402 | LET edecls IN eexp END (ELet (edecls, eexp), s (LETleft, ENDright))
|
adamc@446
|
1403
|
adamc@762
|
1404 | LBRACK RBRACK (EVar (["Basis"], "Nil", Infer), s (LBRACKleft, RBRACKright))
|
adamc@762
|
1405
|
adamc@446
|
1406 edecls : ([])
|
adamc@446
|
1407 | edecl edecls (edecl :: edecls)
|
adamc@446
|
1408
|
adamc@825
|
1409 edecl : VAL pat EQ eexp ((EDVal (pat, eexp), s (VALleft, eexpright)))
|
adamc@446
|
1410 | VAL REC valis ((EDValRec valis, s (VALleft, valisright)))
|
adamc@446
|
1411 | FUN valis ((EDValRec valis, s (FUNleft, valisright)))
|
adamc@446
|
1412
|
adamc@310
|
1413 enterDml : (inDml := true)
|
adamc@310
|
1414 leaveDml : (inDml := false)
|
adamc@310
|
1415
|
adamc@403
|
1416 texp : SYMBOL (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright))
|
adamc@302
|
1417 | LBRACE LBRACE eexp RBRACE RBRACE (eexp)
|
adamc@302
|
1418
|
adamc@302
|
1419 fields : fident ([fident])
|
adamc@302
|
1420 | fident COMMA fields (fident :: fields)
|
adamc@302
|
1421
|
adamc@302
|
1422 sqlexps: sqlexp ([sqlexp])
|
adamc@302
|
1423 | sqlexp COMMA sqlexps (sqlexp :: sqlexps)
|
adamc@302
|
1424
|
adamc@303
|
1425 fsets : fident EQ sqlexp ([(fident, sqlexp)])
|
adamc@303
|
1426 | fident EQ sqlexp COMMA fsets ((fident, sqlexp) :: fsets)
|
adamc@303
|
1427
|
adamc@200
|
1428 idents : ident ([ident])
|
adamc@200
|
1429 | ident DOT idents (ident :: idents)
|
adamc@200
|
1430
|
adamc@195
|
1431 etuple : eexp COMMA eexp ([eexp1, eexp2])
|
adamc@195
|
1432 | eexp COMMA etuple (eexp :: etuple)
|
adamc@195
|
1433
|
adamc@170
|
1434 branch : pat DARROW eexp (pat, eexp)
|
adamc@170
|
1435
|
adamc@170
|
1436 branchs: ([])
|
adamc@170
|
1437 | BAR branch branchs (branch :: branchs)
|
adamc@170
|
1438
|
adamc@822
|
1439 patS : pterm (pterm)
|
adamc@822
|
1440 | pterm DCOLON patS (let
|
adamc@822
|
1441 val loc = s (ptermleft, patSright)
|
adamc@762
|
1442 in
|
adamc@762
|
1443 (PCon (["Basis"], "Cons", SOME (PRecord ([("1", pterm),
|
adamc@822
|
1444 ("2", patS)], false), loc)),
|
adamc@762
|
1445 loc)
|
adamc@762
|
1446 end)
|
adamc@822
|
1447 | patS COLON cexp (PAnnot (patS, cexp), s (patSleft, cexpright))
|
adamc@822
|
1448
|
adamc@822
|
1449 pat : patS (patS)
|
adamc@822
|
1450 | cpath pterm (PCon (#1 cpath, #2 cpath, SOME pterm), s (cpathleft, ptermright))
|
adamc@170
|
1451
|
adamc@170
|
1452 pterm : SYMBOL (PVar SYMBOL, s (SYMBOLleft, SYMBOLright))
|
adamc@170
|
1453 | cpath (PCon (#1 cpath, #2 cpath, NONE), s (cpathleft, cpathright))
|
adamc@170
|
1454 | UNDER (PWild, s (UNDERleft, UNDERright))
|
adamc@173
|
1455 | INT (PPrim (Prim.Int INT), s (INTleft, INTright))
|
adam@1420
|
1456 | MINUS INT (PPrim (Prim.Int (~INT)), s (MINUSleft, INTright))
|
adamc@173
|
1457 | STRING (PPrim (Prim.String STRING), s (STRINGleft, STRINGright))
|
adamc@821
|
1458 | CHAR (PPrim (Prim.Char CHAR), s (CHARleft, CHARright))
|
adamc@170
|
1459 | LPAREN pat RPAREN (pat)
|
adamc@174
|
1460 | LBRACE RBRACE (PRecord ([], false), s (LBRACEleft, RBRACEright))
|
adamc@174
|
1461 | UNIT (PRecord ([], false), s (UNITleft, UNITright))
|
adamc@174
|
1462 | LBRACE rpat RBRACE (PRecord rpat, s (LBRACEleft, RBRACEright))
|
adamc@195
|
1463 | LPAREN ptuple RPAREN (PRecord (ListUtil.mapi (fn (i, p) => (Int.toString (i + 1), p)) ptuple,
|
adamc@195
|
1464 false),
|
adamc@195
|
1465 s (LPARENleft, RPARENright))
|
adamc@762
|
1466 | LBRACK RBRACK (PCon (["Basis"], "Nil", NONE), s (LBRACKleft, RBRACKright))
|
adamc@174
|
1467
|
adamc@175
|
1468 rpat : CSYMBOL EQ pat ([(CSYMBOL, pat)], false)
|
adamc@243
|
1469 | INT EQ pat ([(Int64.toString INT, pat)], false)
|
adamc@174
|
1470 | DOTDOTDOT ([], true)
|
adamc@175
|
1471 | CSYMBOL EQ pat COMMA rpat ((CSYMBOL, pat) :: #1 rpat, #2 rpat)
|
adamc@243
|
1472 | INT EQ pat COMMA rpat ((Int64.toString INT, pat) :: #1 rpat, #2 rpat)
|
adamc@170
|
1473
|
adamc@195
|
1474 ptuple : pat COMMA pat ([pat1, pat2])
|
adamc@195
|
1475 | pat COMMA ptuple (pat :: ptuple)
|
adamc@195
|
1476
|
adamc@12
|
1477 rexp : ([])
|
adamc@12
|
1478 | ident EQ eexp ([(ident, eexp)])
|
adamc@12
|
1479 | ident EQ eexp COMMA rexp ((ident, eexp) :: rexp)
|
adamc@91
|
1480
|
adamc@141
|
1481 xml : xmlOne xml (let
|
adamc@141
|
1482 val pos = s (xmlOneleft, xmlright)
|
adamc@141
|
1483 in
|
adamc@720
|
1484 (EApp ((EApp (
|
adamc@720
|
1485 (EVar (["Basis"], "join", Infer), pos),
|
adamc@720
|
1486 xmlOne), pos),
|
adamc@720
|
1487 xml), pos)
|
adamc@141
|
1488 end)
|
adamc@141
|
1489 | xmlOne (xmlOne)
|
adamc@91
|
1490
|
adamc@1045
|
1491 xmlOpt : xml (xml)
|
adamc@1045
|
1492 | (EApp ((EVar (["Basis"], "cdata", Infer), dummy),
|
adamc@1045
|
1493 (EPrim (Prim.String ""), dummy)),
|
adamc@1045
|
1494 dummy)
|
adamc@1045
|
1495
|
adamc@403
|
1496 xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer), s (NOTAGSleft, NOTAGSright)),
|
adamc@141
|
1497 (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))),
|
adamc@141
|
1498 s (NOTAGSleft, NOTAGSright))
|
adamc@141
|
1499 | tag DIVIDE GT (let
|
adamc@141
|
1500 val pos = s (tagleft, GTright)
|
adamc@710
|
1501
|
adamc@710
|
1502 val cdata =
|
adamc@756
|
1503 if #1 (#1 tag) = "submit" orelse #1 (#1 tag) = "dyn" then
|
adamc@710
|
1504 let
|
adamc@710
|
1505 val e = (EVar (["Basis"], "cdata", DontInfer), pos)
|
adamc@710
|
1506 val e = (ECApp (e, (CWild (KWild, pos), pos)), pos)
|
adamc@710
|
1507 in
|
adamc@710
|
1508 (ECApp (e, (CRecord [], pos)), pos)
|
adamc@710
|
1509 end
|
adamc@710
|
1510 else
|
adamc@710
|
1511 (EVar (["Basis"], "cdata", Infer), pos)
|
adamc@710
|
1512
|
adamc@710
|
1513 val cdata = (EApp (cdata,
|
adamc@710
|
1514 (EPrim (Prim.String ""), pos)),
|
adamc@710
|
1515 pos)
|
adamc@141
|
1516 in
|
adam@1643
|
1517 (EApp (#4 tag, cdata), pos)
|
adamc@141
|
1518 end)
|
adamc@141
|
1519
|
adamc@1045
|
1520 | tag GT xmlOpt END_TAG (let
|
adam@1563
|
1521 fun tagOut s =
|
adam@1563
|
1522 case s of
|
adam@1563
|
1523 "tabl" => "table"
|
adam@1563
|
1524 | _ => s
|
adam@1563
|
1525
|
adamc@141
|
1526 val pos = s (tagleft, GTright)
|
adamc@325
|
1527 val et = tagIn END_TAG
|
adamc@141
|
1528 in
|
adamc@756
|
1529 if #1 (#1 tag) = et then
|
adamc@361
|
1530 if et = "form" then
|
adam@1412
|
1531 let
|
adam@1412
|
1532 val e = (EVar (["Basis"], "form", Infer), pos)
|
adam@1412
|
1533 val e = (EApp (e, case #2 tag of
|
adam@1412
|
1534 NONE => (EVar (["Basis"], "None", Infer), pos)
|
adam@1412
|
1535 | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos)
|
adam@1412
|
1536 in
|
adam@1651
|
1537 case #3 tag of
|
adam@1651
|
1538 NONE => ()
|
adam@1651
|
1539 | SOME _ => ErrorMsg.errorAt pos "<form> does not support 'dynClass' attribute";
|
adam@1412
|
1540 (EApp (e, xmlOpt), pos)
|
adam@1412
|
1541 end
|
adamc@1093
|
1542 else if et = "subform" orelse et = "subforms" then
|
adamc@1093
|
1543 (EApp (#2 (#1 tag),
|
adamc@1045
|
1544 xmlOpt), pos)
|
adamc@758
|
1545 else if et = "entry" then
|
adamc@758
|
1546 (EApp ((EVar (["Basis"], "entry", Infer), pos),
|
adamc@1045
|
1547 xmlOpt), pos)
|
adamc@141
|
1548 else
|
adam@1643
|
1549 (EApp (#4 tag, xmlOpt), pos)
|
adamc@141
|
1550 else
|
adamc@325
|
1551 (if ErrorMsg.anyErrors () then
|
adamc@325
|
1552 ()
|
adamc@325
|
1553 else
|
adamc@1189
|
1554 ErrorMsg.errorAt pos ("Begin tag <"
|
adam@1563
|
1555 ^ tagOut (#1 (#1 tag))
|
adamc@1189
|
1556 ^ "> and end tag </"
|
adam@1563
|
1557 ^ tagOut et
|
adamc@1189
|
1558 ^ "> don't match.");
|
adamc@623
|
1559 (EWild, pos))
|
adamc@141
|
1560 end)
|
adamc@141
|
1561 | LBRACE eexp RBRACE (eexp)
|
adamc@391
|
1562 | LBRACE LBRACK eexp RBRACK RBRACE (let
|
adamc@391
|
1563 val loc = s (LBRACEleft, RBRACEright)
|
adamc@403
|
1564 val e = (EVar (["Top"], "txt", Infer), loc)
|
adamc@391
|
1565 in
|
adamc@391
|
1566 (EApp (e, eexp), loc)
|
adamc@391
|
1567 end)
|
adamc@92
|
1568
|
adamc@141
|
1569 tag : tagHead attrs (let
|
adamc@141
|
1570 val pos = s (tagHeadleft, attrsright)
|
adamc@721
|
1571
|
adamc@721
|
1572 val e = (EVar (["Basis"], "tag", Infer), pos)
|
adamc@721
|
1573 val eo = case #1 attrs of
|
adam@1749
|
1574 NONE => (EVar (["Basis"], "null", Infer), pos)
|
adam@1749
|
1575 | SOME (EPrim (Prim.String s), pos) => parseClass s pos
|
adam@1749
|
1576 | SOME e => e
|
adamc@721
|
1577 val e = (EApp (e, eo), pos)
|
adam@1643
|
1578 val eo = case #2 attrs of
|
adam@1643
|
1579 NONE => (EVar (["Basis"], "None", Infer), pos)
|
adam@1643
|
1580 | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos),
|
adam@1643
|
1581 e), pos)
|
adam@1643
|
1582 val e = (EApp (e, eo), pos)
|
adam@1750
|
1583 val eo = case #3 attrs of
|
adam@1750
|
1584 NONE => (EVar (["Basis"], "noStyle", Infer), pos)
|
adam@1750
|
1585 | SOME (EPrim (Prim.String s), pos) => parseStyle s pos
|
adam@1750
|
1586 | SOME e => e
|
adam@1750
|
1587 val e = (EApp (e, eo), pos)
|
adam@1750
|
1588 val e = (EApp (e, (ERecord (#4 attrs), pos)), pos)
|
adamc@721
|
1589 val e = (EApp (e, (EApp (#2 tagHead,
|
adamc@721
|
1590 (ERecord [], pos)), pos)), pos)
|
adamc@141
|
1591 in
|
adam@1643
|
1592 (tagHead, #1 attrs, #2 attrs, e)
|
adamc@141
|
1593 end)
|
adamc@141
|
1594
|
adamc@141
|
1595 tagHead: BEGIN_TAG (let
|
adamc@325
|
1596 val bt = tagIn BEGIN_TAG
|
adamc@141
|
1597 val pos = s (BEGIN_TAGleft, BEGIN_TAGright)
|
adamc@141
|
1598 in
|
adamc@325
|
1599 (bt,
|
adamc@473
|
1600 (EVar (["Basis"], bt, Infer), pos))
|
adamc@141
|
1601 end)
|
adamc@141
|
1602 | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
|
adamc@92
|
1603
|
adam@1750
|
1604 attrs : (NONE, NONE, NONE, [])
|
adamc@721
|
1605 | attr attrs (let
|
adamc@721
|
1606 val loc = s (attrleft, attrsright)
|
adamc@721
|
1607 in
|
adamc@721
|
1608 case attr of
|
adamc@721
|
1609 Class e =>
|
adamc@721
|
1610 (case #1 attrs of
|
adamc@721
|
1611 NONE => ()
|
adamc@721
|
1612 | SOME _ => ErrorMsg.errorAt loc "Multiple classes specified for tag";
|
adam@1750
|
1613 (SOME e, #2 attrs, #3 attrs, #4 attrs))
|
adam@1643
|
1614 | DynClass e =>
|
adam@1643
|
1615 (case #2 attrs of
|
adam@1643
|
1616 NONE => ()
|
adam@1643
|
1617 | SOME _ => ErrorMsg.errorAt loc "Multiple dynamic classes specified for tag";
|
adam@1750
|
1618 (#1 attrs, SOME e, #3 attrs, #4 attrs))
|
adam@1750
|
1619 | Style e =>
|
adam@1750
|
1620 (case #3 attrs of
|
adam@1750
|
1621 NONE => ()
|
adam@1750
|
1622 | SOME _ => ErrorMsg.errorAt loc "Multiple styles specified for tag";
|
adam@1750
|
1623 (#1 attrs, #2 attrs, SOME e, #4 attrs))
|
adamc@721
|
1624 | Normal xe =>
|
adam@1750
|
1625 (#1 attrs, #2 attrs, #3 attrs, xe :: #4 attrs)
|
adamc@721
|
1626 end)
|
adamc@104
|
1627
|
adam@1643
|
1628 attr : SYMBOL EQ attrv (case SYMBOL of
|
adam@1643
|
1629 "class" => Class attrv
|
adam@1643
|
1630 | "dynClass" => DynClass attrv
|
adam@1750
|
1631 | "style" => Style attrv
|
adam@1643
|
1632 | _ =>
|
adamc@724
|
1633 let
|
adamc@724
|
1634 val sym =
|
adamc@724
|
1635 case SYMBOL of
|
adamc@724
|
1636 "type" => "Typ"
|
adamc@724
|
1637 | x => capitalize x
|
adamc@724
|
1638 in
|
adamc@724
|
1639 Normal ((CName sym, s (SYMBOLleft, SYMBOLright)),
|
adamc@724
|
1640 if (sym = "Href" orelse sym = "Src")
|
adamc@724
|
1641 andalso (case #1 attrv of
|
adamc@724
|
1642 EPrim _ => true
|
adamc@724
|
1643 | _ => false) then
|
adamc@724
|
1644 let
|
adamc@724
|
1645 val loc = s (attrvleft, attrvright)
|
adamc@724
|
1646 in
|
adamc@724
|
1647 (EApp ((EVar (["Basis"], "bless", Infer), loc),
|
adamc@724
|
1648 attrv), loc)
|
adamc@724
|
1649 end
|
adamc@724
|
1650 else
|
adamc@724
|
1651 attrv)
|
adamc@724
|
1652 end)
|
adamc@204
|
1653
|
adamc@104
|
1654 attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright))
|
adamc@104
|
1655 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
|
adamc@104
|
1656 | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
|
adamc@110
|
1657 | LBRACE eexp RBRACE (eexp)
|
adamc@226
|
1658
|
adamc@232
|
1659 query : query1 obopt lopt ofopt (let
|
adamc@229
|
1660 val loc = s (query1left, query1right)
|
adamc@230
|
1661
|
adamc@230
|
1662 val re = (ERecord [((CName "Rows", loc),
|
adamc@230
|
1663 query1),
|
adamc@230
|
1664 ((CName "OrderBy", loc),
|
adamc@231
|
1665 obopt),
|
adamc@231
|
1666 ((CName "Limit", loc),
|
adamc@232
|
1667 lopt),
|
adamc@232
|
1668 ((CName "Offset", loc),
|
adamc@232
|
1669 ofopt)], loc)
|
adamc@229
|
1670 in
|
adamc@403
|
1671 (EApp ((EVar (["Basis"], "sql_query", Infer), loc), re), loc)
|
adamc@229
|
1672 end)
|
adamc@993
|
1673
|
adamc@993
|
1674 dopt : (EVar (["Basis"], "False", Infer), dummy)
|
adamc@993
|
1675 | DISTINCT (EVar (["Basis"], "True", Infer),
|
adamc@993
|
1676 s (DISTINCTleft, DISTINCTright))
|
adamc@993
|
1677
|
adamc@993
|
1678 query1 : SELECT dopt select FROM tables wopt gopt hopt
|
adamc@209
|
1679 (let
|
adamc@204
|
1680 val loc = s (SELECTleft, tablesright)
|
adamc@207
|
1681
|
adamc@1070
|
1682 val (empties, sel, exps) =
|
adamc@207
|
1683 case select of
|
adamc@1070
|
1684 Star => ([],
|
adamc@1070
|
1685 map (fn nm =>
|
adamc@233
|
1686 (nm, (CTuple [(CWild (KRecord (KType, loc), loc),
|
adamc@233
|
1687 loc),
|
adamc@233
|
1688 (CRecord [], loc)],
|
adamc@748
|
1689 loc))) (#1 tables),
|
adamc@233
|
1690 [])
|
adamc@207
|
1691 | Items sis =>
|
adamc@207
|
1692 let
|
adam@1627
|
1693 val tabs = map (fn nm => (nm, Unknown)) (#1 tables)
|
adamc@1194
|
1694 val (_, tabs, exps) = foldl (amend_select loc)
|
adamc@1194
|
1695 (1, tabs, []) sis
|
adam@1627
|
1696 val empties = List.mapPartial (fn (nm, c) =>
|
adam@1627
|
1697 case c of
|
adam@1627
|
1698 Unknown => SOME nm
|
adam@1627
|
1699 | Selective (CRecord [], _) => SOME nm
|
adam@1627
|
1700 | _ => NONE) tabs
|
adamc@207
|
1701 in
|
adamc@1070
|
1702 (empties,
|
adamc@1070
|
1703 map (fn (nm, c) => (nm,
|
adam@1627
|
1704 case c of
|
adam@1627
|
1705 Everything =>
|
adam@1627
|
1706 (CTuple [(CWild (KRecord (KType, loc), loc), loc),
|
adam@1627
|
1707 (CRecord [], loc)], loc)
|
adam@1627
|
1708 | _ =>
|
adam@1627
|
1709 let
|
adam@1627
|
1710 val c = case c of
|
adam@1627
|
1711 Selective c => c
|
adam@1627
|
1712 | _ => (CRecord [], loc)
|
adam@1627
|
1713 in
|
adam@1627
|
1714 (CTuple [c,
|
adam@1627
|
1715 (CWild (KRecord (KType, loc), loc),
|
adam@1627
|
1716 loc)], loc)
|
adam@1627
|
1717 end)) tabs,
|
adamc@233
|
1718 exps)
|
adamc@207
|
1719 end
|
adamc@207
|
1720
|
adamc@207
|
1721 val sel = (CRecord sel, loc)
|
adamc@207
|
1722
|
adamc@226
|
1723 val grp = case gopt of
|
adamc@403
|
1724 NONE => (ECApp ((EVar (["Basis"], "sql_subset_all",
|
adamc@403
|
1725 Infer), loc),
|
adamc@226
|
1726 (CWild (KRecord (KRecord (KType, loc), loc),
|
adamc@226
|
1727 loc), loc)), loc)
|
adamc@226
|
1728 | SOME gis =>
|
adamc@226
|
1729 let
|
adamc@748
|
1730 val tabs = map (fn nm =>
|
adamc@748
|
1731 (nm, (CRecord [], loc))) (#1 tables)
|
adamc@226
|
1732 val tabs = foldl (amend_group loc) tabs gis
|
adamc@226
|
1733
|
adamc@226
|
1734 val tabs = map (fn (nm, c) =>
|
adamc@226
|
1735 (nm,
|
adamc@226
|
1736 (CTuple [c,
|
adamc@226
|
1737 (CWild (KRecord (KType, loc),
|
adamc@226
|
1738 loc),
|
adamc@226
|
1739 loc)], loc))) tabs
|
adamc@226
|
1740 in
|
adamc@403
|
1741 (ECApp ((EVar (["Basis"], "sql_subset", Infer), loc),
|
adamc@226
|
1742 (CRecord tabs, loc)), loc)
|
adamc@226
|
1743 end
|
adamc@226
|
1744
|
adamc@403
|
1745 val e = (EVar (["Basis"], "sql_query1", Infer), loc)
|
adamc@1070
|
1746 val e = (ECApp (e, (CRecord (map (fn nm => (nm, (CUnit, loc))) empties),
|
adamc@1070
|
1747 loc)), loc)
|
adamc@993
|
1748 val re = (ERecord [((CName "Distinct", loc),
|
adamc@993
|
1749 dopt),
|
adamc@993
|
1750 ((CName "From", loc),
|
adamc@748
|
1751 #2 tables),
|
adamc@209
|
1752 ((CName "Where", loc),
|
adamc@223
|
1753 wopt),
|
adamc@224
|
1754 ((CName "GroupBy", loc),
|
adamc@226
|
1755 grp),
|
adamc@224
|
1756 ((CName "Having", loc),
|
adamc@224
|
1757 hopt),
|
adamc@223
|
1758 ((CName "SelectFields", loc),
|
adamc@403
|
1759 (ECApp ((EVar (["Basis"], "sql_subset", Infer), loc),
|
adamc@233
|
1760 sel), loc)),
|
adamc@233
|
1761 ((CName "SelectExps", loc),
|
adamc@233
|
1762 (ERecord exps, loc))], loc)
|
adamc@223
|
1763
|
adamc@209
|
1764 val e = (EApp (e, re), loc)
|
adamc@204
|
1765 in
|
adamc@207
|
1766 e
|
adamc@204
|
1767 end)
|
adam@1427
|
1768 | query1 UNION query1 (sql_relop ("union", false, query11, query12, s (query11left, query12right)))
|
adam@1427
|
1769 | query1 INTERSECT query1 (sql_relop ("intersect", false, query11, query12, s (query11left, query12right)))
|
adam@1427
|
1770 | query1 EXCEPT query1 (sql_relop ("except", false, query11, query12, s (query11left, query12right)))
|
adam@1427
|
1771 | query1 UNION ALL query1 (sql_relop ("union", true, query11, query12, s (query11left, query12right)))
|
adam@1427
|
1772 | query1 INTERSECT ALL query1 (sql_relop ("intersect", true, query11, query12, s (query11left, query12right)))
|
adam@1427
|
1773 | query1 EXCEPT ALL query1 (sql_relop ("except", true, query11, query12, s (query11left, query12right)))
|
adamc@1070
|
1774 | LBRACE LBRACE LBRACE eexp RBRACE RBRACE RBRACE (eexp)
|
adamc@204
|
1775
|
adamc@749
|
1776 tables : fitem (fitem)
|
adamc@749
|
1777 | fitem COMMA tables (let
|
adamc@749
|
1778 val loc = s (fitemleft, tablesright)
|
adamc@748
|
1779
|
adamc@748
|
1780 val e = (EVar (["Basis"], "sql_from_comma", Infer), loc)
|
adamc@749
|
1781 val e = (EApp (e, #2 fitem), loc)
|
adamc@748
|
1782 in
|
adamc@749
|
1783 (#1 fitem @ #1 tables,
|
adamc@748
|
1784 (EApp (e, #2 tables), loc))
|
adamc@748
|
1785 end)
|
adamc@204
|
1786
|
adamc@749
|
1787 fitem : table' ([#1 table'], #2 table')
|
adamc@1265
|
1788 | LBRACE LBRACE eexp RBRACE RBRACE (tnamesOf eexp, eexp)
|
adamc@749
|
1789 | fitem JOIN fitem ON sqlexp (let
|
adamc@749
|
1790 val loc = s (fitem1left, sqlexpright)
|
adamc@749
|
1791
|
adamc@749
|
1792 val e = (EVar (["Basis"], "sql_inner_join", Infer), loc)
|
adamc@749
|
1793 val e = (EApp (e, #2 fitem1), loc)
|
adamc@749
|
1794 val e = (EApp (e, #2 fitem2), loc)
|
adamc@749
|
1795 in
|
adamc@749
|
1796 (#1 fitem1 @ #1 fitem2,
|
adamc@749
|
1797 (EApp (e, sqlexp), loc))
|
adamc@749
|
1798 end)
|
adamc@749
|
1799 | fitem INNER JOIN fitem ON sqlexp (let
|
adamc@749
|
1800 val loc = s (fitem1left, sqlexpright)
|
adamc@749
|
1801
|
adamc@749
|
1802 val e = (EVar (["Basis"], "sql_inner_join", Infer), loc)
|
adamc@749
|
1803 val e = (EApp (e, #2 fitem1), loc)
|
adamc@749
|
1804 val e = (EApp (e, #2 fitem2), loc)
|
adamc@749
|
1805 in
|
adamc@749
|
1806 (#1 fitem1 @ #1 fitem2,
|
adamc@749
|
1807 (EApp (e, sqlexp), loc))
|
adamc@749
|
1808 end)
|
adamc@749
|
1809 | fitem CROSS JOIN fitem (let
|
adamc@749
|
1810 val loc = s (fitem1left, fitem2right)
|
adamc@749
|
1811
|
adamc@749
|
1812 val e = (EVar (["Basis"], "sql_inner_join", Infer), loc)
|
adamc@749
|
1813 val e = (EApp (e, #2 fitem1), loc)
|
adamc@749
|
1814 val e = (EApp (e, #2 fitem2), loc)
|
adamc@749
|
1815 val tru = sql_inject (EVar (["Basis"], "True", Infer), loc)
|
adamc@749
|
1816 in
|
adamc@749
|
1817 (#1 fitem1 @ #1 fitem2,
|
adamc@749
|
1818 (EApp (e, tru), loc))
|
adamc@749
|
1819 end)
|
adamc@750
|
1820 | fitem LEFT JOIN fitem ON sqlexp (let
|
adamc@750
|
1821 val loc = s (fitem1left, sqlexpright)
|
adamc@750
|
1822
|
adamc@750
|
1823 val e = (EVar (["Basis"], "sql_left_join", Infer), loc)
|
adamc@750
|
1824 val e = (EApp (e, #2 fitem1), loc)
|
adamc@750
|
1825 val e = (EApp (e, #2 fitem2), loc)
|
adamc@750
|
1826 in
|
adamc@750
|
1827 (#1 fitem1 @ #1 fitem2,
|
adamc@750
|
1828 (EApp (e, sqlexp), loc))
|
adamc@750
|
1829 end)
|
adamc@751
|
1830 | fitem LEFT OUTER JOIN fitem ON sqlexp (let
|
adamc@751
|
1831 val loc = s (fitem1left, sqlexpright)
|
adamc@751
|
1832
|
adamc@751
|
1833 val e = (EVar (["Basis"], "sql_left_join", Infer), loc)
|
adamc@751
|
1834 val e = (EApp (e, #2 fitem1), loc)
|
adamc@751
|
1835 val e = (EApp (e, #2 fitem2), loc)
|
adamc@751
|
1836 in
|
adamc@751
|
1837 (#1 fitem1 @ #1 fitem2,
|
adamc@751
|
1838 (EApp (e, sqlexp), loc))
|
adamc@751
|
1839 end)
|
adamc@751
|
1840 | fitem RIGHT JOIN fitem ON sqlexp (let
|
adamc@751
|
1841 val loc = s (fitem1left, sqlexpright)
|
adamc@751
|
1842
|
adamc@751
|
1843 val e = (EVar (["Basis"], "sql_right_join", Infer), loc)
|
adamc@751
|
1844 val e = (EApp (e, #2 fitem1), loc)
|
adamc@751
|
1845 val e = (EApp (e, #2 fitem2), loc)
|
adamc@751
|
1846 in
|
adamc@751
|
1847 (#1 fitem1 @ #1 fitem2,
|
adamc@751
|
1848 (EApp (e, sqlexp), loc))
|
adamc@751
|
1849 end)
|
adamc@751
|
1850 | fitem RIGHT OUTER JOIN fitem ON sqlexp (let
|
adamc@751
|
1851 val loc = s (fitem1left, sqlexpright)
|
adamc@751
|
1852
|
adamc@751
|
1853 val e = (EVar (["Basis"], "sql_right_join", Infer), loc)
|
adamc@751
|
1854 val e = (EApp (e, #2 fitem1), loc)
|
adamc@751
|
1855 val e = (EApp (e, #2 fitem2), loc)
|
adamc@751
|
1856 in
|
adamc@751
|
1857 (#1 fitem1 @ #1 fitem2,
|
adamc@751
|
1858 (EApp (e, sqlexp), loc))
|
adamc@751
|
1859 end)
|
adamc@751
|
1860 | fitem FULL JOIN fitem ON sqlexp (let
|
adamc@751
|
1861 val loc = s (fitem1left, sqlexpright)
|
adamc@751
|
1862
|
adamc@751
|
1863 val e = (EVar (["Basis"], "sql_full_join", Infer), loc)
|
adamc@751
|
1864 val e = (EApp (e, #2 fitem1), loc)
|
adamc@751
|
1865 val e = (EApp (e, #2 fitem2), loc)
|
adamc@751
|
1866 in
|
adamc@751
|
1867 (#1 fitem1 @ #1 fitem2,
|
adamc@751
|
1868 (EApp (e, sqlexp), loc))
|
adamc@751
|
1869 end)
|
adamc@751
|
1870 | fitem FULL OUTER JOIN fitem ON sqlexp (let
|
adamc@751
|
1871 val loc = s (fitem1left, sqlexpright)
|
adamc@751
|
1872
|
adamc@751
|
1873 val e = (EVar (["Basis"], "sql_full_join", Infer), loc)
|
adamc@751
|
1874 val e = (EApp (e, #2 fitem1), loc)
|
adamc@751
|
1875 val e = (EApp (e, #2 fitem2), loc)
|
adamc@751
|
1876 in
|
adamc@751
|
1877 (#1 fitem1 @ #1 fitem2,
|
adamc@751
|
1878 (EApp (e, sqlexp), loc))
|
adamc@751
|
1879 end)
|
adamc@1192
|
1880 | LPAREN query RPAREN AS tname (let
|
adamc@1192
|
1881 val loc = s (LPARENleft, RPARENright)
|
adamc@1192
|
1882
|
adamc@1192
|
1883 val e = (EVar (["Basis"], "sql_from_query", Infer), loc)
|
adamc@1192
|
1884 val e = (ECApp (e, tname), loc)
|
adamc@1192
|
1885 in
|
adamc@1192
|
1886 ([tname], (EApp (e, query), loc))
|
adamc@1192
|
1887 end)
|
adamc@749
|
1888
|
adamc@204
|
1889 tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
|
adamc@204
|
1890 | LBRACE cexp RBRACE (cexp)
|
adamc@204
|
1891
|
adamc@243
|
1892 table : SYMBOL ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)),
|
adamc@403
|
1893 (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)))
|
adamc@403
|
1894 | SYMBOL AS tname (tname, (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)))
|
adamc@221
|
1895 | LBRACE LBRACE eexp RBRACE RBRACE AS tname (tname, eexp)
|
adamc@207
|
1896
|
adamc@748
|
1897 table' : table (let
|
adamc@748
|
1898 val loc = s (tableleft, tableright)
|
adamc@748
|
1899 val e = (EVar (["Basis"], "sql_from_table", Infer), loc)
|
adamc@748
|
1900 val e = (ECApp (e, #1 table), loc)
|
adamc@748
|
1901 in
|
adamc@748
|
1902 (#1 table, (EApp (e, #2 table), loc))
|
adamc@748
|
1903 end)
|
adamc@748
|
1904
|
adamc@243
|
1905 tident : SYMBOL (CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright))
|
adamc@207
|
1906 | CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
|
adamc@221
|
1907 | LBRACE LBRACE cexp RBRACE RBRACE (cexp)
|
adamc@207
|
1908
|
adamc@207
|
1909 fident : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
|
adamc@207
|
1910 | LBRACE cexp RBRACE (cexp)
|
adamc@207
|
1911
|
adamc@207
|
1912 seli : tident DOT fident (Field (tident, fident))
|
adamc@1194
|
1913 | sqlexp (Exp (NONE, sqlexp))
|
adamc@1194
|
1914 | sqlexp AS fident (Exp (SOME fident, sqlexp))
|
adamc@341
|
1915 | tident DOT LBRACE LBRACE cexp RBRACE RBRACE (Fields (tident, cexp))
|
adam@1627
|
1916 | tident DOT STAR (StarFields tident)
|
adamc@207
|
1917
|
adamc@207
|
1918 selis : seli ([seli])
|
adamc@207
|
1919 | seli COMMA selis (seli :: selis)
|
adamc@207
|
1920
|
adamc@207
|
1921 select : STAR (Star)
|
adamc@207
|
1922 | selis (Items selis)
|
adamc@209
|
1923
|
adamc@403
|
1924 sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", Infer),
|
adamc@209
|
1925 s (TRUEleft, TRUEright)))
|
adamc@403
|
1926 | FALSE (sql_inject (EVar (["Basis"], "False", Infer),
|
adamc@209
|
1927 s (FALSEleft, FALSEright)))
|
adamc@209
|
1928
|
adamc@222
|
1929 | INT (sql_inject (EPrim (Prim.Int INT),
|
adamc@222
|
1930 s (INTleft, INTright)))
|
adamc@222
|
1931 | FLOAT (sql_inject (EPrim (Prim.Float FLOAT),
|
adamc@222
|
1932 s (FLOATleft, FLOATright)))
|
adamc@229
|
1933 | STRING (sql_inject (EPrim (Prim.String STRING),
|
adamc@229
|
1934 s (STRINGleft, STRINGright)))
|
adamc@441
|
1935 | CURRENT_TIMESTAMP (sql_nfunc ("current_timestamp",
|
adamc@441
|
1936 s (CURRENT_TIMESTAMPleft, CURRENT_TIMESTAMPright)))
|
adamc@222
|
1937
|
adamc@221
|
1938 | tident DOT fident (let
|
adamc@221
|
1939 val loc = s (tidentleft, fidentright)
|
adamc@403
|
1940 val e = (EVar (["Basis"], "sql_field", Infer), loc)
|
adamc@221
|
1941 val e = (ECApp (e, tident), loc)
|
adamc@221
|
1942 in
|
adamc@221
|
1943 (ECApp (e, fident), loc)
|
adamc@221
|
1944 end)
|
adamc@234
|
1945 | CSYMBOL (let
|
adamc@234
|
1946 val loc = s (CSYMBOLleft, CSYMBOLright)
|
adamc@310
|
1947 in
|
adamc@310
|
1948 if !inDml then
|
adamc@310
|
1949 let
|
adamc@403
|
1950 val e = (EVar (["Basis"], "sql_field", Infer), loc)
|
adamc@310
|
1951 val e = (ECApp (e, (CName "T", loc)), loc)
|
adamc@310
|
1952 in
|
adamc@310
|
1953 (ECApp (e, (CName CSYMBOL, loc)), loc)
|
adamc@310
|
1954 end
|
adamc@310
|
1955 else
|
adamc@310
|
1956 let
|
adamc@403
|
1957 val e = (EVar (["Basis"], "sql_exp", Infer), loc)
|
adamc@310
|
1958 in
|
adamc@310
|
1959 (ECApp (e, (CName CSYMBOL, loc)), loc)
|
adamc@310
|
1960 end
|
adamc@310
|
1961 end)
|
adamc@221
|
1962
|
adamc@471
|
1963 | LBRACE eexp RBRACE (eexp)
|
adamc@470
|
1964
|
adamc@559
|
1965 | sqlexp EQ sqlexp (sql_binary ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1966 | sqlexp NE sqlexp (sql_binary ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1967 | sqlexp LT sqlexp (sql_binary ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1968 | sqlexp LE sqlexp (sql_binary ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1969 | sqlexp GT sqlexp (sql_binary ("gt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1970 | sqlexp GE sqlexp (sql_binary ("ge", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1971
|
adamc@559
|
1972 | sqlexp PLUS sqlexp (sql_binary ("plus", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1973 | sqlexp MINUS sqlexp (sql_binary ("minus", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1974 | sqlexp STAR sqlexp (sql_binary ("times", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1975 | sqlexp DIVIDE sqlexp (sql_binary ("div", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1976 | sqlexp MOD sqlexp (sql_binary ("mod", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@219
|
1977
|
adamc@220
|
1978 | sqlexp CAND sqlexp (sql_binary ("and", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@220
|
1979 | sqlexp OR sqlexp (sql_binary ("or", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
adamc@559
|
1980
|
kkallio@1607
|
1981 | sqlexp LIKE sqlexp (sql_binary ("like", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
|
kkallio@1607
|
1982
|
adamc@220
|
1983 | NOT sqlexp (sql_unary ("not", sqlexp, s (NOTleft, sqlexpright)))
|
adamc@559
|
1984 | MINUS sqlexp (sql_unary ("neg", sqlexp, s (MINUSleft, sqlexpright)))
|
adamc@220
|
1985
|
adamc@470
|
1986 | sqlexp IS NULL (let
|
adamc@470
|
1987 val loc = s (sqlexpleft, NULLright)
|
adamc@470
|
1988 in
|
adamc@470
|
1989 (EApp ((EVar (["Basis"], "sql_is_null", Infer), loc),
|
adamc@470
|
1990 sqlexp), loc)
|
adamc@470
|
1991 end)
|
adamc@470
|
1992
|
kkallio@1572
|
1993 | CIF sqlexp CTHEN sqlexp CELSE sqlexp (let
|
kkallio@1572
|
1994 val loc = s (CIFleft, sqlexp3right)
|
kkallio@1572
|
1995 val e = (EVar (["Basis"], "sql_if_then_else", Infer), loc)
|
kkallio@1572
|
1996 in
|
kkallio@1572
|
1997 (EApp ((EApp ((EApp (e, sqlexp1), loc), sqlexp2), loc), sqlexp3), loc)
|
kkallio@1572
|
1998 end)
|
kkallio@1572
|
1999
|
adamc@471
|
2000 | LBRACE LBRACK eexp RBRACK RBRACE (sql_inject (#1 eexp,
|
adamc@471
|
2001 s (LBRACEleft, RBRACEright)))
|
adamc@220
|
2002 | LPAREN sqlexp RPAREN (sqlexp)
|
adamc@210
|
2003
|
adamc@467
|
2004 | NULL (sql_inject ((EVar (["Basis"], "None", Infer),
|
adamc@467
|
2005 s (NULLleft, NULLright))))
|
adamc@467
|
2006
|
adamc@235
|
2007 | COUNT LPAREN STAR RPAREN (let
|
adamc@235
|
2008 val loc = s (COUNTleft, RPARENright)
|
adamc@235
|
2009 in
|
adamc@544
|
2010 (EVar (["Basis"], "sql_count", Infer), loc)
|
adamc@235
|
2011 end)
|
adamc@1187
|
2012 | COUNT LPAREN sqlexp RPAREN (let
|
adamc@1187
|
2013 val loc = s (COUNTleft, RPARENright)
|
adamc@1187
|
2014
|
adamc@1187
|
2015 val e = (EVar (["Basis"], "sql_count_col", Infer), loc)
|
adamc@1187
|
2016 val e = (EApp ((EVar (["Basis"], "sql_aggregate", Infer), loc),
|
adamc@1187
|
2017 e), loc)
|
adamc@1187
|
2018 in
|
adamc@1187
|
2019 (EApp (e, sqlexp), loc)
|
adamc@1187
|
2020 end)
|
adamc@236
|
2021 | sqlagg LPAREN sqlexp RPAREN (let
|
adamc@236
|
2022 val loc = s (sqlaggleft, RPARENright)
|
adamc@236
|
2023
|
adamc@403
|
2024 val e = (EVar (["Basis"], "sql_" ^ sqlagg, Infer), loc)
|
adamc@403
|
2025 val e = (EApp ((EVar (["Basis"], "sql_aggregate", Infer), loc),
|
adamc@236
|
2026 e), loc)
|
adamc@236
|
2027 in
|
adamc@236
|
2028 (EApp (e, sqlexp), loc)
|
adamc@236
|
2029 end)
|
adam@1602
|
2030 | COALESCE LPAREN sqlexp COMMA sqlexp RPAREN
|
adam@1602
|
2031 (let
|
adam@1602
|
2032 val loc = s (COALESCEright, sqlexp2right)
|
adam@1602
|
2033 val e = (EVar (["Basis"], "sql_coalesce", Infer), loc)
|
adam@1602
|
2034 val e = (EApp (e, sqlexp1), loc)
|
adam@1602
|
2035 in
|
adam@1602
|
2036 (EApp (e, sqlexp2), loc)
|
adam@1602
|
2037 end)
|
adamc@746
|
2038 | fname LPAREN sqlexp RPAREN (let
|
adamc@746
|
2039 val loc = s (fnameleft, RPARENright)
|
adamc@746
|
2040
|
adamc@746
|
2041 val e = (EVar (["Basis"], "sql_ufunc", Infer), loc)
|
adamc@746
|
2042 val e = (EApp (e, fname), loc)
|
adamc@746
|
2043 in
|
adamc@746
|
2044 (EApp (e, sqlexp), loc)
|
adamc@746
|
2045 end)
|
adamc@1191
|
2046 | LPAREN query RPAREN (let
|
adamc@1191
|
2047 val loc = s (LPARENleft, RPARENright)
|
adamc@1191
|
2048
|
adamc@1191
|
2049 val e = (EVar (["Basis"], "sql_subquery", Infer), loc)
|
adamc@1191
|
2050 in
|
adamc@1191
|
2051 (EApp (e, query), loc)
|
adamc@1191
|
2052 end)
|
adamc@746
|
2053
|
adamc@746
|
2054 fname : SYMBOL (EVar (["Basis"], "sql_" ^ SYMBOL, Infer), s (SYMBOLleft, SYMBOLright))
|
adamc@746
|
2055 | LBRACE eexp RBRACE (eexp)
|
adamc@235
|
2056
|
adamc@403
|
2057 wopt : (sql_inject (EVar (["Basis"], "True", Infer),
|
adamc@230
|
2058 dummy))
|
adamc@209
|
2059 | CWHERE sqlexp (sqlexp)
|
adamc@226
|
2060
|
adamc@226
|
2061 groupi : tident DOT fident (GField (tident, fident))
|
adam@1425
|
2062 | tident DOT LBRACE LBRACE cexp RBRACE RBRACE (GFields (tident, cexp))
|
adamc@226
|
2063
|
adamc@226
|
2064 groupis: groupi ([groupi])
|
adamc@226
|
2065 | groupi COMMA groupis (groupi :: groupis)
|
adamc@226
|
2066
|
adamc@226
|
2067 gopt : (NONE)
|
adamc@226
|
2068 | GROUP BY groupis (SOME groupis)
|
adamc@227
|
2069
|
adamc@403
|
2070 hopt : (sql_inject (EVar (["Basis"], "True", Infer),
|
adamc@230
|
2071 dummy))
|
adamc@227
|
2072 | HAVING sqlexp (sqlexp)
|
adamc@230
|
2073
|
adamc@403
|
2074 obopt : (ECApp ((EVar (["Basis"], "sql_order_by_Nil", Infer), dummy),
|
adamc@234
|
2075 (CWild (KRecord (KType, dummy), dummy), dummy)),
|
adamc@230
|
2076 dummy)
|
adamc@230
|
2077 | ORDER BY obexps (obexps)
|
adamc@230
|
2078
|
adamc@268
|
2079 obitem : sqlexp diropt (sqlexp, diropt)
|
adamc@268
|
2080
|
adamc@268
|
2081 obexps : obitem (let
|
adamc@268
|
2082 val loc = s (obitemleft, obitemright)
|
adamc@230
|
2083
|
adamc@403
|
2084 val e' = (ECApp ((EVar (["Basis"], "sql_order_by_Nil", Infer), loc),
|
adamc@234
|
2085 (CWild (KRecord (KType, loc), loc), loc)),
|
adamc@230
|
2086 loc)
|
adamc@403
|
2087 val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons", Infer), loc),
|
adamc@268
|
2088 #1 obitem), loc)
|
adamc@268
|
2089 val e = (EApp (e, #2 obitem), loc)
|
adamc@230
|
2090 in
|
adamc@230
|
2091 (EApp (e, e'), loc)
|
adamc@230
|
2092 end)
|
adamc@268
|
2093 | obitem COMMA obexps (let
|
adamc@268
|
2094 val loc = s (obitemleft, obexpsright)
|
adamc@230
|
2095
|
adamc@403
|
2096 val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons", Infer), loc),
|
adamc@268
|
2097 #1 obitem), loc)
|
adamc@268
|
2098 val e = (EApp (e, #2 obitem), loc)
|
adamc@230
|
2099 in
|
adamc@230
|
2100 (EApp (e, obexps), loc)
|
adamc@230
|
2101 end)
|
adam@1682
|
2102 | RANDOM popt (EVar (["Basis"], "sql_order_by_random", Infer), s (RANDOMleft, poptright))
|
adam@1682
|
2103
|
adam@1682
|
2104 popt : ()
|
adam@1682
|
2105 | LPAREN RPAREN ()
|
adam@1684
|
2106 | UNIT ()
|
adamc@231
|
2107
|
adamc@403
|
2108 diropt : (EVar (["Basis"], "sql_asc", Infer), dummy)
|
adamc@403
|
2109 | ASC (EVar (["Basis"], "sql_asc", Infer), s (ASCleft, ASCright))
|
adamc@403
|
2110 | DESC (EVar (["Basis"], "sql_desc", Infer), s (DESCleft, DESCright))
|
adam@1543
|
2111 | LBRACE eexp RBRACE (eexp)
|
adamc@268
|
2112
|
adamc@403
|
2113 lopt : (EVar (["Basis"], "sql_no_limit", Infer), dummy)
|
adamc@403
|
2114 | LIMIT ALL (EVar (["Basis"], "sql_no_limit", Infer), dummy)
|
adamc@231
|
2115 | LIMIT sqlint (let
|
adamc@231
|
2116 val loc = s (LIMITleft, sqlintright)
|
adamc@231
|
2117 in
|
adamc@403
|
2118 (EApp ((EVar (["Basis"], "sql_limit", Infer), loc), sqlint), loc)
|
adamc@231
|
2119 end)
|
adamc@231
|
2120
|
adamc@403
|
2121 ofopt : (EVar (["Basis"], "sql_no_offset", Infer), dummy)
|
adamc@232
|
2122 | OFFSET sqlint (let
|
adamc@232
|
2123 val loc = s (OFFSETleft, sqlintright)
|
adamc@232
|
2124 in
|
adamc@403
|
2125 (EApp ((EVar (["Basis"], "sql_offset", Infer), loc), sqlint), loc)
|
adamc@232
|
2126 end)
|
adamc@232
|
2127
|
adamc@231
|
2128 sqlint : INT (EPrim (Prim.Int INT), s (INTleft, INTright))
|
adamc@231
|
2129 | LBRACE eexp RBRACE (eexp)
|
adamc@236
|
2130
|
adamc@236
|
2131 sqlagg : AVG ("avg")
|
adamc@236
|
2132 | SUM ("sum")
|
adamc@236
|
2133 | MIN ("min")
|
adamc@236
|
2134 | MAX ("max")
|