Mercurial > urweb
changeset 241:052126db06e7
Shorthand for multi-binding exp 'fn'
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 28 Aug 2008 13:57:12 -0400 |
| parents | 7036d29574f2 |
| children | cc193f680193 |
| files | src/lacweb.grm tests/eargs.lac |
| diffstat | 2 files changed, 88 insertions(+), 23 deletions(-) [+] |
line wrap: on
line diff
--- a/src/lacweb.grm Thu Aug 28 13:39:20 2008 -0400 +++ b/src/lacweb.grm Thu Aug 28 13:57:12 2008 -0400 @@ -226,6 +226,11 @@ | tag of string * exp | tagHead of string * exp + | earg of exp * con -> exp * con + | eargp of exp * con -> exp * con + | eargs of exp * con -> exp * con + | eargl of exp * con -> exp * con + | branch of pat * exp | branchs of (pat * exp) list | pat of pat @@ -478,27 +483,14 @@ cargl2 : (fn x => x) | cargp cargl2 (cargp o cargl2) -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) => +carg : 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 (cargp) cargp : SYMBOL (fn (c, k) => let @@ -567,17 +559,12 @@ | eapps LBRACK cexp RBRACK (ECApp (eapps, cexp), s (eappsleft, RBRACKright)) eexp : eapps (eapps) - | FN SYMBOL kcolon kind DARROW eexp (ECAbs (kcolon, SYMBOL, kind, eexp), s (FNleft, eexpright)) - | FN SYMBOL COLON cexp DARROW eexp (EAbs (SYMBOL, SOME cexp, eexp), s (FNleft, eexpright)) - | FN SYMBOL DARROW eexp (EAbs (SYMBOL, NONE, eexp), s (FNleft, eexpright)) - | FN UNDER COLON cexp DARROW eexp (EAbs ("_", SOME cexp, eexp), s (FNleft, eexpright)) - | LBRACK cterm TWIDDLE cterm RBRACK DARROW eexp(EDisjoint (cterm1, cterm2, eexp), s (LBRACKleft, RBRACKright)) - | FN UNIT DARROW eexp (let + | FN eargs DARROW eexp (let val loc = s (FNleft, eexpright) in - (EAbs ("_", SOME (TRecord (CRecord [], loc), loc), eexp), loc) + #1 (eargs (eexp, (CWild (KType, loc), loc))) end) - + | LBRACK cterm TWIDDLE cterm RBRACK DARROW eexp(EDisjoint (cterm1, cterm2, eexp), s (LBRACKleft, RBRACKright)) | eexp COLON cexp (EAnnot (eexp, cexp), s (eexpleft, cexpright)) | eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright)) | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright)) @@ -588,6 +575,79 @@ ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc) end) +eargs : earg (earg) + | eargl (eargl) + +eargl : eargp eargp (eargp1 o eargp2) + | eargp eargl (eargp o eargl) + +earg : SYMBOL kcolon kind (fn (e, t) => + let + val loc = s (SYMBOLleft, kindright) + in + ((ECAbs (kcolon, SYMBOL, kind, e), loc), + (TCFun (kcolon, SYMBOL, kind, t), loc)) + end) + | SYMBOL COLON cexp (fn (e, t) => + let + val loc = s (SYMBOLleft, cexpright) + in + ((EAbs (SYMBOL, SOME cexp, e), loc), + (TFun (cexp, t), loc)) + end) + | UNDER COLON cexp (fn (e, t) => + let + val loc = s (UNDERleft, cexpright) + in + ((EAbs ("_", SOME cexp, e), loc), + (TFun (cexp, t), loc)) + end) + | eargp (eargp) + +eargp : SYMBOL (fn (e, t) => + let + val loc = s (SYMBOLleft, SYMBOLright) + in + ((EAbs (SYMBOL, NONE, e), loc), + (TFun ((CWild (KType, loc), loc), t), loc)) + end) + | UNIT (fn (e, t) => + let + val loc = s (UNITleft, UNITright) + val t' = (TRecord (CRecord [], loc), loc) + in + ((EAbs ("_", SOME t', e), loc), + (TFun (t', t), loc)) + end) + | UNDER (fn (e, t) => + let + val loc = s (UNDERleft, UNDERright) + in + ((EAbs ("_", NONE, e), loc), + (TFun ((CWild (KType, loc), loc), t), loc)) + end) + | LPAREN SYMBOL kcolon kind RPAREN(fn (e, t) => + let + val loc = s (LPARENleft, RPARENright) + in + ((ECAbs (kcolon, SYMBOL, kind, e), loc), + (TCFun (kcolon, SYMBOL, kind, t), loc)) + end) + | LPAREN SYMBOL COLON cexp RPAREN (fn (e, t) => + let + val loc = s (LPARENleft, RPARENright) + in + ((EAbs (SYMBOL, SOME cexp, e), loc), + (TFun (cexp, t), loc)) + end) + | LPAREN UNDER COLON cexp RPAREN (fn (e, t) => + let + val loc = s (LPARENleft, RPARENright) + in + ((EAbs ("_", SOME cexp, e), loc), + (TFun (cexp, t), loc)) + end) + eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) | LPAREN etuple RPAREN (let val loc = s (LPARENleft, RPARENright)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/eargs.lac Thu Aug 28 13:57:12 2008 -0400 @@ -0,0 +1,5 @@ +val id1 = fn n : int => n +val id2 = fn n => id1 n + +val pair1 = fn (t1 ::: Type) (t2 ::: Type) (x1 : t1) (x2 : t2) => (x1, x2) +val pair2 = fn (t1 ::: Type) (t2 ::: Type) (x1 : t1) (x2 : t2) () => pair1 x1 x2