Commit d43c59d9 authored by POTTIER Francois's avatar POTTIER Francois

Added the production of the type [nonterminal], i.e.,

the GADT of nonterminal symbols. In [--table] mode only
and only if the type of every nonterminal symbol is known.
parent 38f393e9
......@@ -16,19 +16,10 @@ let excredef = {
excdef with exceq = Some excname
}
(* Finding the type of a start symbol. *)
let ocamltype_of_start_symbol grammar symbol =
try
TypTextual (StringMap.find symbol grammar.types)
with Not_found ->
(* Every start symbol should have a type. *)
assert false
(* The type of the monolithic entry point for the start symbol [symbol]. *)
let entrytypescheme grammar symbol =
let typ = ocamltype_of_start_symbol grammar symbol in
let typ = TypTextual (ocamltype_of_start_symbol grammar symbol) in
type2scheme (marrow [ arrow tlexbuf TokenType.ttoken; tlexbuf ] typ)
(* When the table back-end is active, the generated parser contains,
......@@ -49,9 +40,35 @@ let incremental symbol =
(* The type of the incremental entry point for the start symbol [symbol]. *)
let entrytypescheme_incremental grammar symbol =
let t = ocamltype_of_start_symbol grammar symbol in
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]
]
(* This is the interface of the generated parser -- only the part
that is specific of the table back-end. *)
......@@ -75,29 +92,12 @@ let table_interface grammar =
)
] else []
(* 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];
]
| _ ->
assert false
(* This is the interface of the generated parser. *)
let interface grammar = [
IIFunctor (grammar.parameters,
tokentypedefs grammar @ [
tokentypedefs grammar @
nonterminalgadtdef grammar @ [
IIComment "This exception is raised by the monolithic API functions.";
IIExcDecls [ excdef ];
IIComment "The monolithic API.";
......
open UnparameterizedSyntax
open IL
(* This is the conventional name of the nonterminal GADT, which describes the
nonterminal symbols. *)
let tcnonterminalgadt =
"nonterminal"
let tnonterminalgadt a =
TypApp (tcnonterminalgadt, [ a ])
(* This is the conventional name of the data constructors of the nonterminal
GADT. *)
let tnonterminalgadtdata nt =
"N_" ^ Misc.normalize nt
(* This is the definition of the nonterminal GADT. Here, the data
constructors have no value argument, but have a type index. *)
exception MissingOCamlType
let nonterminalgadtdef grammar =
if Settings.table then
try
let datadefs =
List.fold_left (fun defs nt ->
let index =
match ocamltype_of_symbol grammar nt with
| Some t ->
TypTextual t
| None ->
raise MissingOCamlType
in
{
dataname = tnonterminalgadtdata nt;
datavalparams = [];
datatypeparams = Some [ index ]
} :: defs
) [] (nonterminals grammar)
in
[{
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. *)
[]
else
[]
(* This module deals with the definition of the type that describes the
nonterminal symbols. *)
(* This is the conventional name of the [nonterminal] GADT. This is an indexed
type (i.e., it has one type parameter). Its data constructors carry zero
value arguments. *)
val tnonterminalgadt: IL.typ -> IL.typ
(* This is the definition of the [nonterminal] GADT, for use by the code
generators. This definition can be constructed only if the type of every
nonterminal symbol is known, either because the user has provided this
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
(* When in [--depend] mode, we are asked to produce a mock [.mli] file before
[--infer] has run, which means that we are usually not able to construct
the definition of the [nonterminal] GADT. This implies that the mock [.mli]
file is a subset of the final [.mli] file. It is not clear at this point
whether this can cause a problem. *)
......@@ -4,6 +4,7 @@ open IL
open Interface
open Printf
open TokenType
open NonterminalType
open CodePieces
module Run (T : sig end) = struct
......@@ -759,6 +760,7 @@ let program = {
typedefs =
tokentypedefs Front.grammar @
nonterminalgadtdef Front.grammar @
[ tokendef1 ];
nonrecvaldefs =
......
......@@ -44,5 +44,28 @@ type grammar =
rules : rule StringMap.t;
}
let nonterminals grammar =
(* [nonterminals grammar] is a list of all nonterminal symbols in the
grammar [grammar]. *)
let nonterminals grammar : nonterminal list =
StringMap.fold (fun nt _ rules -> nt :: rules) grammar.rules []
(* [ocamltype_of_symbol grammar symbol] produces the OCaml type
of the symbol [symbol] in the grammar [grammar], if it is known. *)
let ocamltype_of_symbol grammar symbol : Stretch.ocamltype option =
try
Some (StringMap.find symbol grammar.types)
with Not_found ->
None
(* [ocamltype_of_start_symbol grammar symbol] produces the OCaml type
of the start symbol [symbol] in the grammar [grammar]. *)
let ocamltype_of_start_symbol grammar symbol : Stretch.ocamltype =
try
StringMap.find symbol grammar.types
with Not_found ->
(* Every start symbol should have a type. *)
assert false
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