diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-06-19 15:15:00 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-06-19 15:15:00 -0400 |
| commit | 5a4ddea95a551c5f95f0dcbda433fe457b61d25a (patch) | |
| tree | 60135c04bf54aba0d443ec39a4dc37ec0f399852 /src | |
| parent | 8e98be7de2dd3db541994aae47aeb45756f60098 (diff) | |
Functor parsing
Diffstat (limited to 'src')
| -rw-r--r-- | src/elaborate.sml | 2 | ||||
| -rw-r--r-- | src/lacweb.grm | 8 | ||||
| -rw-r--r-- | src/lacweb.lex | 1 | ||||
| -rw-r--r-- | src/source.sml | 2 | ||||
| -rw-r--r-- | src/source_print.sml | 40 |
5 files changed, 52 insertions, 1 deletions
diff --git a/src/elaborate.sml b/src/elaborate.sml index 29d12b07..d482f9a0 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -1097,6 +1097,7 @@ and elabSgn env (sgn, loc) = (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 @@ and elabStr env (str, loc) = (strerror, sgnerror)) | SOME sgn => ((L'.StrProj (str', x), loc), sgn) end + | L.StrFun _ => raise Fail "Elaborate functor" val elabFile = ListUtil.foldlMap elabDecl diff --git a/src/lacweb.grm b/src/lacweb.grm index f8f54fca..ea40c236 100644 --- a/src/lacweb.grm +++ b/src/lacweb.grm @@ -44,7 +44,7 @@ val s = ErrorMsg.spanOf | 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 @@ decl : CON SYMBOL EQ cexp (DCon (SYMBOL, NONE, cexp), s (CONleft, 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 @@ sgis : ([]) 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 --git a/src/lacweb.lex b/src/lacweb.lex index c5ce7ae8..56f19060 100644 --- a/src/lacweb.lex +++ b/src/lacweb.lex @@ -133,6 +133,7 @@ realconst = [0-9]+\.[0-9]*; <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 --git a/src/source.sml b/src/source.sml index a7ff04c6..6f8c932f 100644 --- a/src/source.sml +++ b/src/source.sml @@ -71,6 +71,7 @@ datatype sgn_item' = 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 @@ datatype decl' = 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 --git a/src/source_print.sml b/src/source_print.sml index 2005d09f..fb416a60 100644 --- a/src/source_print.sml +++ b/src/source_print.sml @@ -247,6 +247,18 @@ and p_sgn (sgn, _) = 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 @@ and p_str (str, _) = | 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 |