Mercurial > urweb

comparison src/urweb.grm @ 1001:1d456a06ea4e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add tuple pattern-matching at the constructor level
author Adam Chlipala <adamc@hcoop.net>
date Tue, 20 Oct 2009 10:19:00 -0400
parents 10114d7b7477
children 36efaf119b85
comparison
equal deleted inserted replaced
1000:5d7e05b4a5c0 1001:1d456a06ea4e
240 240
241 | cst of exp 241 | cst of exp
242 | csts of exp 242 | csts of exp
243 | cstopt of exp 243 | cstopt of exp
244 244
245 | ckl of (string * kind option) list
246
245 | pmode of prop_kind * exp 247 | pmode of prop_kind * exp
246 | pkind of prop_kind 248 | pkind of prop_kind
247 | prule of exp 249 | prule of exp
248 | pmodes of (prop_kind * exp) list 250 | pmodes of (prop_kind * exp) list
249 251
845 val loc = s (UNDERleft, UNDERright) 847 val loc = s (UNDERleft, UNDERright)
846 in 848 in
847 ((CAbs ("_", NONE, c), loc), 849 ((CAbs ("_", NONE, c), loc),
848 (KArrow ((KWild, loc), k), loc)) 850 (KArrow ((KWild, loc), k), loc))
849 end) 851 end)
850 | LPAREN SYMBOL DCOLON kind RPAREN (fn (c, k) => 852 | LPAREN SYMBOL kopt ckl RPAREN (fn (c, k) =>
851 let 853 let
852 val loc = s (LPARENleft, RPARENright) 854 val loc = s (LPARENleft, RPARENright)
855 val ckl = (SYMBOL, kopt) :: ckl
856 val ckl = map (fn (x, ko) => (x, case ko of
857 NONE => (KWild, loc)
858 | SOME k => k)) ckl
853 in 859 in
854 ((CAbs (SYMBOL, SOME kind, c), loc), 860 case ckl of
855 (KArrow (kind, k), loc)) 861 [(x, k')] => ((CAbs (SYMBOL, SOME k', c), loc),
862 (KArrow (k', k), loc))
863 | _ =>
864 let
865 val k' = (KTuple (map #2 ckl), loc)
866
867 val c = foldr (fn ((x, k), c) =>
868 (CAbs (x, SOME k, c), loc)) c ckl
869 val v = (CVar ([], "$x"), loc)
870 val c = ListUtil.foldli (fn (i, _, c) =>
871 (CApp (c, (CProj (v, i + 1), loc)),
872 loc)) c ckl
873 in
874 ((CAbs ("$x", SOME k', c), loc),
875 (KArrow (k', k), loc))
876 end
856 end) 877 end)
857 878
879 ckl : ([])
880 | COMMA SYMBOL kopt ckl ((SYMBOL, kopt) :: ckl)
858 881
859 path : SYMBOL ([], SYMBOL) 882 path : SYMBOL ([], SYMBOL)
860 | CSYMBOL DOT path (let val (ms, x) = path in (CSYMBOL :: ms, x) end) 883 | CSYMBOL DOT path (let val (ms, x) = path in (CSYMBOL :: ms, x) end)
861 884
862 cpath : CSYMBOL ([], CSYMBOL) 885 cpath : CSYMBOL ([], CSYMBOL)