diff options
| -rw-r--r-- | src/elaborate.sml | 26 | ||||
| -rw-r--r-- | src/lacweb.grm | 3 | ||||
| -rw-r--r-- | src/lacweb.lex | 2 | ||||
| -rw-r--r-- | src/source.sml | 1 | ||||
| -rw-r--r-- | src/source_print.sml | 3 | ||||
| -rw-r--r-- | tests/include.lac | 15 |
6 files changed, 43 insertions, 7 deletions
diff --git a/src/elaborate.sml b/src/elaborate.sml index 2417ce6f..56c23bfc 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -977,6 +977,7 @@ datatype sgn_error = | SgiWrongCon of L'.sgn_item * L'.con * L'.sgn_item * L'.con * cunify_error | SgnWrongForm of L'.sgn * L'.sgn | UnWhereable of L'.sgn * string + | NotIncludable of L'.sgn fun sgnError env err = case err of @@ -1007,6 +1008,9 @@ fun sgnError env err = (ErrorMsg.errorAt (#2 sgn) "Unavailable field for 'where'"; eprefaces' [("Signature", p_sgn env sgn), ("Field", PD.string x)]) + | NotIncludable sgn => + (ErrorMsg.errorAt (#2 sgn) "Invalid signature to 'include'"; + eprefaces' [("Signature", p_sgn env sgn)]) datatype str_error = UnboundStr of ErrorMsg.span * string @@ -1047,7 +1051,7 @@ fun elabSgn_item ((sgi, loc), env) = () ); - ((L'.SgiConAbs (x, n, k'), loc), env') + ([(L'.SgiConAbs (x, n, k'), loc)], env') end | L.SgiCon (x, ko, c) => @@ -1075,7 +1079,7 @@ fun elabSgn_item ((sgi, loc), env) = () ); - ((L'.SgiCon (x, n, k', c'), loc), env') + ([(L'.SgiCon (x, n, k', c'), loc)], env') end | L.SgiVal (x, c) => @@ -1095,7 +1099,7 @@ fun elabSgn_item ((sgi, loc), env) = () ); - ((L'.SgiVal (x, n, c'), loc), env') + ([(L'.SgiVal (x, n, c'), loc)], env') end | L.SgiStr (x, sgn) => @@ -1103,16 +1107,26 @@ fun elabSgn_item ((sgi, loc), env) = val sgn' = elabSgn env sgn val (env', n) = E.pushStrNamed env x sgn' in - ((L'.SgiStr (x, n, sgn'), loc), env') + ([(L'.SgiStr (x, n, sgn'), loc)], env') + end + + | L.SgiInclude sgn => + let + val sgn' = elabSgn env sgn + in + case #1 (hnormSgn env sgn') of + L'.SgnConst sgis => + (sgis, foldl (fn (sgi, env) => E.sgiBinds env sgi) env sgis) + | _ => (sgnError env (NotIncludable sgn'); + ([], env)) end - end and elabSgn env (sgn, loc) = case sgn of L.SgnConst sgis => let - val (sgis', _) = ListUtil.foldlMap elabSgn_item env sgis + val (sgis', _) = ListUtil.foldlMapConcat elabSgn_item env sgis in (L'.SgnConst sgis', loc) end diff --git a/src/lacweb.grm b/src/lacweb.grm index 3b85df07..021e862e 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 | FUNCTOR | WHERE | EXTERN + | STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN | INCLUDE | OPEN %nonterm file of decl list @@ -147,6 +147,7 @@ sgi : CON SYMBOL DCOLON kind (SgiConAbs (SYMBOL, kind), s (CONleft, k (SgiStr (CSYMBOL1, (SgnFun (CSYMBOL2, sgn1, sgn2), s (FUNCTORleft, sgn2right))), s (FUNCTORleft, sgn2right)) + | INCLUDE sgn (SgiInclude sgn, s (INCLUDEleft, sgnright)) sgis : ([]) | sgi sgis (sgi :: sgis) diff --git a/src/lacweb.lex b/src/lacweb.lex index 18c5a9e9..a821cc9e 100644 --- a/src/lacweb.lex +++ b/src/lacweb.lex @@ -155,6 +155,8 @@ realconst = [0-9]+\.[0-9]*; <INITIAL> "functor" => (Tokens.FUNCTOR (pos yypos, pos yypos + size yytext)); <INITIAL> "where" => (Tokens.WHERE (pos yypos, pos yypos + size yytext)); <INITIAL> "extern" => (Tokens.EXTERN (pos yypos, pos yypos + size yytext)); +<INITIAL> "include" => (Tokens.INCLUDE (pos yypos, pos yypos + size yytext)); +<INITIAL> "open" => (Tokens.OPEN (pos yypos, pos yypos + size yytext)); <INITIAL> "Type" => (Tokens.TYPE (pos yypos, pos yypos + size yytext)); <INITIAL> "Name" => (Tokens.NAME (pos yypos, pos yypos + size yytext)); diff --git a/src/source.sml b/src/source.sml index 6397bd71..266e8629 100644 --- a/src/source.sml +++ b/src/source.sml @@ -67,6 +67,7 @@ datatype sgn_item' = | SgiCon of string * kind option * con | SgiVal of string * con | SgiStr of string * sgn + | SgiInclude of sgn and sgn' = SgnConst of sgn_item list diff --git a/src/source_print.sml b/src/source_print.sml index 1ea2b837..208aa23a 100644 --- a/src/source_print.sml +++ b/src/source_print.sml @@ -238,6 +238,9 @@ fun p_sgn_item (sgi, _) = string ":", space, p_sgn sgn] + | SgiInclude sgn => box [string "include", + space, + p_sgn sgn] and p_sgn (sgn, _) = case sgn of diff --git a/tests/include.lac b/tests/include.lac new file mode 100644 index 00000000..6661d0f9 --- /dev/null +++ b/tests/include.lac @@ -0,0 +1,15 @@ +signature S = sig + type t + val x : t +end + +signature S' = sig + include S + val y : t +end + +signature S'' = sig + type u + include S' where type t = int + type v +end |