diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-08-09 12:50:49 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-08-09 12:50:49 -0400 |
commit | e699687ba2ff0cc2c7c185c4d99669f77093473b (patch) | |
tree | ac9cfeac791b20f1763c72069c1fb1b61a364b24 | |
parent | bd2d0fe6c8deedc88d985b2c38978b730ff0cd19 (diff) |
Tuples syntactic sugar
-rw-r--r-- | src/lacweb.grm | 40 | ||||
-rw-r--r-- | src/lacweb.lex | 1 | ||||
-rw-r--r-- | tests/tuple.lac | 13 |
3 files changed, 52 insertions, 2 deletions
diff --git a/src/lacweb.grm b/src/lacweb.grm index 0e25c217..7fb7b020 100644 --- a/src/lacweb.grm +++ b/src/lacweb.grm @@ -47,7 +47,7 @@ fun uppercaseFirst "" = "" | 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 @@ fun uppercaseFirst "" = "" | 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 @@ fun uppercaseFirst "" = "" | 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 @@ fun uppercaseFirst "" = "" | 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 @@ fun uppercaseFirst "" = "" %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 @@ cexp : capps (capps) | 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 @@ cterm : LPAREN cexp RPAREN (#1 cexp, s (LPARENleft, RPARENright)) 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 @@ rcone : ([]) | 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 @@ eexp : eapps (eapps) (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 @@ eexp : eapps (eapps) 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 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) (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 @@ pterm : SYMBOL (PVar SYMBOL, s (SYMBOLleft, SYMBOLright | 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) diff --git a/src/lacweb.lex b/src/lacweb.lex index 45c9410c..0bb5ca38 100644 --- a/src/lacweb.lex +++ b/src/lacweb.lex @@ -250,6 +250,7 @@ notags = [^<{\n]+; <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)); diff --git a/tests/tuple.lac b/tests/tuple.lac new file mode 100644 index 00000000..fb14aad9 --- /dev/null +++ b/tests/tuple.lac @@ -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 |