Mercurial > urweb
changeset 195:85b5f663bb86
Tuples syntactic sugar
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 09 Aug 2008 12:50:49 -0400 |
| parents | df5fd8f6913a |
| children | 890a61991263 |
| files | src/lacweb.grm src/lacweb.lex tests/tuple.lac |
| diffstat | 3 files changed, 52 insertions(+), 2 deletions(-) [+] |
line wrap: on
line diff
--- a/src/lacweb.grm Sat Aug 09 08:47:36 2008 -0400 +++ b/src/lacweb.grm Sat Aug 09 12:50:49 2008 -0400 @@ -47,7 +47,7 @@ | CON | LTYPE | VAL | REC | AND | FOLD | UNIT | KUNIT | DATATYPE | OF | TYPE | NAME - | ARROW | LARROW | DARROW + | ARROW | LARROW | DARROW | STAR | FN | PLUSPLUS | MINUSMINUS | DOLLAR | TWIDDLE | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT @@ -87,6 +87,7 @@ | cexp of con | capps of con | cterm of con + | ctuple of con list | ident of con | rcon of (con * con) list | rconn of (con * con) list @@ -95,6 +96,7 @@ | eexp of exp | eapps of exp | eterm of exp + | etuple of exp list | rexp of (con * exp) list | xml of exp | xmlOne of exp @@ -106,6 +108,7 @@ | pat of pat | pterm of pat | rpat of (string * pat) list * bool + | ptuple of pat list | attrs of (con * exp) list | attr of con * exp @@ -120,12 +123,14 @@ %name Lacweb +%nonassoc IF THEN ELSE %nonassoc DARROW %nonassoc COLON %nonassoc DCOLON TCOLON %right COMMA %right ARROW LARROW %right PLUSPLUS MINUSMINUS +%right STAR %nonassoc TWIDDLE %nonassoc DOLLAR %left DOT @@ -268,6 +273,14 @@ | LPAREN cexp RPAREN DCOLON kind (CAnnot (cexp, kind), s (LPARENleft, kindright)) | UNDER DCOLON kind (CWild kind, s (UNDERleft, UNDERright)) + | ctuple (let + val loc = s (ctupleleft, ctupleright) + in + (TRecord (CRecord (ListUtil.mapi (fn (i, c) => + ((CName (Int.toString (i + 1)), loc), + c)) ctuple), + loc), loc) + end) kcolon : DCOLON (Explicit) | TCOLON (Implicit) @@ -288,12 +301,16 @@ s (LBRACEleft, RBRACEright)) | DOLLAR cterm (TRecord cterm, s (DOLLARleft, ctermright)) | HASH CSYMBOL (CName CSYMBOL, s (HASHleft, CSYMBOLright)) + | HASH INT (CName (Int64.toString INT), s (HASHleft, INTright)) | path (CVar path, s (pathleft, pathright)) | UNDER (CWild (KWild, s (UNDERleft, UNDERright)), s (UNDERleft, UNDERright)) | FOLD (CFold, s (FOLDleft, FOLDright)) | UNIT (CUnit, s (UNITleft, UNITright)) +ctuple : cterm STAR cterm ([cterm1, cterm2]) + | cterm STAR ctuple (cterm :: ctuple) + rcon : ([]) | ident EQ cexp ([(ident, cexp)]) | ident EQ cexp COMMA rcon ((ident, cexp) :: rcon) @@ -306,6 +323,7 @@ | ident COLON cexp COMMA rcone ((ident, cexp) :: rcone) ident : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) + | INT (CName (Int64.toString INT), s (INTleft, INTright)) | path (CVar path, s (pathleft, pathright)) eapps : eterm (eterm) @@ -323,7 +341,9 @@ (EAbs ("_", SOME (TRecord (CRecord [], loc), loc), eexp), loc) end) - | LPAREN eexp RPAREN DCOLON cexp (EAnnot (eexp, cexp), s (LPARENleft, cexpright)) + | LPAREN etuple RPAREN COLON cexp(case etuple of + [eexp] => (EAnnot (eexp, cexp), s (LPARENleft, cexpright)) + | _ => raise Fail "Multiple arguments to expression type annotation") | eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright)) | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright)) | IF eexp THEN eexp ELSE eexp (let @@ -334,6 +354,13 @@ end) eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) + | LPAREN etuple RPAREN (let + val loc = s (LPARENleft, RPARENright) + in + (ERecord (ListUtil.mapi (fn (i, e) => + ((CName (Int.toString (i + 1)), loc), + e)) etuple), loc) + end) | path (EVar path, s (pathleft, pathright)) | cpath (EVar cpath, s (cpathleft, cpathright)) @@ -352,6 +379,9 @@ (EPrim (Prim.String ""), s (XML_BEGINleft, XML_ENDright))), s (XML_BEGINleft, XML_ENDright)) +etuple : eexp COMMA eexp ([eexp1, eexp2]) + | eexp COMMA etuple (eexp :: etuple) + branch : pat DARROW eexp (pat, eexp) branchs: ([]) @@ -369,11 +399,17 @@ | LBRACE RBRACE (PRecord ([], false), s (LBRACEleft, RBRACEright)) | UNIT (PRecord ([], false), s (UNITleft, UNITright)) | LBRACE rpat RBRACE (PRecord rpat, s (LBRACEleft, RBRACEright)) + | LPAREN ptuple RPAREN (PRecord (ListUtil.mapi (fn (i, p) => (Int.toString (i + 1), p)) ptuple, + false), + s (LPARENleft, RPARENright)) rpat : CSYMBOL EQ pat ([(CSYMBOL, pat)], false) | DOTDOTDOT ([], true) | CSYMBOL EQ pat COMMA rpat ((CSYMBOL, pat) :: #1 rpat, #2 rpat) +ptuple : pat COMMA pat ([pat1, pat2]) + | pat COMMA ptuple (pat :: ptuple) + rexp : ([]) | ident EQ eexp ([(ident, eexp)]) | ident EQ eexp COMMA rexp ((ident, eexp) :: rexp)
--- a/src/lacweb.lex Sat Aug 09 08:47:36 2008 -0400 +++ b/src/lacweb.lex Sat Aug 09 12:50:49 2008 -0400 @@ -250,6 +250,7 @@ <INITIAL> "_" => (Tokens.UNDER (pos yypos, pos yypos + size yytext)); <INITIAL> "~" => (Tokens.TWIDDLE (pos yypos, pos yypos + size yytext)); <INITIAL> "|" => (Tokens.BAR (pos yypos, pos yypos + size yytext)); +<INITIAL> "*" => (Tokens.STAR (pos yypos, pos yypos + size yytext)); <INITIAL> "con" => (Tokens.CON (pos yypos, pos yypos + size yytext)); <INITIAL> "type" => (Tokens.LTYPE (pos yypos, pos yypos + size yytext));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/tuple.lac Sat Aug 09 12:50:49 2008 -0400 @@ -0,0 +1,13 @@ +val x = (1, 2.0, "Hi") + +val x1 = x.1 +val x2 = x.2 +val x3 = x.3 + +val y : int * float * string = x + +val bizarro_x = case x of (a, b, c) => (c, a, b) + +val main : unit -> page = fn () => <html><body> + {cdata bizarro_x.1} +</body></html> \ No newline at end of file