changeset 242:cc193f680193

Shorthand for multi-binding exp declaration
author Adam Chlipala <adamc@hcoop.net>
date Thu, 28 Aug 2008 14:05:47 -0400 (2008-08-28)
parents 052126db06e7
children 2b9dfaffb008
files src/lacweb.grm src/lacweb.lex tests/eargs.lac tests/recBad.lac
diffstat 4 files changed, 28 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/src/lacweb.grm	Thu Aug 28 13:57:12 2008 -0400
+++ b/src/lacweb.grm	Thu Aug 28 14:05:47 2008 -0400
@@ -151,7 +151,7 @@
  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR
  | DIVIDE | DOTDOTDOT
- | CON | LTYPE | VAL | REC | AND | FOLD | UNIT | KUNIT | CLASS
+ | CON | LTYPE | VAL | REC | AND | FUN | FOLD | UNIT | KUNIT | CLASS
  | DATATYPE | OF
  | TYPE | NAME
  | ARROW | LARROW | DARROW | STAR
@@ -177,6 +177,7 @@
  | decl of decl
  | vali of string * con option * exp
  | valis of (string * con option * exp) list
+ | copt of con option
 
  | dargs of string list
  | barOpt of unit
@@ -230,6 +231,7 @@
  | eargp of exp * con -> exp * con
  | eargs of exp * con -> exp * con
  | eargl of exp * con -> exp * con
+ | eargl2 of exp * con -> exp * con
 
  | branch of pat * exp
  | branchs of (pat * exp) list
@@ -319,6 +321,7 @@
                    | _ => raise Fail "Arguments specified for imported datatype")
        | VAL vali                       (DVal vali, s (VALleft, valiright))
        | VAL REC valis                  (DValRec valis, s (VALleft, valisright))
+       | FUN valis                      (DValRec valis, s (FUNleft, valisright))
 
        | SIGNATURE CSYMBOL EQ sgn       (DSgn (CSYMBOL, sgn), s (SIGNATUREleft, sgnright))
        | STRUCTURE CSYMBOL EQ str       (DStr (CSYMBOL, NONE, str), s (STRUCTUREleft, strright))
@@ -365,8 +368,17 @@
 dcon   : CSYMBOL                        (CSYMBOL, NONE)
        | CSYMBOL OF cexp                (CSYMBOL, SOME cexp)
 
-vali   : SYMBOL EQ eexp                 (SYMBOL, NONE, eexp)
-       | SYMBOL COLON cexp EQ eexp      (SYMBOL, SOME cexp, eexp)
+vali   : SYMBOL eargl2 copt EQ eexp     (let
+                                             val loc = s (SYMBOLleft, eexpright)
+                                             val t = Option.getOpt (copt, (CWild (KType, loc), loc))
+
+                                             val (e, t) = eargl2 (eexp, t)
+                                         in
+                                             (SYMBOL, SOME t, e)
+                                         end)
+
+copt   :                                (NONE)
+       | COLON cexp                     (SOME cexp)
 
 valis  : vali                           ([vali])
        | vali AND valis                 (vali :: valis)
@@ -581,6 +593,9 @@
 eargl  : eargp eargp                    (eargp1 o eargp2)
        | eargp eargl                    (eargp o eargl)
 
+eargl2 :                                (fn x => x)
+       | eargp eargl2                   (eargp o eargl2)
+
 earg   : SYMBOL kcolon kind             (fn (e, t) =>
                                             let
                                                 val loc = s (SYMBOLleft, kindright)
--- a/src/lacweb.lex	Thu Aug 28 13:57:12 2008 -0400
+++ b/src/lacweb.lex	Thu Aug 28 14:05:47 2008 -0400
@@ -274,6 +274,7 @@
 <INITIAL> "val"       => (Tokens.VAL (pos yypos, pos yypos + size yytext));
 <INITIAL> "rec"       => (Tokens.REC (pos yypos, pos yypos + size yytext));
 <INITIAL> "and"       => (Tokens.AND (pos yypos, pos yypos + size yytext));
+<INITIAL> "fun"       => (Tokens.FUN (pos yypos, pos yypos + size yytext));
 <INITIAL> "fn"        => (Tokens.FN (pos yypos, pos yypos + size yytext));
 <INITIAL> "fold"      => (Tokens.FOLD (pos yypos, pos yypos + size yytext));
 <INITIAL> "case"      => (Tokens.CASE (pos yypos, pos yypos + size yytext));
--- a/tests/eargs.lac	Thu Aug 28 13:57:12 2008 -0400
+++ b/tests/eargs.lac	Thu Aug 28 14:05:47 2008 -0400
@@ -3,3 +3,11 @@
 
 val pair1 = fn (t1 ::: Type) (t2 ::: Type) (x1 : t1) (x2 : t2) => (x1, x2)
 val pair2 = fn (t1 ::: Type) (t2 ::: Type) (x1 : t1) (x2 : t2) () => pair1 x1 x2
+
+val id3 n = id2 n
+val id4 n : int = id3 n
+val id5 (n : int) = id4 n
+val id6 (n : int) : int = id5 n
+
+val id1 (t ::: Type) (x : t) = x
+val id2 (t ::: Type) (x : t) : t = id1 x
--- a/tests/recBad.lac	Thu Aug 28 13:57:12 2008 -0400
+++ b/tests/recBad.lac	Thu Aug 28 14:05:47 2008 -0400
@@ -1,6 +1,6 @@
 datatype list a = Nil | Cons of a * list a
 
-val rec append : t ::: Type -> list t -> list t -> list t = fn t ::: Type => fn ls1 => fn ls2 =>
+fun append (t ::: Type) (ls1 : list t) (ls2 : list t) : list t =
         case ls1 of
             Nil => ls2
           | Cons (h, t) => Cons (h, append t ls2)