Mercurial > urweb

comparison src/urweb.grm @ 623:588b9d16b00a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Start of kind polymorphism, up to the point where demo/hello elaborates with updated Basis/Top
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Feb 2009 16:10:25 -0500
parents 8998114760c1
children 12b73f3c108e
comparison
equal deleted inserted replaced
622:d64533157f40 623:588b9d16b00a
182 | STRING of string | INT of Int64.int | FLOAT of Real64.real 182 | STRING of string | INT of Int64.int | FLOAT of Real64.real
183 | SYMBOL of string | CSYMBOL of string 183 | SYMBOL of string | CSYMBOL of string
184 | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE 184 | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
185 | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR 185 | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR
186 | PLUS | MINUS | DIVIDE | DOTDOTDOT | MOD | AT 186 | PLUS | MINUS | DIVIDE | DOTDOTDOT | MOD | AT
187 | CON | LTYPE | VAL | REC | AND | FUN | MAP | FOLD | UNIT | KUNIT | CLASS 187 | CON | LTYPE | VAL | REC | AND | FUN | MAP | UNIT | KUNIT | CLASS
188 | DATATYPE | OF 188 | DATATYPE | OF
189 | TYPE | NAME 189 | TYPE | NAME
190 | ARROW | LARROW | DARROW | STAR | SEMI 190 | ARROW | LARROW | DARROW | STAR | SEMI | KARROW | DKARROW
191 | FN | PLUSPLUS | MINUSMINUS | MINUSMINUSMINUS | DOLLAR | TWIDDLE 191 | FN | PLUSPLUS | MINUSMINUS | MINUSMINUSMINUS | DOLLAR | TWIDDLE
192 | LET | IN 192 | LET | IN
193 | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN | SQL 193 | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN | SQL
194 | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE | SEQUENCE 194 | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE | SEQUENCE
195 | COOKIE 195 | COOKIE
325 %eop EOF 325 %eop EOF
326 %noshift EOF 326 %noshift EOF
327 327
328 %name Urweb 328 %name Urweb
329 329
330 %right KARROW
331 %nonassoc DKARROW
330 %right SEMI 332 %right SEMI
331 %nonassoc LARROW 333 %nonassoc LARROW
332 %nonassoc IF THEN ELSE 334 %nonassoc IF THEN ELSE
333 %nonassoc DARROW 335 %nonassoc DARROW
334 %nonassoc COLON 336 %nonassoc COLON
573 | kind ARROW kind (KArrow (kind1, kind2), s (kind1left, kind2right)) 575 | kind ARROW kind (KArrow (kind1, kind2), s (kind1left, kind2right))
574 | LPAREN kind RPAREN (#1 kind, s (LPARENleft, RPARENright)) 576 | LPAREN kind RPAREN (#1 kind, s (LPARENleft, RPARENright))
575 | KUNIT (KUnit, s (KUNITleft, KUNITright)) 577 | KUNIT (KUnit, s (KUNITleft, KUNITright))
576 | UNDERUNDER (KWild, s (UNDERUNDERleft, UNDERUNDERright)) 578 | UNDERUNDER (KWild, s (UNDERUNDERleft, UNDERUNDERright))
577 | LPAREN ktuple RPAREN (KTuple ktuple, s (LPARENleft, RPARENright)) 579 | LPAREN ktuple RPAREN (KTuple ktuple, s (LPARENleft, RPARENright))
580 | CSYMBOL (KVar CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
581 | CSYMBOL KARROW kind (KFun (CSYMBOL, kind), s (CSYMBOLleft, kindright))
578 582
579 ktuple : kind STAR kind ([kind1, kind2]) 583 ktuple : kind STAR kind ([kind1, kind2])
580 | kind STAR ktuple (kind :: ktuple) 584 | kind STAR ktuple (kind :: ktuple)
581 585
582 capps : cterm (cterm) 586 capps : cterm (cterm)
583 | capps cterm (CApp (capps, cterm), s (cappsleft, ctermright)) 587 | capps cterm (CApp (capps, cterm), s (cappsleft, ctermright))
584 588
585 cexp : capps (capps) 589 cexp : capps (capps)
586 | cexp ARROW cexp (TFun (cexp1, cexp2), s (cexp1left, cexp2right)) 590 | cexp ARROW cexp (TFun (cexp1, cexp2), s (cexp1left, cexp2right))
587 | SYMBOL kcolon kind ARROW cexp (TCFun (kcolon, SYMBOL, kind, cexp), s (SYMBOLleft, cexpright)) 591 | SYMBOL kcolon kind ARROW cexp (TCFun (kcolon, SYMBOL, kind, cexp), s (SYMBOLleft, cexpright))
592 | CSYMBOL KARROW cexp (TKFun (CSYMBOL, cexp), s (CSYMBOLleft, cexpright))
588 593
589 | cexp PLUSPLUS cexp (CConcat (cexp1, cexp2), s (cexp1left, cexp1right)) 594 | cexp PLUSPLUS cexp (CConcat (cexp1, cexp2), s (cexp1left, cexp1right))
590 595
591 | FN cargs DARROW cexp (#1 (cargs (cexp, (KWild, s (FNleft, cexpright))))) 596 | FN cargs DARROW cexp (#1 (cargs (cexp, (KWild, s (FNleft, cexpright)))))
597 | CSYMBOL DKARROW cexp (CKAbs (CSYMBOL, cexp), s (CSYMBOLleft, cexpright))
592 598
593 | LPAREN cexp RPAREN DCOLON kind (CAnnot (cexp, kind), s (LPARENleft, kindright)) 599 | LPAREN cexp RPAREN DCOLON kind (CAnnot (cexp, kind), s (LPARENleft, kindright))
594 600
595 | UNDER DCOLON kind (CWild kind, s (UNDERleft, UNDERright)) 601 | UNDER DCOLON kind (CWild kind, s (UNDERleft, UNDERright))
596 | ctuple (let 602 | ctuple (let
649 val loc = s (LPARENleft, RPARENright) 655 val loc = s (LPARENleft, RPARENright)
650 in 656 in
651 ((CAbs (SYMBOL, SOME kind, c), loc), 657 ((CAbs (SYMBOL, SOME kind, c), loc),
652 (KArrow (kind, k), loc)) 658 (KArrow (kind, k), loc))
653 end) 659 end)
654 | LBRACK cexp TWIDDLE cexp RBRACK (fn (c, k) => 660 | LBRACK cexp TWIDDLE cexp RBRACK (fn (c, k) =>
655 let 661 let
656 val loc = s (LBRACKleft, RBRACKright) 662 val loc = s (LBRACKleft, RBRACKright)
657 in 663 in
658 ((CDisjoint (cexp1, cexp2, c), loc), 664 ((CDisjoint (cexp1, cexp2, c), loc),
659 k) 665 k)
714 | FN eargs DARROW eexp (let 720 | FN eargs DARROW eexp (let
715 val loc = s (FNleft, eexpright) 721 val loc = s (FNleft, eexpright)
716 in 722 in
717 #1 (eargs (eexp, (CWild (KType, loc), loc))) 723 #1 (eargs (eexp, (CWild (KType, loc), loc)))
718 end) 724 end)
725 | CSYMBOL DKARROW eexp (EKAbs (CSYMBOL, eexp), s (CSYMBOLleft, eexpright))
719 | eexp COLON cexp (EAnnot (eexp, cexp), s (eexpleft, cexpright)) 726 | eexp COLON cexp (EAnnot (eexp, cexp), s (eexpleft, cexpright))
720 | eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright)) 727 | eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright))
721 | eexp MINUSMINUSMINUS cexp (ECutMulti (eexp, cexp), s (eexpleft, cexpright)) 728 | eexp MINUSMINUSMINUS cexp (ECutMulti (eexp, cexp), s (eexpleft, cexpright))
722 | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright)) 729 | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright))
723 | IF eexp THEN eexp ELSE eexp (let 730 | IF eexp THEN eexp ELSE eexp (let
849 val loc = s (LBRACKleft, RBRACKright) 856 val loc = s (LBRACKleft, RBRACKright)
850 in 857 in
851 ((EDisjoint (cexp1, cexp2, e), loc), 858 ((EDisjoint (cexp1, cexp2, e), loc),
852 (CDisjoint (cexp1, cexp2, t), loc)) 859 (CDisjoint (cexp1, cexp2, t), loc))
853 end) 860 end)
861 | CSYMBOL (fn (e, t) =>
862 let
863 val loc = s (CSYMBOLleft, CSYMBOLright)
864 in
865 ((EKAbs (CSYMBOL, e), loc),
866 (TKFun (CSYMBOL, t), loc))
867 end)
854 868
855 eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) 869 eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
856 | LPAREN etuple RPAREN (let 870 | LPAREN etuple RPAREN (let
857 val loc = s (LPARENleft, RPARENright) 871 val loc = s (LPARENleft, RPARENright)
858 in 872 in
893 in 907 in
894 foldl (fn (ident, e) => 908 foldl (fn (ident, e) =>
895 (EField (e, ident), loc)) 909 (EField (e, ident), loc))
896 (EVar (#1 path, #2 path, DontInfer), s (pathleft, pathright)) idents 910 (EVar (#1 path, #2 path, DontInfer), s (pathleft, pathright)) idents
897 end) 911 end)
898 | FOLD (EFold, s (FOLDleft, FOLDright))
899 912
900 | XML_BEGIN xml XML_END (let 913 | XML_BEGIN xml XML_END (let
901 val loc = s (XML_BEGINleft, XML_ENDright) 914 val loc = s (XML_BEGINleft, XML_ENDright)
902 in 915 in
903 if XML_BEGIN = "xml" then 916 if XML_BEGIN = "xml" then
1068 else 1081 else
1069 (if ErrorMsg.anyErrors () then 1082 (if ErrorMsg.anyErrors () then
1070 () 1083 ()
1071 else 1084 else
1072 ErrorMsg.errorAt pos "Begin and end tags don't match."; 1085 ErrorMsg.errorAt pos "Begin and end tags don't match.";
1073 (EFold, pos)) 1086 (EWild, pos))
1074 end) 1087 end)
1075 | LBRACE eexp RBRACE (eexp) 1088 | LBRACE eexp RBRACE (eexp)
1076 | LBRACE LBRACK eexp RBRACK RBRACE (let 1089 | LBRACE LBRACK eexp RBRACK RBRACE (let
1077 val loc = s (LBRACEleft, RBRACEright) 1090 val loc = s (LBRACEleft, RBRACEright)
1078 val e = (EVar (["Top"], "txt", Infer), loc) 1091 val e = (EVar (["Top"], "txt", Infer), loc)