Mercurial > urweb
changeset 40:e3d3c2791105
Functor parsing
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 19 Jun 2008 15:15:00 -0400 |
| parents | 02f42e9a1825 |
| children | 1405d8c26790 |
| files | src/elaborate.sml src/lacweb.grm src/lacweb.lex src/source.sml src/source_print.sml tests/functor.lac |
| diffstat | 6 files changed, 67 insertions(+), 1 deletions(-) [+] |
line wrap: on
line diff
--- 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
--- 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))
--- 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));
--- 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
--- 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
--- /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