diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-12-19 10:03:31 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-12-19 10:03:31 -0500 |
| commit | ba83ee9a9b3d2539b820c9fcb1cb7cd42226da6c (patch) | |
| tree | 147dbc155a38e55b93e8c303304bdc6c9f5e8258 /src/urweb.grm | |
| parent | 8d98194908d9001ce5da0bceda10c22e71e940ba (diff) | |
Initial conversion to arbitrary-kind classes
Diffstat (limited to 'src/urweb.grm')
| -rw-r--r-- | src/urweb.grm | 49 |
1 files changed, 42 insertions, 7 deletions
diff --git a/src/urweb.grm b/src/urweb.grm index 7798b018..5f2c0575 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -410,13 +410,24 @@ decl : CON SYMBOL cargl2 kopt EQ cexp (let | EXPORT spath ([(DExport spath, s (EXPORTleft, spathright))]) | TABLE SYMBOL COLON cexp ([(DTable (SYMBOL, entable cexp), s (TABLEleft, cexpright))]) | SEQUENCE SYMBOL ([(DSequence SYMBOL, s (SEQUENCEleft, SYMBOLright))]) - | CLASS SYMBOL EQ cexp ([(DClass (SYMBOL, cexp), s (CLASSleft, cexpright))]) + | CLASS SYMBOL EQ cexp (let + val loc = s (CLASSleft, cexpright) + in + [(DClass (SYMBOL, (KWild, loc), cexp), loc)] + end) + | CLASS SYMBOL DCOLON kind EQ cexp ([(DClass (SYMBOL, kind, cexp), s (CLASSleft, cexpright))]) | CLASS SYMBOL SYMBOL EQ cexp (let val loc = s (CLASSleft, cexpright) - val k = (KType, loc) + val k = (KWild, loc) val c = (CAbs (SYMBOL2, SOME k, cexp), loc) in - [(DClass (SYMBOL1, c), s (CLASSleft, cexpright))] + [(DClass (SYMBOL1, k, c), s (CLASSleft, cexpright))] + end) + | CLASS SYMBOL LPAREN SYMBOL DCOLON kind RPAREN EQ cexp (let + val loc = s (CLASSleft, cexpright) + val c = (CAbs (SYMBOL2, SOME kind, cexp), loc) + in + [(DClass (SYMBOL1, kind, c), s (CLASSleft, cexpright))] end) | COOKIE SYMBOL COLON cexp ([(DCookie (SYMBOL, cexp), s (COOKIEleft, cexpright))]) @@ -501,14 +512,38 @@ sgi : CON SYMBOL DCOLON kind (SgiConAbs (SYMBOL, kind), s (CONleft, k in (SgiVal (SYMBOL, t), loc) end) - | CLASS SYMBOL (SgiClassAbs SYMBOL, s (CLASSleft, SYMBOLright)) - | CLASS SYMBOL EQ cexp (SgiClass (SYMBOL, cexp), s (CLASSleft, cexpright)) + | CLASS SYMBOL (let + val loc = s (CLASSleft, SYMBOLright) + in + (SgiClassAbs (SYMBOL, (KWild, loc)), loc) + end) + | CLASS SYMBOL DCOLON kind (let + val loc = s (CLASSleft, kindright) + in + (SgiClassAbs (SYMBOL, kind), loc) + end) + | CLASS SYMBOL EQ cexp (let + val loc = s (CLASSleft, cexpright) + in + (SgiClass (SYMBOL, (KWild, loc), cexp), loc) + end) + | CLASS SYMBOL DCOLON kind EQ cexp (let + val loc = s (CLASSleft, cexpright) + in + (SgiClass (SYMBOL, kind, cexp), loc) + end) | CLASS SYMBOL SYMBOL EQ cexp (let val loc = s (CLASSleft, cexpright) - val k = (KType, loc) + val k = (KWild, loc) val c = (CAbs (SYMBOL2, SOME k, cexp), loc) in - (SgiClass (SYMBOL1, c), s (CLASSleft, cexpright)) + (SgiClass (SYMBOL1, k, c), s (CLASSleft, cexpright)) + end) + | CLASS SYMBOL LPAREN SYMBOL DCOLON kind RPAREN EQ cexp (let + val loc = s (CLASSleft, cexpright) + val c = (CAbs (SYMBOL2, SOME kind, cexp), loc) + in + (SgiClass (SYMBOL1, kind, c), s (CLASSleft, cexpright)) end) | COOKIE SYMBOL COLON cexp (let val loc = s (COOKIEleft, cexpright) |