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