comparison src/urweb.grm @ 707:d8217b4cb617

PRIMARY KEY
author Adam Chlipala <adamc@hcoop.net>
date Tue, 07 Apr 2009 16:14:31 -0400
parents 1fb318c17546
children 0406e9cccb72
comparison
equal deleted inserted replaced
706:1fb318c17546 707:d8217b4cb617
206 | COUNT | AVG | SUM | MIN | MAX 206 | COUNT | AVG | SUM | MIN | MAX
207 | ASC | DESC 207 | ASC | DESC
208 | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS 208 | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS
209 | CURRENT_TIMESTAMP 209 | CURRENT_TIMESTAMP
210 | NE | LT | LE | GT | GE 210 | NE | LT | LE | GT | GE
211 | CCONSTRAINT | UNIQUE 211 | CCONSTRAINT | UNIQUE | PRIMARY | KEY
212 212
213 %nonterm 213 %nonterm
214 file of decl list 214 file of decl list
215 | decls of decl list 215 | decls of decl list
216 | decl of decl list 216 | decl of decl list
220 220
221 | dargs of string list 221 | dargs of string list
222 | barOpt of unit 222 | barOpt of unit
223 | dcons of (string * con option) list 223 | dcons of (string * con option) list
224 | dcon of string * con option 224 | dcon of string * con option
225
226 | pkopt of exp
227 | commaOpt of unit
225 228
226 | cst of exp 229 | cst of exp
227 | csts of exp 230 | csts of exp
228 | cstopt of exp 231 | cstopt of exp
229 232
416 | OPEN CONSTRAINTS mpath (case mpath of 419 | OPEN CONSTRAINTS mpath (case mpath of
417 [] => raise Fail "Impossible mpath parse [3]" 420 [] => raise Fail "Impossible mpath parse [3]"
418 | m :: ms => [(DOpenConstraints (m, ms), s (OPENleft, mpathright))]) 421 | m :: ms => [(DOpenConstraints (m, ms), s (OPENleft, mpathright))])
419 | CONSTRAINT cterm TWIDDLE cterm ([(DConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright))]) 422 | CONSTRAINT cterm TWIDDLE cterm ([(DConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright))])
420 | EXPORT spath ([(DExport spath, s (EXPORTleft, spathright))]) 423 | EXPORT spath ([(DExport spath, s (EXPORTleft, spathright))])
421 | TABLE SYMBOL COLON cterm cstopt([(DTable (SYMBOL, entable cterm, cstopt), s (TABLEleft, cstoptright))]) 424 | TABLE SYMBOL COLON cterm pkopt commaOpt cstopt([(DTable (SYMBOL, entable cterm, pkopt, cstopt),
425 s (TABLEleft, cstoptright))])
422 | SEQUENCE SYMBOL ([(DSequence SYMBOL, s (SEQUENCEleft, SYMBOLright))]) 426 | SEQUENCE SYMBOL ([(DSequence SYMBOL, s (SEQUENCEleft, SYMBOLright))])
423 | CLASS SYMBOL EQ cexp (let 427 | CLASS SYMBOL EQ cexp (let
424 val loc = s (CLASSleft, cexpright) 428 val loc = s (CLASSleft, cexpright)
425 in 429 in
426 [(DClass (SYMBOL, (KWild, loc), cexp), loc)] 430 [(DClass (SYMBOL, (KWild, loc), cexp), loc)]
510 tnames : tnameW (tnameW, []) 514 tnames : tnameW (tnameW, [])
511 | LPAREN tnames' RPAREN (tnames') 515 | LPAREN tnames' RPAREN (tnames')
512 516
513 tnames': tnameW (tnameW, []) 517 tnames': tnameW (tnameW, [])
514 | tnameW COMMA tnames' (#1 tnames', tnameW :: #2 tnames') 518 | tnameW COMMA tnames' (#1 tnames', tnameW :: #2 tnames')
519
520 commaOpt: ()
521 | COMMA ()
522
523 pkopt : (EVar (["Basis"], "no_primary_key", Infer), ErrorMsg.dummySpan)
524 | PRIMARY KEY tnames (let
525 val loc = s (PRIMARYleft, tnamesright)
526
527 val e = (EVar (["Basis"], "primary_key", Infer), loc)
528 val e = (ECApp (e, #1 (#1 tnames)), loc)
529 val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc)
530 val e = (EDisjointApp e, loc)
531 val e = (EDisjointApp e, loc)
532
533 val witness = map (fn (c, _) =>
534 (c, (EWild, loc)))
535 (#1 tnames :: #2 tnames)
536 val witness = (ERecord witness, loc)
537 in
538 (EApp (e, witness), loc)
539 end)
515 540
516 valis : vali ([vali]) 541 valis : vali ([vali])
517 | vali AND valis (vali :: valis) 542 | vali AND valis (vali :: valis)
518 543
519 sgn : sgntm (sgntm) 544 sgn : sgntm (sgntm)
552 ((SgiStr (CSYMBOL1, 577 ((SgiStr (CSYMBOL1,
553 (SgnFun (CSYMBOL2, sgn1, sgn2), s (FUNCTORleft, sgn2right))), 578 (SgnFun (CSYMBOL2, sgn1, sgn2), s (FUNCTORleft, sgn2right))),
554 s (FUNCTORleft, sgn2right))) 579 s (FUNCTORleft, sgn2right)))
555 | INCLUDE sgn ((SgiInclude sgn, s (INCLUDEleft, sgnright))) 580 | INCLUDE sgn ((SgiInclude sgn, s (INCLUDEleft, sgnright)))
556 | CONSTRAINT cterm TWIDDLE cterm ((SgiConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright))) 581 | CONSTRAINT cterm TWIDDLE cterm ((SgiConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright)))
557 | TABLE SYMBOL COLON cterm cstopt(let 582 | TABLE SYMBOL COLON cterm pkopt commaOpt cstopt (let
558 val loc = s (TABLEleft, ctermright) 583 val loc = s (TABLEleft, ctermright)
559 in 584 in
560 (SgiTable (SYMBOL, entable cterm, cstopt), loc) 585 (SgiTable (SYMBOL, entable cterm, pkopt, cstopt), loc)
561 end) 586 end)
562 | SEQUENCE SYMBOL (let 587 | SEQUENCE SYMBOL (let
563 val loc = s (SEQUENCEleft, SYMBOLright) 588 val loc = s (SEQUENCEleft, SYMBOLright)
564 val t = (CVar (["Basis"], "sql_sequence"), loc) 589 val t = (CVar (["Basis"], "sql_sequence"), loc)
565 in 590 in
566 (SgiVal (SYMBOL, t), loc) 591 (SgiVal (SYMBOL, t), loc)