changeset 239:fc6f04889bf2

Shorthand for multi-binding con 'fn'
author Adam Chlipala <adamc@hcoop.net>
date Thu, 28 Aug 2008 13:29:57 -0400
parents 44a1663ad893
children 7036d29574f2
files src/lacweb.grm tests/cargs.lac tests/recBad.lac
diffstat 3 files changed, 56 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- a/src/lacweb.grm	Thu Aug 28 13:13:16 2008 -0400
+++ b/src/lacweb.grm	Thu Aug 28 13:29:57 2008 -0400
@@ -209,6 +209,10 @@
  | rcon of (con * con) list
  | rconn of (con * con) list
  | rcone of (con * con) list
+ | cargs of con * kind -> con * kind
+ | cargl of con * kind -> con * kind
+ | carg of con * kind -> con * kind
+ | cargp of con * kind -> con * kind
 
  | eexp of exp
  | eapps of exp
@@ -435,8 +439,7 @@
 
        | cexp PLUSPLUS cexp             (CConcat (cexp1, cexp2), s (cexp1left, cexp1right))
 
-       | FN SYMBOL DARROW cexp          (CAbs (SYMBOL, NONE, cexp), s (FNleft, cexpright))
-       | FN SYMBOL DCOLON kind DARROW cexp (CAbs (SYMBOL, SOME kind, cexp), s (FNleft, cexpright))
+       | FN cargs DARROW cexp           (#1 (cargs (cexp, (KWild, s (FNleft, cexpright)))))
        | cterm TWIDDLE cterm DARROW cexp(CDisjoint (cterm1, cterm2, cexp), s (cterm1left, cexpright))
        | cterm TWIDDLE cterm ARROW cexp (TDisjoint (cterm1, cterm2, cexp), s (cterm1left, cexpright))
 
@@ -455,6 +458,49 @@
 kcolon : DCOLON                         (Explicit)
        | TCOLON                         (Implicit)
 
+cargs  : carg                           (carg)
+       | cargl                          (cargl)
+
+cargl  : cargp cargp                    (cargp1 o cargp2)
+       | cargp cargl                    (cargp o cargl)
+
+carg   : SYMBOL                         (fn (c, k) =>
+                                            let
+                                                val loc = s (SYMBOLleft, SYMBOLright)
+                                            in
+                                                ((CAbs (SYMBOL, NONE, c), loc),
+                                                 (KArrow ((KWild, loc), k), loc))
+                                            end)
+       | SYMBOL DCOLON kind             (fn (c, k) =>
+                                            let
+                                                val loc = s (SYMBOLleft, kindright)
+                                            in
+                                                ((CAbs (SYMBOL, SOME kind, c), loc),
+                                                 (KArrow (kind, k), loc))
+                                            end)
+       | LPAREN SYMBOL DCOLON kind RPAREN (fn (c, k) =>
+                                              let
+                                                  val loc = s (LPARENleft, RPARENright)
+                                              in
+                                                  ((CAbs (SYMBOL, SOME kind, c), loc),
+                                                   (KArrow (kind, k), loc))
+                                              end)
+
+cargp  : SYMBOL                         (fn (c, k) =>
+                                            let
+                                                val loc = s (SYMBOLleft, SYMBOLright)
+                                            in
+                                                ((CAbs (SYMBOL, NONE, c), loc),
+                                                 (KArrow ((KWild, loc), k), loc))
+                                            end)
+       | LPAREN SYMBOL DCOLON kind RPAREN (fn (c, k) =>
+                                              let
+                                                  val loc = s (LPARENleft, RPARENright)
+                                              in
+                                                  ((CAbs (SYMBOL, SOME kind, c), loc),
+                                                   (KArrow (kind, k), loc))
+                                              end)
+
 path   : SYMBOL                         ([], SYMBOL)
        | CSYMBOL DOT path               (let val (ms, x) = path in (CSYMBOL :: ms, x) end)
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cargs.lac	Thu Aug 28 13:29:57 2008 -0400
@@ -0,0 +1,7 @@
+con id = fn t :: Type => t
+con id2 = fn (t :: Type) => id t
+con id3 = fn t => id2 t
+
+con pair = fn (t :: Type) (u :: Type) => (t, u)
+con pair2 = fn t u => pair t u
+con pair3 = fn t (u :: Type) => pair2 t u
--- a/tests/recBad.lac	Thu Aug 28 13:13:16 2008 -0400
+++ b/tests/recBad.lac	Thu Aug 28 13:29:57 2008 -0400
@@ -6,4 +6,4 @@
           | Cons (h, t) => Cons (h, append t ls2)
 
 (*val rec ones : list int = Cons (1, ones)*)
-val rec ones : unit -> list int = fn () => Cons (1, ones ())
+val rec ones = fn () => Cons (1, ones ())