# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1213902900 14400
# Node ID e3d3c27911059d3bf059963d1af9908aad0cb475
# Parent  02f42e9a1825abd5465f3b11d26c7d7b39d4c914
Functor parsing

diff -r 02f42e9a1825 -r e3d3c2791105 src/elaborate.sml
--- a/src/elaborate.sml	Thu Jun 19 12:39:22 2008 -0400
+++ b/src/elaborate.sml	Thu Jun 19 15:15:00 2008 -0400
@@ -1097,6 +1097,7 @@
              (sgnError env (UnboundSgn (loc, x));
               (L'.SgnError, loc))
            | SOME (n, sgis) => (L'.SgnVar n, loc))
+      | L.SgnFun _ => raise Fail "Elaborate functor sig"
 
 fun sgiOfDecl (d, loc) =
     case d of
@@ -1343,6 +1344,7 @@
                          (strerror, sgnerror))
               | SOME sgn => ((L'.StrProj (str', x), loc), sgn)
         end
+      | L.StrFun _ => raise Fail "Elaborate functor"
 
 val elabFile = ListUtil.foldlMap elabDecl
 
diff -r 02f42e9a1825 -r e3d3c2791105 src/lacweb.grm
--- a/src/lacweb.grm	Thu Jun 19 12:39:22 2008 -0400
+++ b/src/lacweb.grm	Thu Jun 19 15:15:00 2008 -0400
@@ -44,7 +44,7 @@
  | TYPE | NAME
  | ARROW | LARROW | DARROW
  | FN | PLUSPLUS | DOLLAR
- | STRUCTURE | SIGNATURE | STRUCT | SIG | END
+ | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR
 
 %nonterm
    file of decl list
@@ -113,6 +113,8 @@
 
 sgn    : SIG sgis END                   (SgnConst sgis, s (SIGleft, ENDright))
        | CSYMBOL                        (SgnVar CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN COLON sgn
+                                        (SgnFun (CSYMBOL, sgn1, sgn2), s (FUNCTORleft, sgn2right))
 
 sgi    : CON SYMBOL DCOLON kind         (SgiConAbs (SYMBOL, kind), s (CONleft, kindright))
        | LTYPE SYMBOL                   (SgiConAbs (SYMBOL, (KType, s (LTYPEleft, SYMBOLright))),
@@ -130,6 +132,10 @@
 
 str    : STRUCT decls END               (StrConst decls, s (STRUCTleft, ENDright))
        | spath                          (spath)
+       | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN DARROW str
+                                        (StrFun (CSYMBOL, sgn, NONE, str), s (FUNCTORleft, strright))
+       | FUNCTOR LPAREN CSYMBOL COLON sgn RPAREN COLON sgn DARROW str
+                                        (StrFun (CSYMBOL, sgn1, SOME sgn2, str), s (FUNCTORleft, strright))
 
 spath  : CSYMBOL                        (StrVar CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
        | spath DOT CSYMBOL              (StrProj (spath, CSYMBOL), s (spathleft, CSYMBOLright))
diff -r 02f42e9a1825 -r e3d3c2791105 src/lacweb.lex
--- a/src/lacweb.lex	Thu Jun 19 12:39:22 2008 -0400
+++ b/src/lacweb.lex	Thu Jun 19 15:15:00 2008 -0400
@@ -133,6 +133,7 @@
 <INITIAL> "struct"    => (Tokens.STRUCT (yypos, yypos + size yytext));
 <INITIAL> "sig"       => (Tokens.SIG (yypos, yypos + size yytext));
 <INITIAL> "end"       => (Tokens.END (yypos, yypos + size yytext));
+<INITIAL> "functor"   => (Tokens.FUNCTOR (yypos, yypos + size yytext));
 
 <INITIAL> "Type"      => (Tokens.TYPE (yypos, yypos + size yytext));
 <INITIAL> "Name"      => (Tokens.NAME (yypos, yypos + size yytext));
diff -r 02f42e9a1825 -r e3d3c2791105 src/source.sml
--- a/src/source.sml	Thu Jun 19 12:39:22 2008 -0400
+++ b/src/source.sml	Thu Jun 19 15:15:00 2008 -0400
@@ -71,6 +71,7 @@
 and sgn' =
     SgnConst of sgn_item list
   | SgnVar of string
+  | SgnFun of string * sgn * sgn
 
 withtype sgn_item = sgn_item' located
 and sgn = sgn' located
@@ -100,6 +101,7 @@
          StrConst of decl list
        | StrVar of string
        | StrProj of str * string
+       | StrFun of string * sgn * sgn option * str
 
 withtype decl = decl' located
      and str = str' located
diff -r 02f42e9a1825 -r e3d3c2791105 src/source_print.sml
--- a/src/source_print.sml	Thu Jun 19 12:39:22 2008 -0400
+++ b/src/source_print.sml	Thu Jun 19 15:15:00 2008 -0400
@@ -247,6 +247,18 @@
                               newline,
                               string "end"]
       | SgnVar x => string x
+      | SgnFun (x, sgn, sgn') => box [string "functor",
+                                      space,
+                                      string "(",
+                                      string x,
+                                      space,
+                                      string ":",
+                                      p_sgn sgn,
+                                      string ")",
+                                      space,
+                                      string ":",
+                                      space,
+                                      p_sgn sgn']
                                  
 fun p_decl ((d, _) : decl) =
     case d of
@@ -324,6 +336,34 @@
       | StrProj (str, x) => box [p_str str,
                                  string ".",
                                  string x]
+      | StrFun (x, sgn, NONE, str) => box [string "functor",
+                                           space,
+                                           string "(",
+                                           string x,
+                                           space,
+                                           string ":",
+                                           p_sgn sgn,
+                                           string ")",
+                                           space,
+                                           string "=>",
+                                           space,
+                                           p_str str]
+      | StrFun (x, sgn, SOME sgn', str) => box [string "functor",
+                                                space,
+                                                string "(",
+                                                string x,
+                                                space,
+                                                string ":",
+                                                p_sgn sgn,
+                                                string ")",
+                                                space,
+                                                string ":",
+                                                space,
+                                                p_sgn sgn',
+                                                space,
+                                                string "=>",
+                                                space,
+                                                p_str str]
 
 val p_file = p_list_sep newline p_decl
 
diff -r 02f42e9a1825 -r e3d3c2791105 tests/functor.lac
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/functor.lac	Thu Jun 19 15:15:00 2008 -0400
@@ -0,0 +1,15 @@
+signature S = sig
+        type t
+        val z : t
+        val s : t -> t
+end
+
+signature T = sig
+        type t
+        val three : t
+end
+
+structure F = functor (M : S) : T => struct
+        val t = M.t
+        val three = M.s (M.s (M.s M.z))
+end