Commit bdc4365f authored by POTTIER Francois's avatar POTTIER Francois

Updated [TokenType] to produce not only the type [token], but also

the type [terminal], which is a GADT. Produced only in [--table]
mode. The flags [--only-tokens] and [--external-tokens] are respected.
parent 9273fe11
......@@ -509,6 +509,11 @@ let statetypedef = {
typeconstraint = None
}
(* The type of lexers. *)
let tlexer =
TypArrow (tlexbuf, ttoken)
(* This is the type of parser environments. *)
let field modifiable name t =
......@@ -1631,7 +1636,7 @@ let program = {
[ excdef ];
typedefs =
tokentypedef Front.grammar @
tokentypedefs Front.grammar @
[ envtypedef; statetypedef ];
nonrecvaldefs =
......
......@@ -66,7 +66,7 @@ let () =
the definition of the [token] type and stop. *)
let () =
TokenType.produce_tokentype grammar
TokenType.produce_tokentypes grammar
(* ------------------------------------------------------------------------- *)
......
......@@ -184,7 +184,7 @@ let program grammar =
paramdefs = grammar.parameters;
prologue = grammar.preludes;
excdefs = [];
typedefs = tokentypedef grammar;
typedefs = tokentypedefs grammar;
nonrecvaldefs = [ begindef; def; enddef ];
moduledefs = [];
valdefs = [];
......
......@@ -75,18 +75,29 @@ let table_interface grammar =
)
] else []
(* This is the interface of the generated parser. *)
(* Inserting comments into the definitions of the types of tokens. Not pretty. *)
let tokentypedef grammar =
match TokenType.tokentypedef grammar with
let tokentypedefs grammar =
let defs = TokenType.tokentypedefs grammar in
match defs with
| [] ->
[]
| def ->
[ IIComment "The type of tokens."; IITypeDecls def ]
| [_] ->
[ 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];
]
| _ ->
assert false
(* This is the interface of the generated parser. *)
let interface grammar = [
IIFunctor (grammar.parameters,
tokentypedef grammar @ [
tokentypedefs grammar @ [
IIComment "This exception is raised by the monolithic API functions.";
IIExcDecls [ excdef ];
IIComment "The monolithic API.";
......
......@@ -758,7 +758,7 @@ let program = {
[ excdef ];
typedefs =
tokentypedef Front.grammar @
tokentypedefs Front.grammar @
[ tokendef1 ];
nonrecvaldefs =
......
......@@ -14,6 +14,18 @@ open CodeBits
let tctoken =
"token"
(* This is the conventional name of the token GADT, which describes
the tokens. Same setup as above. *)
let tctokengadt =
"terminal"
(* This is the conventional name of the data constructors of
the token GADT. *)
let ttokengadtdata token =
"T_" ^ token
(* This is the definition of the type of tokens. (Regardless of
[Settings.token_type_mode], which is examined below.) *)
......@@ -48,10 +60,50 @@ let tokentypedef grammar =
typeconstraint = None
}
(* This is the definition of the token GADT. Here, the data
constructors have no value argument, but have a type index. *)
let tokengadtdef grammar =
let datadefs =
StringMap.fold (fun token properties defs ->
if properties.tk_is_declared then
let index =
match properties.tk_ocamltype with
| None ->
tunit
| Some t ->
TypTextual t
in
{
dataname = ttokengadtdata token;
datavalparams = [];
datatypeparams = Some [ index ]
} :: defs
else
defs
) grammar.tokens []
in
{
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
compatible with old versions of OCaml, without GADTs. *)
let typedefs grammar =
if Settings.table then
[ tokentypedef grammar; tokengadtdef grammar ]
else
[ tokentypedef grammar ]
(* If we were asked to only produce a type definition, then
do so and stop. *)
let produce_tokentype grammar =
let produce_tokentypes grammar =
match Settings.token_type_mode with
| Settings.TokenTypeOnly ->
......@@ -59,6 +111,8 @@ let produce_tokentype grammar =
necessary by the fact that the two can be different
when there are functor parameters. *)
let decls = typedefs grammar in
let module P =
Printer.Make (struct
let f = open_out (Settings.base ^ ".mli")
......@@ -68,7 +122,7 @@ let produce_tokentype grammar =
in
P.interface [
IIFunctor (grammar.parameters, [
IITypeDecls [ tokentypedef grammar ]
IITypeDecls decls
])
];
let module P =
......@@ -82,7 +136,7 @@ let produce_tokentype grammar =
paramdefs = grammar.parameters;
prologue = [];
excdefs = [];
typedefs = [ tokentypedef grammar ];
typedefs = decls;
nonrecvaldefs = [];
valdefs = [];
moduledefs = [];
......@@ -94,16 +148,16 @@ let produce_tokentype grammar =
| 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. *)
(* Define [tokentypedefs], and define [tokenprefix], so as to tell the code
generator whether it should include a definition of the token types in the
code and how the token types are called. *)
let tokentypedef grammar =
let tokentypedefs grammar =
match Settings.token_type_mode with
| Settings.CodeOnly _ ->
[]
| Settings.TokenTypeAndCode ->
[ tokentypedef grammar ]
typedefs grammar
| Settings.TokenTypeOnly ->
(* This should not happen, as [produce_tokentype] should
have been called first. *)
......@@ -127,8 +181,9 @@ let tctoken =
let ttoken =
TypApp (tctoken, [])
(* The type of lexers. *)
let tctokengadt =
tokenprefix tctokengadt
let tlexer =
TypArrow (tlexbuf, ttoken)
let ttokengadt a =
TypApp (tctokengadt, [ a ])
(* This module deals with a few details regarding the definition of
the [token] type. In particular, if [--only-tokens] was specified,
it emits the type definition and exits. *)
(* This module deals with the definitions of the type(s) that describe
the tokens and the terminal symbols. *)
(* This is the conventional name of the [token] type, for use by
the code generator. *)
(* By default, following [ocamlyacc], we produce just one type, [token],
which describes the tokens. A token contains a tag (a terminal symbol)
and possibly a semantic value. *)
(* In addition to that, in [--table] mode only, we produce a GADT which
describes the terminal symbols. A terminal symbol is just a tag; it
does not carry a semantic value. *)
(* In this module, we also deal with [--only-tokens] and [--external-tokens].
If [--only-tokens] is specified on the command line, [produce_tokentypes]
emits the type definition(s) and exit. If [--external-tokens] is specified,
then the list [tokentypedefs] is empty, and [tokenprefix] produces a
nontrivial prefix. *)
(* This is the conventional name of the [token] type, for use by the code
generators. If [--external-tokens] is set, this type is qualified. *)
val tctoken: string
val ttoken: IL.typ
(* This is the type of lexers. It refers to the [token] type,
which is why it is defined here. *)
(* This is the conventional name of the [terminal] type, a.k.a. the token
GADT. This is an indexed type (i.e., it has one type parameter). Its data
constructors carry zero value arguments. If [--external-tokens] is set,
this type is qualified. *)
val tlexer: IL.typ
val ttokengadt: IL.typ -> 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. *)
(* If [--external-tokens] is set, then [tokenprefix] prefixes its argument
with an appropriate OCaml module name. Otherwise, it is the identity. *)
val produce_tokentype: UnparameterizedSyntax.grammar -> unit
val tokenprefix: string -> string
(* This is the definition of the type of tokens, for use by the
code generator. *)
(* These are the definitions of the types of tokens, for use by the code
generators. This can be a list of zero, one, or two types. Indeed, this
list is empty when [--external-tokens] is set. Otherwise, it contains just
the type [token] when not in [--table] mode, and the types [token] and
[terminal] when in [--table] mode. *)
val tokentypedef: UnparameterizedSyntax.grammar -> IL.typedef list
val tokentypedefs: UnparameterizedSyntax.grammar -> IL.typedef list
(* This function prefixes the name of a token with an appropriate
Objective Caml module name, if necessary. *)
(* If [--only-tokens] is set, then [produce_tokentypes] writes the type
definitions to the [.ml] and [.mli] files and stops Menhir. Otherwise,
it does nothing. *)
val tokenprefix: string -> string
val produce_tokentypes: UnparameterizedSyntax.grammar -> unit
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