comparison src/urweb.grm @ 706:1fb318c17546

Enhance table sig item support and get demo compiling again
author Adam Chlipala <adamc@hcoop.net>
date Tue, 07 Apr 2009 15:04:07 -0400
parents e6706a1df013
children d8217b4cb617
comparison
equal deleted inserted replaced
705:e6706a1df013 706:1fb318c17546
530 s (mpathleft, mpathright)) 530 s (mpathleft, mpathright))
531 | sgntm WHERE CON SYMBOL EQ cexp (SgnWhere (sgntm, SYMBOL, cexp), s (sgntmleft, cexpright)) 531 | sgntm WHERE CON SYMBOL EQ cexp (SgnWhere (sgntm, SYMBOL, cexp), s (sgntmleft, cexpright))
532 | sgntm WHERE LTYPE SYMBOL EQ cexp(SgnWhere (sgntm, SYMBOL, cexp), s (sgntmleft, cexpright)) 532 | sgntm WHERE LTYPE SYMBOL EQ cexp(SgnWhere (sgntm, SYMBOL, cexp), s (sgntmleft, cexpright))
533 | LPAREN sgn RPAREN (sgn) 533 | LPAREN sgn RPAREN (sgn)
534 534
535 sgi : CON SYMBOL DCOLON kind (SgiConAbs (SYMBOL, kind), s (CONleft, kindright)) 535 sgi : CON SYMBOL DCOLON kind ((SgiConAbs (SYMBOL, kind), s (CONleft, kindright)))
536 | LTYPE SYMBOL (SgiConAbs (SYMBOL, (KType, s (LTYPEleft, SYMBOLright))), 536 | LTYPE SYMBOL ((SgiConAbs (SYMBOL, (KType, s (LTYPEleft, SYMBOLright))),
537 s (LTYPEleft, SYMBOLright)) 537 s (LTYPEleft, SYMBOLright)))
538 | CON SYMBOL EQ cexp (SgiCon (SYMBOL, NONE, cexp), s (CONleft, cexpright)) 538 | CON SYMBOL EQ cexp ((SgiCon (SYMBOL, NONE, cexp), s (CONleft, cexpright)))
539 | CON SYMBOL DCOLON kind EQ cexp (SgiCon (SYMBOL, SOME kind, cexp), s (CONleft, cexpright)) 539 | CON SYMBOL DCOLON kind EQ cexp ((SgiCon (SYMBOL, SOME kind, cexp), s (CONleft, cexpright)))
540 | LTYPE SYMBOL EQ cexp (SgiCon (SYMBOL, SOME (KType, s (LTYPEleft, cexpright)), cexp), 540 | LTYPE SYMBOL EQ cexp ((SgiCon (SYMBOL, SOME (KType, s (LTYPEleft, cexpright)), cexp),
541 s (LTYPEleft, cexpright)) 541 s (LTYPEleft, cexpright)))
542 | DATATYPE SYMBOL dargs EQ barOpt dcons(SgiDatatype (SYMBOL, dargs, dcons), s (DATATYPEleft, dconsright)) 542 | DATATYPE SYMBOL dargs EQ barOpt dcons((SgiDatatype (SYMBOL, dargs, dcons), s (DATATYPEleft, dconsright)))
543 | DATATYPE SYMBOL dargs EQ DATATYPE CSYMBOL DOT path 543 | DATATYPE SYMBOL dargs EQ DATATYPE CSYMBOL DOT path
544 (case dargs of 544 (case dargs of
545 [] => (SgiDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright)) 545 [] => (SgiDatatypeImp (SYMBOL, CSYMBOL :: #1 path, #2 path), s (DATATYPEleft, pathright))
546 | _ => raise Fail "Arguments specified for imported datatype") 546 | _ => raise Fail "Arguments specified for imported datatype")
547 | VAL SYMBOL COLON cexp (SgiVal (SYMBOL, cexp), s (VALleft, cexpright)) 547 | VAL SYMBOL COLON cexp ((SgiVal (SYMBOL, cexp), s (VALleft, cexpright)))
548 548
549 | STRUCTURE CSYMBOL COLON sgn (SgiStr (CSYMBOL, sgn), s (STRUCTUREleft, sgnright)) 549 | STRUCTURE CSYMBOL COLON sgn ((SgiStr (CSYMBOL, sgn), s (STRUCTUREleft, sgnright)))
550 | SIGNATURE CSYMBOL EQ sgn (SgiSgn (CSYMBOL, sgn), s (SIGNATUREleft, sgnright)) 550 | SIGNATURE CSYMBOL EQ sgn ((SgiSgn (CSYMBOL, sgn), s (SIGNATUREleft, sgnright)))
551 | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN COLON sgn 551 | FUNCTOR CSYMBOL LPAREN CSYMBOL COLON sgn RPAREN COLON sgn
552 (SgiStr (CSYMBOL1, 552 ((SgiStr (CSYMBOL1,
553 (SgnFun (CSYMBOL2, sgn1, sgn2), s (FUNCTORleft, sgn2right))), 553 (SgnFun (CSYMBOL2, sgn1, sgn2), s (FUNCTORleft, sgn2right))),
554 s (FUNCTORleft, sgn2right)) 554 s (FUNCTORleft, sgn2right)))
555 | INCLUDE sgn (SgiInclude sgn, s (INCLUDEleft, sgnright)) 555 | INCLUDE sgn ((SgiInclude sgn, s (INCLUDEleft, sgnright)))
556 | CONSTRAINT cterm TWIDDLE cterm (SgiConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright)) 556 | CONSTRAINT cterm TWIDDLE cterm ((SgiConstraint (cterm1, cterm2), s (CONSTRAINTleft, ctermright)))
557 | TABLE SYMBOL COLON cexp (let 557 | TABLE SYMBOL COLON cterm cstopt(let
558 val loc = s (TABLEleft, cexpright) 558 val loc = s (TABLEleft, ctermright)
559 val t = (CApp ((CVar (["Basis"], "sql_table"), loc), 559 in
560 entable cexp), loc) 560 (SgiTable (SYMBOL, entable cterm, cstopt), loc)
561 in
562 (SgiVal (SYMBOL, t), loc)
563 end) 561 end)
564 | SEQUENCE SYMBOL (let 562 | SEQUENCE SYMBOL (let
565 val loc = s (SEQUENCEleft, SYMBOLright) 563 val loc = s (SEQUENCEleft, SYMBOLright)
566 val t = (CVar (["Basis"], "sql_sequence"), loc) 564 val t = (CVar (["Basis"], "sql_sequence"), loc)
567 in 565 in