comparison src/lacweb.grm @ 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
comparison
equal deleted inserted replaced
240:7036d29574f2 241:052126db06e7
224 | xml of exp 224 | xml of exp
225 | xmlOne of exp 225 | xmlOne of exp
226 | tag of string * exp 226 | tag of string * exp
227 | tagHead of string * exp 227 | tagHead of string * exp
228 228
229 | earg of exp * con -> exp * con
230 | eargp of exp * con -> exp * con
231 | eargs of exp * con -> exp * con
232 | eargl of exp * con -> exp * con
233
229 | branch of pat * exp 234 | branch of pat * exp
230 | branchs of (pat * exp) list 235 | branchs of (pat * exp) list
231 | pat of pat 236 | pat of pat
232 | pterm of pat 237 | pterm of pat
233 | rpat of (string * pat) list * bool 238 | rpat of (string * pat) list * bool
476 | cargp cargl (cargp o cargl) 481 | cargp cargl (cargp o cargl)
477 482
478 cargl2 : (fn x => x) 483 cargl2 : (fn x => x)
479 | cargp cargl2 (cargp o cargl2) 484 | cargp cargl2 (cargp o cargl2)
480 485
481 carg : SYMBOL (fn (c, k) => 486 carg : SYMBOL DCOLON kind (fn (c, k) =>
482 let
483 val loc = s (SYMBOLleft, SYMBOLright)
484 in
485 ((CAbs (SYMBOL, NONE, c), loc),
486 (KArrow ((KWild, loc), k), loc))
487 end)
488 | SYMBOL DCOLON kind (fn (c, k) =>
489 let 487 let
490 val loc = s (SYMBOLleft, kindright) 488 val loc = s (SYMBOLleft, kindright)
491 in 489 in
492 ((CAbs (SYMBOL, SOME kind, c), loc), 490 ((CAbs (SYMBOL, SOME kind, c), loc),
493 (KArrow (kind, k), loc)) 491 (KArrow (kind, k), loc))
494 end) 492 end)
495 | LPAREN SYMBOL DCOLON kind RPAREN (fn (c, k) => 493 | cargp (cargp)
496 let
497 val loc = s (LPARENleft, RPARENright)
498 in
499 ((CAbs (SYMBOL, SOME kind, c), loc),
500 (KArrow (kind, k), loc))
501 end)
502 494
503 cargp : SYMBOL (fn (c, k) => 495 cargp : SYMBOL (fn (c, k) =>
504 let 496 let
505 val loc = s (SYMBOLleft, SYMBOLright) 497 val loc = s (SYMBOLleft, SYMBOLright)
506 in 498 in
565 eapps : eterm (eterm) 557 eapps : eterm (eterm)
566 | eapps eterm (EApp (eapps, eterm), s (eappsleft, etermright)) 558 | eapps eterm (EApp (eapps, eterm), s (eappsleft, etermright))
567 | eapps LBRACK cexp RBRACK (ECApp (eapps, cexp), s (eappsleft, RBRACKright)) 559 | eapps LBRACK cexp RBRACK (ECApp (eapps, cexp), s (eappsleft, RBRACKright))
568 560
569 eexp : eapps (eapps) 561 eexp : eapps (eapps)
570 | FN SYMBOL kcolon kind DARROW eexp (ECAbs (kcolon, SYMBOL, kind, eexp), s (FNleft, eexpright)) 562 | FN eargs DARROW eexp (let
571 | FN SYMBOL COLON cexp DARROW eexp (EAbs (SYMBOL, SOME cexp, eexp), s (FNleft, eexpright)) 563 val loc = s (FNleft, eexpright)
572 | FN SYMBOL DARROW eexp (EAbs (SYMBOL, NONE, eexp), s (FNleft, eexpright)) 564 in
573 | FN UNDER COLON cexp DARROW eexp (EAbs ("_", SOME cexp, eexp), s (FNleft, eexpright)) 565 #1 (eargs (eexp, (CWild (KType, loc), loc)))
566 end)
574 | LBRACK cterm TWIDDLE cterm RBRACK DARROW eexp(EDisjoint (cterm1, cterm2, eexp), s (LBRACKleft, RBRACKright)) 567 | LBRACK cterm TWIDDLE cterm RBRACK DARROW eexp(EDisjoint (cterm1, cterm2, eexp), s (LBRACKleft, RBRACKright))
575 | FN UNIT DARROW eexp (let
576 val loc = s (FNleft, eexpright)
577 in
578 (EAbs ("_", SOME (TRecord (CRecord [], loc), loc), eexp), loc)
579 end)
580
581 | eexp COLON cexp (EAnnot (eexp, cexp), s (eexpleft, cexpright)) 568 | eexp COLON cexp (EAnnot (eexp, cexp), s (eexpleft, cexpright))
582 | eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright)) 569 | eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright))
583 | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright)) 570 | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright))
584 | IF eexp THEN eexp ELSE eexp (let 571 | IF eexp THEN eexp ELSE eexp (let
585 val loc = s (IFleft, eexp3right) 572 val loc = s (IFleft, eexp3right)
586 in 573 in
587 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2), 574 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2),
588 ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc) 575 ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc)
589 end) 576 end)
577
578 eargs : earg (earg)
579 | eargl (eargl)
580
581 eargl : eargp eargp (eargp1 o eargp2)
582 | eargp eargl (eargp o eargl)
583
584 earg : SYMBOL kcolon kind (fn (e, t) =>
585 let
586 val loc = s (SYMBOLleft, kindright)
587 in
588 ((ECAbs (kcolon, SYMBOL, kind, e), loc),
589 (TCFun (kcolon, SYMBOL, kind, t), loc))
590 end)
591 | SYMBOL COLON cexp (fn (e, t) =>
592 let
593 val loc = s (SYMBOLleft, cexpright)
594 in
595 ((EAbs (SYMBOL, SOME cexp, e), loc),
596 (TFun (cexp, t), loc))
597 end)
598 | UNDER COLON cexp (fn (e, t) =>
599 let
600 val loc = s (UNDERleft, cexpright)
601 in
602 ((EAbs ("_", SOME cexp, e), loc),
603 (TFun (cexp, t), loc))
604 end)
605 | eargp (eargp)
606
607 eargp : SYMBOL (fn (e, t) =>
608 let
609 val loc = s (SYMBOLleft, SYMBOLright)
610 in
611 ((EAbs (SYMBOL, NONE, e), loc),
612 (TFun ((CWild (KType, loc), loc), t), loc))
613 end)
614 | UNIT (fn (e, t) =>
615 let
616 val loc = s (UNITleft, UNITright)
617 val t' = (TRecord (CRecord [], loc), loc)
618 in
619 ((EAbs ("_", SOME t', e), loc),
620 (TFun (t', t), loc))
621 end)
622 | UNDER (fn (e, t) =>
623 let
624 val loc = s (UNDERleft, UNDERright)
625 in
626 ((EAbs ("_", NONE, e), loc),
627 (TFun ((CWild (KType, loc), loc), t), loc))
628 end)
629 | LPAREN SYMBOL kcolon kind RPAREN(fn (e, t) =>
630 let
631 val loc = s (LPARENleft, RPARENright)
632 in
633 ((ECAbs (kcolon, SYMBOL, kind, e), loc),
634 (TCFun (kcolon, SYMBOL, kind, t), loc))
635 end)
636 | LPAREN SYMBOL COLON cexp RPAREN (fn (e, t) =>
637 let
638 val loc = s (LPARENleft, RPARENright)
639 in
640 ((EAbs (SYMBOL, SOME cexp, e), loc),
641 (TFun (cexp, t), loc))
642 end)
643 | LPAREN UNDER COLON cexp RPAREN (fn (e, t) =>
644 let
645 val loc = s (LPARENleft, RPARENright)
646 in
647 ((EAbs ("_", SOME cexp, e), loc),
648 (TFun (cexp, t), loc))
649 end)
590 650
591 eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) 651 eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
592 | LPAREN etuple RPAREN (let 652 | LPAREN etuple RPAREN (let
593 val loc = s (LPARENleft, RPARENright) 653 val loc = s (LPARENleft, RPARENright)
594 in 654 in