Mercurial > urweb

comparison src/urweb.grm @ 709:0406e9cccb72

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
FOREIGN KEY, without ability to link NULL to NOT NULL (and with some lingering problems in row inference)
author Adam Chlipala <adamc@hcoop.net>
date Tue, 07 Apr 2009 18:47:47 -0400
parents d8217b4cb617
children 71409a4ccb67
comparison
equal deleted inserted replaced
708:1a317a707d71 709:0406e9cccb72
172 fun tagIn bt = 172 fun tagIn bt =
173 case bt of 173 case bt of
174 "table" => "tabl" 174 "table" => "tabl"
175 | _ => bt 175 | _ => bt
176 176
177 datatype prop_kind = Delete | Update
178
177 %% 179 %%
178 %header (functor UrwebLrValsFn(structure Token : TOKEN)) 180 %header (functor UrwebLrValsFn(structure Token : TOKEN))
179 181
180 %term 182 %term
181 EOF 183 EOF
206 | COUNT | AVG | SUM | MIN | MAX 208 | COUNT | AVG | SUM | MIN | MAX
207 | ASC | DESC 209 | ASC | DESC
208 | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS 210 | INSERT | INTO | VALUES | UPDATE | SET | DELETE | NULL | IS
209 | CURRENT_TIMESTAMP 211 | CURRENT_TIMESTAMP
210 | NE | LT | LE | GT | GE 212 | NE | LT | LE | GT | GE
211 | CCONSTRAINT | UNIQUE | PRIMARY | KEY 213 | CCONSTRAINT | UNIQUE | PRIMARY | FOREIGN | KEY | ON | NO | ACTION | RESTRICT | CASCADE | REFERENCES
212 214
213 %nonterm 215 %nonterm
214 file of decl list 216 file of decl list
215 | decls of decl list 217 | decls of decl list
216 | decl of decl list 218 | decl of decl list
227 | commaOpt of unit 229 | commaOpt of unit
228 230
229 | cst of exp 231 | cst of exp
230 | csts of exp 232 | csts of exp
231 | cstopt of exp 233 | cstopt of exp
234
235 | pmode of prop_kind * exp
236 | pkind of prop_kind
237 | prule of exp
238 | pmodes of (prop_kind * exp) list
232 239
233 | sgn of sgn 240 | sgn of sgn
234 | sgntm of sgn 241 | sgntm of sgn
235 | sgi of sgn_item 242 | sgi of sgn_item
236 | sgis of sgn_item list 243 | sgis of sgn_item list
501 val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc) 508 val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc)
502 val e = (EDisjointApp e, loc) 509 val e = (EDisjointApp e, loc)
503 in 510 in
504 (EDisjointApp e, loc) 511 (EDisjointApp e, loc)
505 end) 512 end)
513
514 | FOREIGN KEY tnames REFERENCES texp LPAREN tnames' RPAREN pmodes
515 (let
516 val loc = s (FOREIGNleft, pmodesright)
517
518 val mat = ListPair.foldrEq
519 (fn ((nm1, _), (nm2, _), mat) =>
520 let
521 val e = (EVar (["Basis"], "mat_cons", Infer), loc)
522 val e = (ECApp (e, nm1), loc)
523 val e = (ECApp (e, nm2), loc)
524 val e = (EDisjointApp e, loc)
525 val e = (EDisjointApp e, loc)
526 in
527 (EApp (e, mat), loc)
528 end)
529 (EVar (["Basis"], "mat_nil", Infer), loc)
530 (#1 tnames :: #2 tnames, #1 tnames' :: #2 tnames')
531
532 fun findMode mode =
533 let
534 fun findMode' pmodes =
535 case pmodes of
536 [] => (EVar (["Basis"], "no_action", Infer), loc)
537 | (mode', rule) :: pmodes' =>
538 if mode' = mode then
539 (if List.exists (fn (mode', _) => mode' = mode)
540 pmodes' then
541 ErrorMsg.errorAt loc "Duplicate propagation rule"
542 else
543 ();
544 rule)
545 else
546 findMode' pmodes'
547 in
548 findMode' pmodes
549 end
550
551 val e = (EVar (["Basis"], "foreign_key", Infer), loc)
552 val e = (EApp (e, mat), loc)
553 val e = (EApp (e, texp), loc)
554 in
555 (EApp (e, (ERecord [((CName "OnDelete", loc),
556 findMode Delete),
557 ((CName "OnUpdate", loc),
558 findMode Update)], loc)), loc)
559 end)
560
506 | LBRACE eexp RBRACE (eexp) 561 | LBRACE eexp RBRACE (eexp)
507 562
508 tnameW : tname (let 563 tnameW : tname (let
509 val loc = s (tnameleft, tnameright) 564 val loc = s (tnameleft, tnameright)
510 in 565 in
514 tnames : tnameW (tnameW, []) 569 tnames : tnameW (tnameW, [])
515 | LPAREN tnames' RPAREN (tnames') 570 | LPAREN tnames' RPAREN (tnames')
516 571
517 tnames': tnameW (tnameW, []) 572 tnames': tnameW (tnameW, [])
518 | tnameW COMMA tnames' (#1 tnames', tnameW :: #2 tnames') 573 | tnameW COMMA tnames' (#1 tnames', tnameW :: #2 tnames')
574
575 pmode : ON pkind prule (pkind, prule)
576
577 pkind : DELETE (Delete)
578 | UPDATE (Update)
579
580 prule : NO ACTION (EVar (["Basis"], "no_action", Infer), s (NOleft, ACTIONright))
581 | RESTRICT (EVar (["Basis"], "restrict", Infer), s (RESTRICTleft, RESTRICTright))
582 | CASCADE (EVar (["Basis"], "cascade", Infer), s (CASCADEleft, CASCADEright))
583 | SET NULL (EVar (["Basis"], "set_null", Infer), s (SETleft, NULLright))
584
585 pmodes : ([])
586 | pmode pmodes (pmode :: pmodes)
519 587
520 commaOpt: () 588 commaOpt: ()
521 | COMMA () 589 | COMMA ()
522 590
523 pkopt : (EVar (["Basis"], "no_primary_key", Infer), ErrorMsg.dummySpan) 591 pkopt : (EVar (["Basis"], "no_primary_key", Infer), ErrorMsg.dummySpan)