Attention une mise à jour du serveur va être effectuée le vendredi 16 avril entre 12h et 12h30. Cette mise à jour va générer une interruption du service de quelques minutes.

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