Commit c4284a6f authored by POTTIER Francois's avatar POTTIER Francois

Cleanup. Removed a few horrible functions in [Interface] that were used

to insert comments a posteriori. Now done a priori where appropriate.
parent 0178ac11
......@@ -1624,19 +1624,22 @@ let initenvdef =
(* ------------------------------------------------------------------------ *)
(* Here is complete code for the parser. *)
let grammar =
Front.grammar
let program = {
paramdefs =
Front.grammar.UnparameterizedSyntax.parameters;
grammar.UnparameterizedSyntax.parameters;
prologue =
Front.grammar.UnparameterizedSyntax.preludes;
grammar.UnparameterizedSyntax.preludes;
excdefs =
[ excdef ];
typedefs =
tokentypedefs Front.grammar @
filter_typedefs (tokentypedefs grammar) @
[ envtypedef; statetypedef ];
nonrecvaldefs =
......@@ -1662,7 +1665,7 @@ let program = {
[];
postlogue =
Front.grammar.UnparameterizedSyntax.postludes
grammar.UnparameterizedSyntax.postludes
}
......
......@@ -150,3 +150,15 @@ let tvprefix name =
name
else
"ttv_" ^ name
(* ------------------------------------------------------------------------ *)
let filter_typedefs (items : interface_item list) : typedef list =
List.flatten (List.map (fun item ->
match item with
| IITypeDecls defs ->
defs
| _ ->
[]
) items)
......@@ -53,3 +53,8 @@ val marrow: typ list -> typ -> typ
val prefix: string -> string
val dataprefix: string -> string
val tvprefix: string -> string
(* Projecting interface items to typedefs. Any interface items other
than typedefs are lost. *)
val filter_typedefs: interface_item list -> typedef list
......@@ -184,7 +184,7 @@ let program grammar =
paramdefs = grammar.parameters;
prologue = grammar.preludes;
excdefs = [];
typedefs = tokentypedefs grammar;
typedefs = filter_typedefs (tokentypedefs grammar);
nonrecvaldefs = [ begindef; def; enddef ];
moduledefs = [];
valdefs = [];
......
......@@ -43,42 +43,6 @@ let entrytypescheme_incremental grammar symbol =
let t = TypTextual (ocamltype_of_start_symbol grammar symbol) in
type2scheme (marrow [ tunit ] (result t))
(* Inserting comments into the definitions of the types of tokens. Not pretty. *)
let tokentypedefs grammar =
let defs = TokenType.tokentypedefs grammar in
match defs with
| [] ->
[]
| [_] ->
[ IIComment "The type of tokens."; IITypeDecls defs ]
| def1 :: def2 :: _ ->
[ IIComment "The type of tokens.";
IITypeDecls [def1];
IIComment "The indexed type of terminal symbols.";
IITypeDecls [def2];
]
let nonterminalgadtdef grammar =
let defs = NonterminalType.nonterminalgadtdef grammar in
match defs with
| [] ->
[]
| def :: _ ->
[ IIComment "The indexed type of nonterminal symbols.";
IITypeDecls [def]
]
let symbolgadtdef grammar =
let defs = SymbolType.symbolgadtdef grammar in
match defs with
| [] ->
[]
| def :: _ ->
[ IIComment "The indexed type of (terminal and nonterminal) symbols.";
IITypeDecls [def]
]
(* This is the interface of the generated parser -- only the part
that is specific of the table back-end. *)
......@@ -106,9 +70,9 @@ let table_interface grammar =
let interface grammar = [
IIFunctor (grammar.parameters,
tokentypedefs grammar @
nonterminalgadtdef grammar @
symbolgadtdef grammar @ [
TokenType.tokentypedefs grammar @
NonterminalType.nonterminalgadtdef grammar @
SymbolType.symbolgadtdef grammar @ [
IIComment "This exception is raised by the monolithic API functions.";
IIExcDecls [ excdef ];
IIComment "The monolithic API.";
......
......@@ -40,12 +40,15 @@ let nonterminalgadtdef grammar =
} :: defs
) [] (nonterminals grammar)
in
[{
typename = tcnonterminalgadt;
typeparams = [ "_" ];
typerhs = TDefSum datadefs;
typeconstraint = None
}]
[
IIComment "The indexed type of nonterminal symbols.";
IITypeDecls [{
typename = tcnonterminalgadt;
typeparams = [ "_" ];
typerhs = TDefSum datadefs;
typeconstraint = None
}]
]
with MissingOCamlType ->
(* If the type of some nonterminal symbol is unknown, give up
on the whole thing. *)
......
......@@ -13,7 +13,7 @@ val tnonterminalgadt: IL.typ -> IL.typ
information, or because [--infer] has been set and inference has been
performed already. This definition is produced only in [--table] mode. *)
val nonterminalgadtdef: UnparameterizedSyntax.grammar -> IL.typedef list
val nonterminalgadtdef: UnparameterizedSyntax.grammar -> IL.interface_item list
(* When in [--(raw-)depend] mode, we are asked to produce a mock [.mli] file
before [--infer] has run, which means that we are usually not able to
......
......@@ -41,10 +41,11 @@ let symbolgadtdef grammar =
} ::
[]
in
[{
typename = tcsymbolgadt;
typeparams = [ a ];
typerhs = TDefSum datadefs;
typeconstraint = None
}]
[ IIComment "The indexed type of terminal and nonterminal symbols.";
IITypeDecls [{
typename = tcsymbolgadt;
typeparams = [ a ];
typerhs = TDefSum datadefs;
typeconstraint = None
}]
]
......@@ -5,5 +5,5 @@ val tsymbolgadt: IL.typ -> IL.typ
(* The definition of the symbol GADT. This definition can be produced only if
we are successfully able to construct the nonterminal GADT first. *)
val symbolgadtdef: UnparameterizedSyntax.grammar -> IL.typedef list
val symbolgadtdef: UnparameterizedSyntax.grammar -> IL.interface_item list
......@@ -763,9 +763,9 @@ let program = {
[ excdef ];
typedefs =
tokentypedefs grammar @
nonterminalgadtdef grammar @
symbolgadtdef grammar @
filter_typedefs (tokentypedefs grammar) @
filter_typedefs (nonterminalgadtdef grammar) @
filter_typedefs (symbolgadtdef grammar) @
[ tokendef1 ];
nonrecvaldefs =
......
......@@ -53,12 +53,15 @@ let tokentypedef grammar =
defs
) grammar.tokens []
in
{
typename = tctoken;
typeparams = [];
typerhs = TDefSum datadefs;
typeconstraint = None
}
[
IIComment "The type of tokens.";
IITypeDecls [{
typename = tctoken;
typeparams = [];
typerhs = TDefSum datadefs;
typeconstraint = None
}]
]
(* This is the definition of the token GADT. Here, the data
constructors have no value argument, but have a type index. *)
......@@ -83,12 +86,15 @@ let tokengadtdef grammar =
defs
) grammar.tokens []
in
{
typename = tctokengadt;
typeparams = [ "_" ];
typerhs = TDefSum datadefs;
typeconstraint = None
}
[
IIComment "The indexed type of terminal symbols.";
IITypeDecls [{
typename = tctokengadt;
typeparams = [ "_" ];
typerhs = TDefSum datadefs;
typeconstraint = None
}]
]
(* The token type is always needed. The token GADT is needed only in
[--table] mode. This ensures that, when [--table] is off, we remain
......@@ -96,9 +102,9 @@ let tokengadtdef grammar =
let typedefs grammar =
if Settings.table then
[ tokentypedef grammar; tokengadtdef grammar ]
tokentypedef grammar @ tokengadtdef grammar
else
[ tokentypedef grammar ]
tokentypedef grammar
(* If we were asked to only produce a type definition, then
do so and stop. *)
......@@ -111,7 +117,7 @@ let produce_tokentypes grammar =
necessary by the fact that the two can be different
when there are functor parameters. *)
let decls = typedefs grammar in
let items = typedefs grammar in
let module P =
Printer.Make (struct
......@@ -121,9 +127,7 @@ let produce_tokentypes grammar =
end)
in
P.interface [
IIFunctor (grammar.parameters, [
IITypeDecls decls
])
IIFunctor (grammar.parameters, items)
];
let module P =
Printer.Make (struct
......@@ -136,7 +140,7 @@ let produce_tokentypes grammar =
paramdefs = grammar.parameters;
prologue = [];
excdefs = [];
typedefs = decls;
typedefs = filter_typedefs items;
nonrecvaldefs = [];
valdefs = [];
moduledefs = [];
......
......@@ -38,7 +38,7 @@ val tokenprefix: string -> string
the type [token] when not in [--table] mode, and the types [token] and
[terminal] when in [--table] mode. *)
val tokentypedefs: UnparameterizedSyntax.grammar -> IL.typedef list
val tokentypedefs: UnparameterizedSyntax.grammar -> IL.interface_item list
(* If [--only-tokens] is set, then [produce_tokentypes] writes the type
definitions to the [.ml] and [.mli] files and stops Menhir. Otherwise,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment