Mercurial > urweb
changeset 239:fc6f04889bf2
Shorthand for multi-binding con 'fn'
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 28 Aug 2008 13:29:57 -0400 |
| parents | 44a1663ad893 |
| children | 7036d29574f2 |
| files | src/lacweb.grm tests/cargs.lac tests/recBad.lac |
| diffstat | 3 files changed, 56 insertions(+), 3 deletions(-) [+] |
line wrap: on
line diff
--- a/src/lacweb.grm Thu Aug 28 13:13:16 2008 -0400 +++ b/src/lacweb.grm Thu Aug 28 13:29:57 2008 -0400 @@ -209,6 +209,10 @@ | rcon of (con * con) list | rconn of (con * con) list | rcone of (con * con) list + | cargs of con * kind -> con * kind + | cargl of con * kind -> con * kind + | carg of con * kind -> con * kind + | cargp of con * kind -> con * kind | eexp of exp | eapps of exp @@ -435,8 +439,7 @@ | cexp PLUSPLUS cexp (CConcat (cexp1, cexp2), s (cexp1left, cexp1right)) - | FN SYMBOL DARROW cexp (CAbs (SYMBOL, NONE, cexp), s (FNleft, cexpright)) - | FN SYMBOL DCOLON kind DARROW cexp (CAbs (SYMBOL, SOME kind, cexp), s (FNleft, cexpright)) + | FN cargs DARROW cexp (#1 (cargs (cexp, (KWild, s (FNleft, cexpright))))) | cterm TWIDDLE cterm DARROW cexp(CDisjoint (cterm1, cterm2, cexp), s (cterm1left, cexpright)) | cterm TWIDDLE cterm ARROW cexp (TDisjoint (cterm1, cterm2, cexp), s (cterm1left, cexpright)) @@ -455,6 +458,49 @@ kcolon : DCOLON (Explicit) | TCOLON (Implicit) +cargs : carg (carg) + | cargl (cargl) + +cargl : cargp cargp (cargp1 o cargp2) + | cargp cargl (cargp o cargl) + +carg : SYMBOL (fn (c, k) => + let + val loc = s (SYMBOLleft, SYMBOLright) + in + ((CAbs (SYMBOL, NONE, c), loc), + (KArrow ((KWild, loc), k), loc)) + end) + | SYMBOL DCOLON kind (fn (c, k) => + let + val loc = s (SYMBOLleft, kindright) + in + ((CAbs (SYMBOL, SOME kind, c), loc), + (KArrow (kind, k), loc)) + end) + | LPAREN SYMBOL DCOLON kind RPAREN (fn (c, k) => + let + val loc = s (LPARENleft, RPARENright) + in + ((CAbs (SYMBOL, SOME kind, c), loc), + (KArrow (kind, k), loc)) + end) + +cargp : SYMBOL (fn (c, k) => + let + val loc = s (SYMBOLleft, SYMBOLright) + in + ((CAbs (SYMBOL, NONE, c), loc), + (KArrow ((KWild, loc), k), loc)) + end) + | LPAREN SYMBOL DCOLON kind RPAREN (fn (c, k) => + let + val loc = s (LPARENleft, RPARENright) + in + ((CAbs (SYMBOL, SOME kind, c), loc), + (KArrow (kind, k), loc)) + end) + path : SYMBOL ([], SYMBOL) | CSYMBOL DOT path (let val (ms, x) = path in (CSYMBOL :: ms, x) end)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/cargs.lac Thu Aug 28 13:29:57 2008 -0400 @@ -0,0 +1,7 @@ +con id = fn t :: Type => t +con id2 = fn (t :: Type) => id t +con id3 = fn t => id2 t + +con pair = fn (t :: Type) (u :: Type) => (t, u) +con pair2 = fn t u => pair t u +con pair3 = fn t (u :: Type) => pair2 t u
--- a/tests/recBad.lac Thu Aug 28 13:13:16 2008 -0400 +++ b/tests/recBad.lac Thu Aug 28 13:29:57 2008 -0400 @@ -6,4 +6,4 @@ | Cons (h, t) => Cons (h, append t ls2) (*val rec ones : list int = Cons (1, ones)*) -val rec ones : unit -> list int = fn () => Cons (1, ones ()) +val rec ones = fn () => Cons (1, ones ())