Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
POTTIER Francois
menhir
Commits
4a1048f8
Commit
4a1048f8
authored
Jan 01, 2015
by
POTTIER Francois
Browse files
The generation of the inspection API is now subject to --inspection.
parent
d4c8a4b4
Changes
11
Hide whitespace changes
Inline
Side-by-side
demos/calc-incremental/Makefile
View file @
4a1048f8
...
...
@@ -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
...
...
src/interface.ml
View file @
4a1048f8
...
...
@@ -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
()
=
...
...
src/nonterminalType.ml
View file @
4a1048f8
...
...
@@ -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
}]
]
src/nonterminalType.mli
View file @
4a1048f8
...
...
@@ -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
...
...
src/settings.ml
View file @
4a1048f8
...
...
@@ -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"
;
...
...
src/settings.mli
View file @
4a1048f8
...
...
@@ -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
...
...
src/symbolType.ml
View file @
4a1048f8
...
...
@@ -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
}]
]
src/symbolType.mli
View file @
4a1048f8
...
...
@@ -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
src/tableBackend.ml
View file @
4a1048f8
...
...
@@ -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
::
...
...
src/tokenType.ml
View file @
4a1048f8
...
...
@@ -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
...
...
src/tokenType.mli
View file @
4a1048f8
...
...
@@ -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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment