Commit 4a1048f8 authored by POTTIER Francois's avatar POTTIER Francois

The generation of the inspection API is now subject to --inspection.

parent d4c8a4b4
......@@ -9,7 +9,7 @@ endif
# We assume that menhirLib has been installed in such a
# way that ocamlfind knows about it.
MENHIRFLAGS := --infer --table
MENHIRFLAGS := --infer --table --inspection
OCAMLBUILD := ocamlbuild -use-ocamlfind -use-menhir -menhir "$(MENHIR) $(MENHIRFLAGS)" -package menhirLib
......
......@@ -2,7 +2,9 @@ open UnparameterizedSyntax
open IL
open CodeBits
(* This is the [Error] exception. *)
(* -------------------------------------------------------------------------- *)
(* The [Error] exception. *)
let excname =
"Error"
......@@ -16,12 +18,16 @@ let excredef = {
excdef with exceq = Some excname
}
(* -------------------------------------------------------------------------- *)
(* The type of the monolithic entry point for the start symbol [symbol]. *)
let entrytypescheme grammar symbol =
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,
as a sub-module, an application of [Engine.Make]. This sub-module
is named as follows. *)
......@@ -32,6 +38,8 @@ let interpreter =
let result t =
TypApp (interpreter ^ ".result", [ t ])
(* -------------------------------------------------------------------------- *)
(* The name of the incremental entry point for the start symbol [symbol]. *)
let incremental symbol =
......@@ -46,67 +54,89 @@ let entrytypescheme_incremental grammar symbol =
let t = TypTextual (ocamltype_of_start_symbol grammar symbol) in
type2scheme (marrow [ tunit ] (result t))
(* This is the interface of the generated parser. *)
(* -------------------------------------------------------------------------- *)
let interface grammar = [
IIFunctor (grammar.parameters,
(* The monolithic (traditional) API: the type [token], the exception [Error],
and the parser's entry points. *)
let monolithic_api grammar =
TokenType.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 grammar symbol) :: decls
) grammar.start_symbols []
) ::
[]
(* -------------------------------------------------------------------------- *)
(* The incremental API. *)
let incremental_api grammar () =
(* The monolithic (traditional) API: the type [token], the exception
[Error], and the parser's entry points. *)
TokenType.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 grammar symbol) :: decls
) grammar.start_symbols []
) ::
(* The incremental engine and API. *)
listiflazy Settings.table (fun () -> [
IIComment "The incremental API.";
IIModule (
interpreter,
MTWithType (
MTNamedModuleType "MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE",
"token", (* NOT [tctoken], which is qualified if [--external-tokens] is used *)
WKDestructive,
TokenType.ttoken
)
);
IIComment "The entry point(s) to the incremental API.";
IIValDecls (
StringSet.fold (fun symbol decls ->
(incremental symbol, entrytypescheme_incremental grammar symbol) :: decls
) grammar.start_symbols []
)
]) @
(* The inspection API. *)
listiflazy Settings.table (fun () ->
TokenType.tokengadtdef grammar @
NonterminalType.nonterminalgadtdef grammar @
SymbolType.symbolgadtdef grammar @
(* TEMPORARY emit a comment *)
IIValDecls [
let ty =
arrow (TypApp (interpreter ^ ".lr1state", [ TypVar "a" ]))
(TypApp ("symbol", [ TypVar "a" ]))
in
(* TEMPORARY code sharing with tableBackend *)
"symbol", type2scheme ty
] ::
[]
IIComment "The incremental API." ::
IIModule (
interpreter,
MTWithType (
MTNamedModuleType "MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE",
"token", (* NOT [tctoken], which is qualified if [--external-tokens] is used *)
WKDestructive,
TokenType.ttoken
)
) ::
IIComment "The entry point(s) to the incremental API." ::
IIValDecls (
StringSet.fold (fun symbol decls ->
(incremental symbol, entrytypescheme_incremental grammar symbol) :: decls
) grammar.start_symbols []
) ::
[]
(* -------------------------------------------------------------------------- *)
(* The inspection API. *)
let inspection_api grammar () =
TokenType.tokengadtdef grammar @
NonterminalType.nonterminalgadtdef grammar @
SymbolType.symbolgadtdef() @
(* TEMPORARY emit a comment *)
IIValDecls [
let ty =
arrow (TypApp (interpreter ^ ".lr1state", [ TypVar "a" ]))
(TypApp ("symbol", [ TypVar "a" ]))
in
(* TEMPORARY code sharing with tableBackend *)
"symbol", type2scheme ty
] ::
[]
(* -------------------------------------------------------------------------- *)
(* The complete interface of the generated parser. *)
let interface grammar = [
IIFunctor (grammar.parameters,
monolithic_api grammar @
listiflazy Settings.table (incremental_api grammar) @
listiflazy Settings.inspection (inspection_api grammar)
)
]
(* -------------------------------------------------------------------------- *)
(* Writing the interface to a file. *)
let write grammar () =
......
......@@ -22,9 +22,10 @@ let tnonterminalgadtdata nt =
exception MissingOCamlType
let nonterminalgadtdef grammar =
assert Settings.table;
try
let datadefs =
assert Settings.inspection;
let comment, datadefs =
try
"The indexed type of nonterminal symbols.",
List.fold_left (fun defs nt ->
let index =
match ocamltype_of_symbol grammar nt with
......@@ -39,17 +40,21 @@ let nonterminalgadtdef grammar =
datatypeparams = Some [ index ]
} :: defs
) [] (nonterminals grammar)
in
[
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. *)
[]
with MissingOCamlType ->
(* If the type of some nonterminal symbol is unknown, give up
and define ['a nonterminal] as an abstract type. This is
useful when we are in [--(raw)-depend] mode and we do not
wish to fail. Instead, we produce a mock [.mli] file that
is an approximation of the real [.mli] file. *)
"The indexed type of nonterminal symbols (mock!).",
[]
in
[
IIComment comment;
IITypeDecls [{
typename = tcnonterminalgadt;
typeparams = [ "_" ];
typerhs = TDefSum datadefs;
typeconstraint = None
}]
]
......@@ -16,7 +16,8 @@ val tnonterminalgadtdata: string -> string
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. *)
performed already. This definition is produced only in [--inspection]
mode. *)
val nonterminalgadtdef: UnparameterizedSyntax.grammar -> IL.interface
......
......@@ -173,7 +173,7 @@ let options = Arg.align [
"--follow-construction", Arg.Set follow, " (undocumented)";
"--graph", Arg.Set graph, " Write grammar's dependency graph to <basename>.dot";
"--infer", Arg.Set infer, " Invoke ocamlc for ahead of time type inference";
"--inspection", Arg.Set inspection, " Generate an inspection API (requires --table)";
"--inspection", Arg.Set inspection, " Generate the inspection API (requires --table)";
"--interpret", Arg.Set interpret, " Interpret the sentences provided on stdin";
"--interpret-show-cst", Arg.Set interpret_show_cst, " Show a concrete syntax tree upon acceptance";
"--log-automaton", Arg.Set_int logA, "<level> Log information about the automaton";
......
......@@ -131,6 +131,11 @@ val interpret_show_cst : bool
val table : bool
(* Whether to generate the inspection API (which requires GADTs, and
requires producing more tables). *)
val inspection : bool
(* Whether to generate a coq description of the grammar and automaton. *)
val coq : bool
......
......@@ -20,33 +20,27 @@ let dataN =
(* The definition of the symbol GADT. *)
let symbolgadtdef grammar =
assert Settings.table;
(* This definition can be produced only if we are successfully able
to construct the nonterminal GADT. *)
match NonterminalType.nonterminalgadtdef grammar with
| [] ->
[]
| _ :: _ ->
let a = "a" in
let datadefs =
{
dataname = dataT;
datavalparams = [ TokenType.ttokengadt (TypVar a) ];
datatypeparams = Some [ TypVar a ]
} ::
{
dataname = dataN;
datavalparams = [ NonterminalType.tnonterminalgadt (TypVar a) ];
datatypeparams = Some [ TypVar a ]
} ::
[]
in
[ IIComment "The indexed type of terminal and nonterminal symbols.";
IITypeDecls [{
typename = tcsymbolgadt;
typeparams = [ a ];
typerhs = TDefSum datadefs;
typeconstraint = None
}]
]
let symbolgadtdef () =
assert Settings.inspection;
let a = "a" in
let datadefs =
{
dataname = dataT;
datavalparams = [ TokenType.ttokengadt (TypVar a) ];
datatypeparams = Some [ TypVar a ]
} ::
{
dataname = dataN;
datavalparams = [ NonterminalType.tnonterminalgadt (TypVar a) ];
datatypeparams = Some [ TypVar a ]
} ::
[]
in
[ IIComment "The indexed type of terminal and nonterminal symbols.";
IITypeDecls [{
typename = tcsymbolgadt;
typeparams = [ a ];
typerhs = TDefSum datadefs;
typeconstraint = None
}]
]
......@@ -10,5 +10,5 @@ val dataN: string
(* 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.interface
val symbolgadtdef: unit -> IL.interface
......@@ -778,8 +778,6 @@ let tlr1state a : typ =
(* Produce a function [symbol] that maps a state of type ['a lr1state]
(represented as an integer value) to a value of type ['a symbol]. *)
(* TEMPORARY maybe subject to a switch, so as to reduce table size *)
let incoming_symbol_def = {
valpublic = true;
valpat = PVar "symbol";
......@@ -858,13 +856,19 @@ let program =
SIValDefs (false, api) ::
interface_to_structure (
tokengadtdef grammar @
nonterminalgadtdef grammar @
symbolgadtdef grammar
) @
listiflazy Settings.inspection (fun () ->
interface_to_structure (
tokengadtdef grammar @
nonterminalgadtdef grammar @
symbolgadtdef()
) @
SIValDefs (false, [incoming_symbol_def]) ::
SIValDefs (false, [incoming_symbol_def]) ::
[]
) @
SIStretch grammar.postludes ::
......
......@@ -66,12 +66,12 @@ let tokentypedef grammar =
(* This is the definition of the token GADT. Here, the data
constructors have no value argument, but have a type index. *)
(* The token GADT is produced only in [--table] mode. This ensures that, when
[--table] is off, we remain compatible with old versions of OCaml, without
GADTs. *)
(* The token GADT is produced only when [Settings.inspection] is true. Thus,
when [Settings.inspection] is false, we remain compatible with old versions
of OCaml, without GADTs. *)
let tokengadtdef grammar =
assert Settings.table;
assert Settings.inspection;
let datadefs =
StringMap.fold (fun token properties defs ->
if properties.tk_is_declared then
......@@ -114,7 +114,7 @@ let produce_tokentypes grammar =
let i =
tokentypedef grammar @
listiflazy Settings.table (fun () ->
listiflazy Settings.inspection (fun () ->
tokengadtdef grammar
)
in
......
......@@ -5,9 +5,9 @@
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 addition to that, in [--inspection] 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]
......@@ -41,8 +41,8 @@ val tokengadtdata: string -> string
(* The definitions of the token type and of the token GADT, for use by the
code generators. Each of these lists may define zero or one type. Indeed,
both lists are empty when [--external-tokens] is set. Otherwise, only the
type [token] is defined when not in [--table] mode, and both [token] and
[terminal] are defined when in [--table] mode. *)
type [token] is defined always, and the type [terminal] is defined only in
[--inspection] mode. *)
val tokentypedef: UnparameterizedSyntax.grammar -> IL.interface
val tokengadtdef: UnparameterizedSyntax.grammar -> IL.interface
......
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