Mercurial > urweb

comparison src/lacweb.grm @ 195:85b5f663bb86

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tuples syntactic sugar
author Adam Chlipala <adamc@hcoop.net>
date Sat, 09 Aug 2008 12:50:49 -0400
parents aa54250f58ac
children 890a61991263
comparison
equal deleted inserted replaced
194:df5fd8f6913a 195:85b5f663bb86
45 | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR 45 | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR
46 | DIVIDE | GT | DOTDOTDOT 46 | DIVIDE | GT | DOTDOTDOT
47 | CON | LTYPE | VAL | REC | AND | FOLD | UNIT | KUNIT 47 | CON | LTYPE | VAL | REC | AND | FOLD | UNIT | KUNIT
48 | DATATYPE | OF 48 | DATATYPE | OF
49 | TYPE | NAME 49 | TYPE | NAME
50 | ARROW | LARROW | DARROW 50 | ARROW | LARROW | DARROW | STAR
51 | FN | PLUSPLUS | MINUSMINUS | DOLLAR | TWIDDLE 51 | FN | PLUSPLUS | MINUSMINUS | DOLLAR | TWIDDLE
52 | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN 52 | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN
53 | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT 53 | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT
54 | CASE | IF | THEN | ELSE 54 | CASE | IF | THEN | ELSE
55 55
85 | mpath of string list 85 | mpath of string list
86 86
87 | cexp of con 87 | cexp of con
88 | capps of con 88 | capps of con
89 | cterm of con 89 | cterm of con
90 | ctuple of con list
90 | ident of con 91 | ident of con
91 | rcon of (con * con) list 92 | rcon of (con * con) list
92 | rconn of (con * con) list 93 | rconn of (con * con) list
93 | rcone of (con * con) list 94 | rcone of (con * con) list
94 95
95 | eexp of exp 96 | eexp of exp
96 | eapps of exp 97 | eapps of exp
97 | eterm of exp 98 | eterm of exp
99 | etuple of exp list
98 | rexp of (con * exp) list 100 | rexp of (con * exp) list
99 | xml of exp 101 | xml of exp
100 | xmlOne of exp 102 | xmlOne of exp
101 | tag of string * exp 103 | tag of string * exp
102 | tagHead of string * exp 104 | tagHead of string * exp
104 | branch of pat * exp 106 | branch of pat * exp
105 | branchs of (pat * exp) list 107 | branchs of (pat * exp) list
106 | pat of pat 108 | pat of pat
107 | pterm of pat 109 | pterm of pat
108 | rpat of (string * pat) list * bool 110 | rpat of (string * pat) list * bool
111 | ptuple of pat list
109 112
110 | attrs of (con * exp) list 113 | attrs of (con * exp) list
111 | attr of con * exp 114 | attr of con * exp
112 | attrv of exp 115 | attrv of exp
113 116
118 %eop EOF 121 %eop EOF
119 %noshift EOF 122 %noshift EOF
120 123
121 %name Lacweb 124 %name Lacweb
122 125
126 %nonassoc IF THEN ELSE
123 %nonassoc DARROW 127 %nonassoc DARROW
124 %nonassoc COLON 128 %nonassoc COLON
125 %nonassoc DCOLON TCOLON 129 %nonassoc DCOLON TCOLON
126 %right COMMA 130 %right COMMA
127 %right ARROW LARROW 131 %right ARROW LARROW
128 %right PLUSPLUS MINUSMINUS 132 %right PLUSPLUS MINUSMINUS
133 %right STAR
129 %nonassoc TWIDDLE 134 %nonassoc TWIDDLE
130 %nonassoc DOLLAR 135 %nonassoc DOLLAR
131 %left DOT 136 %left DOT
132 137
133 %% 138 %%
266 | cterm TWIDDLE cterm ARROW cexp (TDisjoint (cterm1, cterm2, cexp), s (cterm1left, cexpright)) 271 | cterm TWIDDLE cterm ARROW cexp (TDisjoint (cterm1, cterm2, cexp), s (cterm1left, cexpright))
267 272
268 | LPAREN cexp RPAREN DCOLON kind (CAnnot (cexp, kind), s (LPARENleft, kindright)) 273 | LPAREN cexp RPAREN DCOLON kind (CAnnot (cexp, kind), s (LPARENleft, kindright))
269 274
270 | UNDER DCOLON kind (CWild kind, s (UNDERleft, UNDERright)) 275 | UNDER DCOLON kind (CWild kind, s (UNDERleft, UNDERright))
276 | ctuple (let
277 val loc = s (ctupleleft, ctupleright)
278 in
279 (TRecord (CRecord (ListUtil.mapi (fn (i, c) =>
280 ((CName (Int.toString (i + 1)), loc),
281 c)) ctuple),
282 loc), loc)
283 end)
271 284
272 kcolon : DCOLON (Explicit) 285 kcolon : DCOLON (Explicit)
273 | TCOLON (Implicit) 286 | TCOLON (Implicit)
274 287
275 path : SYMBOL ([], SYMBOL) 288 path : SYMBOL ([], SYMBOL)
286 | LBRACK rconn RBRACK (CRecord rconn, s (LBRACKleft, RBRACKright)) 299 | LBRACK rconn RBRACK (CRecord rconn, s (LBRACKleft, RBRACKright))
287 | LBRACE rcone RBRACE (TRecord (CRecord rcone, s (LBRACEleft, RBRACEright)), 300 | LBRACE rcone RBRACE (TRecord (CRecord rcone, s (LBRACEleft, RBRACEright)),
288 s (LBRACEleft, RBRACEright)) 301 s (LBRACEleft, RBRACEright))
289 | DOLLAR cterm (TRecord cterm, s (DOLLARleft, ctermright)) 302 | DOLLAR cterm (TRecord cterm, s (DOLLARleft, ctermright))
290 | HASH CSYMBOL (CName CSYMBOL, s (HASHleft, CSYMBOLright)) 303 | HASH CSYMBOL (CName CSYMBOL, s (HASHleft, CSYMBOLright))
304 | HASH INT (CName (Int64.toString INT), s (HASHleft, INTright))
291 305
292 | path (CVar path, s (pathleft, pathright)) 306 | path (CVar path, s (pathleft, pathright))
293 | UNDER (CWild (KWild, s (UNDERleft, UNDERright)), s (UNDERleft, UNDERright)) 307 | UNDER (CWild (KWild, s (UNDERleft, UNDERright)), s (UNDERleft, UNDERright))
294 | FOLD (CFold, s (FOLDleft, FOLDright)) 308 | FOLD (CFold, s (FOLDleft, FOLDright))
295 | UNIT (CUnit, s (UNITleft, UNITright)) 309 | UNIT (CUnit, s (UNITleft, UNITright))
296 310
311 ctuple : cterm STAR cterm ([cterm1, cterm2])
312 | cterm STAR ctuple (cterm :: ctuple)
313
297 rcon : ([]) 314 rcon : ([])
298 | ident EQ cexp ([(ident, cexp)]) 315 | ident EQ cexp ([(ident, cexp)])
299 | ident EQ cexp COMMA rcon ((ident, cexp) :: rcon) 316 | ident EQ cexp COMMA rcon ((ident, cexp) :: rcon)
300 317
301 rconn : ident ([(ident, (CUnit, s (identleft, identright)))]) 318 rconn : ident ([(ident, (CUnit, s (identleft, identright)))])
304 rcone : ([]) 321 rcone : ([])
305 | ident COLON cexp ([(ident, cexp)]) 322 | ident COLON cexp ([(ident, cexp)])
306 | ident COLON cexp COMMA rcone ((ident, cexp) :: rcone) 323 | ident COLON cexp COMMA rcone ((ident, cexp) :: rcone)
307 324
308 ident : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) 325 ident : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
326 | INT (CName (Int64.toString INT), s (INTleft, INTright))
309 | path (CVar path, s (pathleft, pathright)) 327 | path (CVar path, s (pathleft, pathright))
310 328
311 eapps : eterm (eterm) 329 eapps : eterm (eterm)
312 | eapps eterm (EApp (eapps, eterm), s (eappsleft, etermright)) 330 | eapps eterm (EApp (eapps, eterm), s (eappsleft, etermright))
313 | eapps LBRACK cexp RBRACK (ECApp (eapps, cexp), s (eappsleft, RBRACKright)) 331 | eapps LBRACK cexp RBRACK (ECApp (eapps, cexp), s (eappsleft, RBRACKright))
321 val loc = s (FNleft, eexpright) 339 val loc = s (FNleft, eexpright)
322 in 340 in
323 (EAbs ("_", SOME (TRecord (CRecord [], loc), loc), eexp), loc) 341 (EAbs ("_", SOME (TRecord (CRecord [], loc), loc), eexp), loc)
324 end) 342 end)
325 343
326 | LPAREN eexp RPAREN DCOLON cexp (EAnnot (eexp, cexp), s (LPARENleft, cexpright)) 344 | LPAREN etuple RPAREN COLON cexp(case etuple of
345 [eexp] => (EAnnot (eexp, cexp), s (LPARENleft, cexpright))
346 | _ => raise Fail "Multiple arguments to expression type annotation")
327 | eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright)) 347 | eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright))
328 | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright)) 348 | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright))
329 | IF eexp THEN eexp ELSE eexp (let 349 | IF eexp THEN eexp ELSE eexp (let
330 val loc = s (IFleft, eexp3right) 350 val loc = s (IFleft, eexp3right)
331 in 351 in
332 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2), 352 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2),
333 ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc) 353 ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc)
334 end) 354 end)
335 355
336 eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) 356 eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
357 | LPAREN etuple RPAREN (let
358 val loc = s (LPARENleft, RPARENright)
359 in
360 (ERecord (ListUtil.mapi (fn (i, e) =>
361 ((CName (Int.toString (i + 1)), loc),
362 e)) etuple), loc)
363 end)
337 364
338 | path (EVar path, s (pathleft, pathright)) 365 | path (EVar path, s (pathleft, pathright))
339 | cpath (EVar cpath, s (cpathleft, cpathright)) 366 | cpath (EVar cpath, s (cpathleft, cpathright))
340 | LBRACE rexp RBRACE (ERecord rexp, s (LBRACEleft, RBRACEright)) 367 | LBRACE rexp RBRACE (ERecord rexp, s (LBRACEleft, RBRACEright))
341 | UNIT (ERecord [], s (UNITleft, UNITright)) 368 | UNIT (ERecord [], s (UNITleft, UNITright))
349 376
350 | XML_BEGIN xml XML_END (xml) 377 | XML_BEGIN xml XML_END (xml)
351 | XML_BEGIN XML_END (EApp ((EVar (["Basis"], "cdata"), s (XML_BEGINleft, XML_ENDright)), 378 | XML_BEGIN XML_END (EApp ((EVar (["Basis"], "cdata"), s (XML_BEGINleft, XML_ENDright)),
352 (EPrim (Prim.String ""), s (XML_BEGINleft, XML_ENDright))), 379 (EPrim (Prim.String ""), s (XML_BEGINleft, XML_ENDright))),
353 s (XML_BEGINleft, XML_ENDright)) 380 s (XML_BEGINleft, XML_ENDright))
381
382 etuple : eexp COMMA eexp ([eexp1, eexp2])
383 | eexp COMMA etuple (eexp :: etuple)
354 384
355 branch : pat DARROW eexp (pat, eexp) 385 branch : pat DARROW eexp (pat, eexp)
356 386
357 branchs: ([]) 387 branchs: ([])
358 | BAR branch branchs (branch :: branchs) 388 | BAR branch branchs (branch :: branchs)
367 | STRING (PPrim (Prim.String STRING), s (STRINGleft, STRINGright)) 397 | STRING (PPrim (Prim.String STRING), s (STRINGleft, STRINGright))
368 | LPAREN pat RPAREN (pat) 398 | LPAREN pat RPAREN (pat)
369 | LBRACE RBRACE (PRecord ([], false), s (LBRACEleft, RBRACEright)) 399 | LBRACE RBRACE (PRecord ([], false), s (LBRACEleft, RBRACEright))
370 | UNIT (PRecord ([], false), s (UNITleft, UNITright)) 400 | UNIT (PRecord ([], false), s (UNITleft, UNITright))
371 | LBRACE rpat RBRACE (PRecord rpat, s (LBRACEleft, RBRACEright)) 401 | LBRACE rpat RBRACE (PRecord rpat, s (LBRACEleft, RBRACEright))
402 | LPAREN ptuple RPAREN (PRecord (ListUtil.mapi (fn (i, p) => (Int.toString (i + 1), p)) ptuple,
403 false),
404 s (LPARENleft, RPARENright))
372 405
373 rpat : CSYMBOL EQ pat ([(CSYMBOL, pat)], false) 406 rpat : CSYMBOL EQ pat ([(CSYMBOL, pat)], false)
374 | DOTDOTDOT ([], true) 407 | DOTDOTDOT ([], true)
375 | CSYMBOL EQ pat COMMA rpat ((CSYMBOL, pat) :: #1 rpat, #2 rpat) 408 | CSYMBOL EQ pat COMMA rpat ((CSYMBOL, pat) :: #1 rpat, #2 rpat)
409
410 ptuple : pat COMMA pat ([pat1, pat2])
411 | pat COMMA ptuple (pat :: ptuple)
376 412
377 rexp : ([]) 413 rexp : ([])
378 | ident EQ eexp ([(ident, eexp)]) 414 | ident EQ eexp ([(ident, eexp)])
379 | ident EQ eexp COMMA rexp ((ident, eexp) :: rexp) 415 | ident EQ eexp COMMA rexp ((ident, eexp) :: rexp)
380 416