Mercurial > urweb

comparison src/urweb.grm @ 434:c471345f5165

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove need for '() <-' notation
author Adam Chlipala <adamc@hcoop.net>
date Mon, 27 Oct 2008 08:27:45 -0400
parents 8084fa9216de
children c5335613f31e
comparison
equal deleted inserted replaced
433:659c17441250 434:c471345f5165
261 | rexp of (con * exp) list 261 | rexp of (con * exp) list
262 | xml of exp 262 | xml of exp
263 | xmlOne of exp 263 | xmlOne of exp
264 | tag of string * exp 264 | tag of string * exp
265 | tagHead of string * exp 265 | tagHead of string * exp
266 | bind of string * con option * exp
266 267
267 | earg of exp * con -> exp * con 268 | earg of exp * con -> exp * con
268 | eargp of exp * con -> exp * con 269 | eargp of exp * con -> exp * con
269 | eargs of exp * con -> exp * con 270 | eargs of exp * con -> exp * con
270 | eargl of exp * con -> exp * con 271 | eargl of exp * con -> exp * con
666 val loc = s (IFleft, eexp3right) 667 val loc = s (IFleft, eexp3right)
667 in 668 in
668 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2), 669 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2),
669 ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc) 670 ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc)
670 end) 671 end)
671 | SYMBOL LARROW eexp SEMI eexp (let 672 | bind SEMI eexp (let
672 val loc = s (SYMBOLleft, eexp2right) 673 val loc = s (bindleft, eexpright)
674 val (v, to, e1) = bind
673 val e = (EVar (["Basis"], "bind", Infer), loc) 675 val e = (EVar (["Basis"], "bind", Infer), loc)
674 val e = (EApp (e, eexp1), loc) 676 val e = (EApp (e, e1), loc)
675 in 677 in
676 (EApp (e, (EAbs (SYMBOL, NONE, eexp2), loc)), loc) 678 (EApp (e, (EAbs (v, to, eexp), loc)), loc)
677 end)
678 | UNIT LARROW eexp SEMI eexp (let
679 val loc = s (UNITleft, eexp2right)
680 val e = (EVar (["Basis"], "bind", Infer), loc)
681 val e = (EApp (e, eexp1), loc)
682 val t = (TRecord (CRecord [], loc), loc)
683 in
684 (EApp (e, (EAbs ("_", SOME t, eexp2), loc)), loc)
685 end) 679 end)
686 | eexp EQ eexp (native_op ("eq", eexp1, eexp2, s (eexp1left, eexp2right))) 680 | eexp EQ eexp (native_op ("eq", eexp1, eexp2, s (eexp1left, eexp2right)))
687 | eexp NE eexp (native_op ("ne", eexp1, eexp2, s (eexp1left, eexp2right))) 681 | eexp NE eexp (native_op ("ne", eexp1, eexp2, s (eexp1left, eexp2right)))
688 | MINUS eterm (native_unop ("neg", eterm, s (MINUSleft, etermright))) 682 | MINUS eterm (native_unop ("neg", eterm, s (MINUSleft, etermright)))
689 | eexp PLUS eexp (native_op ("plus", eexp1, eexp2, s (eexp1left, eexp2right))) 683 | eexp PLUS eexp (native_op ("plus", eexp1, eexp2, s (eexp1left, eexp2right)))
696 | eexp LE eexp (native_op ("le", eexp1, eexp2, s (eexp1left, eexp2right))) 690 | eexp LE eexp (native_op ("le", eexp1, eexp2, s (eexp1left, eexp2right)))
697 | eexp GT eexp (native_op ("gt", eexp1, eexp2, s (eexp1left, eexp2right))) 691 | eexp GT eexp (native_op ("gt", eexp1, eexp2, s (eexp1left, eexp2right)))
698 | eexp GE eexp (native_op ("ge", eexp1, eexp2, s (eexp1left, eexp2right))) 692 | eexp GE eexp (native_op ("ge", eexp1, eexp2, s (eexp1left, eexp2right)))
699 693
700 | eexp WITH cterm EQ eexp (EWith (eexp1, cterm, eexp2), s (eexp1left, eexp2right)) 694 | eexp WITH cterm EQ eexp (EWith (eexp1, cterm, eexp2), s (eexp1left, eexp2right))
695
696 bind : SYMBOL LARROW eapps (SYMBOL, NONE, eapps)
697 | UNIT LARROW eapps (let
698 val loc = s (UNITleft, eappsright)
699 in
700 ("_", SOME (TRecord (CRecord [], loc), loc), eapps)
701 end)
702 | eapps (let
703 val loc = s (eappsleft, eappsright)
704 in
705 ("_", SOME (TRecord (CRecord [], loc), loc), eapps)
706 end)
701 707
702 eargs : earg (earg) 708 eargs : earg (earg)
703 | eargl (eargl) 709 | eargl (eargl)
704 710
705 eargl : eargp eargp (eargp1 o eargp2) 711 eargl : eargp eargp (eargp1 o eargp2)