Commit 559706a2 authored by POTTIER Francois's avatar POTTIER Francois

Avoid toplevel side effects in [TokenType].

Explicitly parameterize [TokenType] over a grammar.
This removes the dependency of [TokenType] on [PreFront].
parent dc2f76a1
......@@ -1631,7 +1631,7 @@ let program = {
[ excdef ];
typedefs =
tokentypedef @
tokentypedef Front.grammar @
[ envtypedef; statetypedef ];
nonrecvaldefs =
......
module TT = TokenType (* artificial dependency; ensures that [TokenType] runs first *)
(* Start where [PreFront] left off. *)
let grammar =
PreFront.grammar
(* If [--only-tokens] was specified on the command line, produce
the definition of the [token] type and stop. *)
let () =
TokenType.produce_tokentype grammar
(* Perform reachability analysis. *)
let grammar =
......
......@@ -184,7 +184,7 @@ let program grammar =
paramdefs = PreFront.grammar.parameters;
prologue = PreFront.grammar.preludes;
excdefs = [];
typedefs = tokentypedef;
typedefs = tokentypedef PreFront.grammar;
nonrecvaldefs = [ begindef; def; enddef ];
moduledefs = [];
valdefs = [];
......
......@@ -59,7 +59,7 @@ let entrytypescheme_incremental symbol =
(* This is the interface of the generated parser -- only the part
that is specific of the table back-end. *)
let table_interface =
let table_interface grammar =
if Settings.table then [
IIComment "The incremental API.";
IIModule (
......@@ -75,42 +75,43 @@ let table_interface =
IIValDecls (
StringSet.fold (fun symbol decls ->
(incremental symbol, entrytypescheme_incremental symbol) :: decls
) PreFront.grammar.start_symbols []
) grammar.start_symbols []
)
] else []
(* This is the interface of the generated parser. *)
let tokentypedef =
match TokenType.tokentypedef with
let tokentypedef grammar =
match TokenType.tokentypedef grammar with
| [] ->
[]
| _ ->
[ IIComment "The type of tokens."; IITypeDecls TokenType.tokentypedef ]
| def ->
[ IIComment "The type of tokens."; IITypeDecls def ]
let interface = [
IIFunctor (PreFront.grammar.parameters,
tokentypedef @ [
let interface grammar = [
IIFunctor (grammar.parameters,
tokentypedef grammar @ [
IIComment "This exception is raised by the monolithic API functions.";
IIExcDecls [ excdef ];
IIComment "The monolithic API.";
IIValDecls (
StringSet.fold (fun symbol decls ->
(Misc.normalize symbol, entrytypescheme symbol) :: decls
) PreFront.grammar.start_symbols []
) grammar.start_symbols []
)
] @ table_interface)
] @ table_interface grammar)
]
(* Writing the interface to a file. *)
let write () =
assert (Settings.token_type_mode <> Settings.TokenTypeOnly);
let mli = open_out (Settings.base ^ ".mli") in
let module P = Printer.Make (struct
let f = mli
let locate_stretches = None
let raw_stretch_action = false
end) in
P.interface interface;
P.interface (interface PreFront.grammar);
close_out mli
......@@ -758,7 +758,7 @@ let program = {
[ excdef ];
typedefs =
tokentypedef @
tokentypedef Front.grammar @
[ tokendef1 ];
nonrecvaldefs =
......
......@@ -14,9 +14,10 @@ open CodeBits
let tctoken =
"token"
(* This is the definition of the type of tokens. *)
(* This is the definition of the type of tokens. (Regardless of
[Settings.token_type_mode], which is examined below.) *)
let tokentypedef =
let tokentypedef grammar =
let datadefs =
StringMap.fold (fun token properties defs ->
......@@ -38,7 +39,7 @@ let tokentypedef =
} :: defs
else
defs
) PreFront.grammar.tokens []
) grammar.tokens []
in
{
typename = tctoken;
......@@ -47,12 +48,10 @@ let tokentypedef =
typeconstraint = None
}
(* Consult the command line options to determine what to do.
If we were asked to only produce a type definition, then
do so and stop. Otherwise, tell the code generator whether
it should produce a type definition as part of the code. *)
(* If we were asked to only produce a type definition, then
do so and stop. *)
let tokentypedef, tokenprefix =
let produce_tokentype grammar =
match Settings.token_type_mode with
| Settings.TokenTypeOnly ->
......@@ -68,8 +67,8 @@ let tokentypedef, tokenprefix =
end)
in
P.interface [
IIFunctor (PreFront.grammar.parameters, [
IITypeDecls [ tokentypedef ]
IIFunctor (grammar.parameters, [
IITypeDecls [ tokentypedef grammar ]
])
];
let module P =
......@@ -80,22 +79,44 @@ let tokentypedef, tokenprefix =
end)
in
P.program {
paramdefs = PreFront.grammar.parameters;
paramdefs = grammar.parameters;
prologue = [];
excdefs = [];
typedefs = [ tokentypedef ];
typedefs = [ tokentypedef grammar ];
nonrecvaldefs = [];
valdefs = [];
moduledefs = [];
postlogue = [];
};
exit 0
| Settings.CodeOnly _
| Settings.TokenTypeAndCode ->
()
(* Redefine [tokentypedef], and define [tokenprefix], so as to tell the code
generator whether it should include a definition of the token type in the
code and how the token type is called. *)
let tokentypedef grammar =
match Settings.token_type_mode with
| Settings.CodeOnly _ ->
[]
| Settings.TokenTypeAndCode ->
[ tokentypedef grammar ]
| Settings.TokenTypeOnly ->
(* This should not happen, as [produce_tokentype] should
have been called first. *)
assert false
let tokenprefix id =
match Settings.token_type_mode with
| Settings.CodeOnly m ->
[],
(fun id -> m ^ "." ^ id)
m ^ "." ^ id
| Settings.TokenTypeAndCode ->
[ tokentypedef ],
(fun id -> id)
id
| Settings.TokenTypeOnly ->
id (* irrelevant, really *)
(* Redefine the name of the [token] type to take a possible
prefix into account. *)
......
......@@ -13,10 +13,16 @@ val ttoken: IL.typ
val tlexer: IL.typ
(* If we were asked to only produce a type definition, then
[produce_tokentype_and_stop] does so and stops Menhir.
Otherwise, it does nothing. *)
val produce_tokentype: UnparameterizedSyntax.grammar -> unit
(* This is the definition of the type of tokens, for use by the
code generator. *)
val tokentypedef: IL.typedef list
val tokentypedef: UnparameterizedSyntax.grammar -> IL.typedef list
(* This function prefixes the name of a token with an appropriate
Objective Caml module name, if necessary. *)
......
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