Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
M
menhir
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
12
Issues
12
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
POTTIER Francois
menhir
Commits
b508805d
Commit
b508805d
authored
Jan 10, 2015
by
POTTIER Francois
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Modified the table back-end to merge the sub-modules [MenhirInterpreter]
and [Inspection].
parent
a3ce6eee
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
80 additions
and
95 deletions
+80
-95
demos/calc-incremental/calc.ml
demos/calc-incremental/calc.ml
+5
-8
src/interface.ml
src/interface.ml
+34
-54
src/interface.mli
src/interface.mli
+0
-6
src/tableBackend.ml
src/tableBackend.ml
+41
-27
No files found.
demos/calc-incremental/calc.ml
View file @
b508805d
...
...
@@ -30,7 +30,7 @@ let height env =
(* Printing a symbol. *)
let
print_symbol
symbol
=
let
open
Parser
.
Inspection
in
let
open
I
in
match
symbol
with
|
X
(
T
T_TIMES
)
->
"*"
...
...
@@ -56,10 +56,7 @@ let print_symbol symbol =
"error"
module
P
=
Printers
.
Make
(
struct
include
Parser
.
MenhirInterpreter
include
Parser
.
Inspection
end
)
(
struct
Printers
.
Make
(
I
)
(
struct
let
arrow
=
" -> "
let
dot
=
"."
let
space
=
" "
...
...
@@ -71,12 +68,12 @@ module P =
let
print_element
e
=
match
e
with
|
I
.
Element
(
s
,
v
,
_
,
_
)
->
print_symbol
(
Parser
.
Inspection
.
X
(
Parser
.
Inspection
.
incoming_symbol
s
))
print_symbol
(
I
.
X
(
I
.
incoming_symbol
s
))
let
print_element
e
:
string
=
match
e
with
|
I
.
Element
(
s
,
v
,
_
,
_
)
->
let
open
Parser
.
Inspection
in
let
open
I
in
match
incoming_symbol
s
with
|
T
T_TIMES
->
"*"
...
...
@@ -121,7 +118,7 @@ let dump env =
()
|
I
.
Cons
(
I
.
Element
(
current
,
_
,
_
,
_
)
,
_
)
->
Printf
.
fprintf
stderr
"Current state: %d
\n
%!"
(
Obj
.
magic
current
);
let
items
=
Parser
.
Inspection
.
items
current
in
let
items
=
I
.
items
current
in
Printf
.
fprintf
stderr
"#Items: %d
\n
%!"
(
List
.
length
items
);
List
.
iter
(
fun
item
->
Printf
.
fprintf
stderr
"%s
\n
%!"
(
P
.
print_item
item
)
...
...
src/interface.ml
View file @
b508805d
...
...
@@ -34,27 +34,12 @@ let interpreter =
let
result
t
=
TypApp
(
interpreter
^
".result"
,
[
t
])
let
raw_lr1state
=
"lr1state"
let
lr1state
=
interpreter
^
"."
^
raw_lr1state
"lr1state"
let
tlr1state
a
:
typ
=
TypApp
(
lr1state
,
[
a
])
(* This interface item is a re-definition of the type [lr1state] as
an abbreviation for [MenhirInterpreter.lr1state]. *)
let
lr1state_redef
=
let
a
=
"a"
in
IITypeDecls
[{
typename
=
raw_lr1state
;
typeparams
=
[
a
];
typerhs
=
TAbbrev
(
tlr1state
(
TypVar
a
));
typeconstraint
=
None
}]
(* -------------------------------------------------------------------------- *)
(* The name of the sub-module that contains the incremental entry points. *)
...
...
@@ -98,6 +83,35 @@ let monolithic_api grammar =
(* -------------------------------------------------------------------------- *)
(* The inspection API. *)
let
inspection_api
grammar
()
=
let
a
=
"a"
in
(* Define the types [terminal] and [nonterminal]. *)
TokenType
.
tokengadtdef
grammar
@
NonterminalType
.
nonterminalgadtdef
grammar
@
(* Include the signature that lists the inspection functions, with
appropriate type instantiations. *)
IIComment
"The inspection API."
::
IIInclude
(
with_types
WKDestructive
"MenhirLib.IncrementalEngine.INSPECTION"
[
[
a
]
,
"lr1state"
,
tlr1state
(
TypVar
a
);
[]
,
"production"
,
TypApp
(
"production"
,
[]
);
[
a
]
,
TokenType
.
tctokengadt
,
TokenType
.
ttokengadt
(
TypVar
a
);
[
a
]
,
NonterminalType
.
tcnonterminalgadt
,
NonterminalType
.
tnonterminalgadt
(
TypVar
a
)
]
)
::
[]
(* -------------------------------------------------------------------------- *)
(* The incremental API. *)
let
incremental_engine
()
:
module_type
=
...
...
@@ -129,56 +143,22 @@ let incremental_api grammar () : interface =
MTSigEnd
(
IIComment
"The incremental API."
::
IIInclude
(
incremental_engine
()
)
::
[]
listiflazy
Settings
.
inspection
(
inspection_api
grammar
)
)
)
::
(* The entry points must come after the incremental API, because
their type refers to the type [result]. *)
incremental_entry_points
grammar
(* -------------------------------------------------------------------------- *)
(* The inspection API. *)
let
inspection_api
grammar
()
=
let
a
=
"a"
in
IIComment
"The inspection API."
::
IIModule
(
inspection
,
MTSigEnd
(
(* Define the types [terminal] and [nonterminal]. *)
TokenType
.
tokengadtdef
grammar
@
NonterminalType
.
nonterminalgadtdef
grammar
@
(* Include the signature that lists the inspection functions, with
appropriate type instantiations. *)
IIComment
"The inspection functions."
::
IIInclude
(
with_types
WKDestructive
"MenhirLib.IncrementalEngine.INSPECTION"
[
[
a
]
,
"lr1state"
,
tlr1state
(
TypVar
a
);
[]
,
"production"
,
TypApp
(
"MenhirInterpreter.production"
,
[]
);
[
a
]
,
TokenType
.
tctokengadt
,
TokenType
.
ttokengadt
(
TypVar
a
);
[
a
]
,
NonterminalType
.
tcnonterminalgadt
,
NonterminalType
.
tnonterminalgadt
(
TypVar
a
)
]
)
::
[]
))
::
[]
(* -------------------------------------------------------------------------- *)
(* 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
)
listiflazy
Settings
.
table
(
incremental_api
grammar
)
)
]
...
...
src/interface.mli
View file @
b508805d
...
...
@@ -18,12 +18,6 @@ val interpreter: string
val
result
:
IL
.
typ
->
IL
.
typ
(* The type ['a lr1state], defined by the interpreter sub-module. *)
val
lr1state
:
string
val
tlr1state
:
IL
.
typ
->
IL
.
typ
val
lr1state_redef
:
IL
.
interface_item
(* The name of the sub-module that contains the incremental entry points. *)
val
incremental
:
string
...
...
src/tableBackend.ml
View file @
b508805d
...
...
@@ -16,11 +16,8 @@ module Run (T : sig end) = struct
let
menhirlib
=
"MenhirLib"
let
tableInterpreter
=
menhirlib
^
".TableInterpreter"
let
make
=
tableInterpreter
^
".Make"
let
make_engine
=
menhirlib
^
".TableInterpreter.Make"
let
make_symbol
=
menhirlib
^
".InspectionTableInterpreter.Symbols"
...
...
@@ -64,14 +61,22 @@ let entry =
let
start
=
interpreter
^
".start"
(* The following are names of internal sub-modules. *)
let
basics
=
"Basics"
(* name of an internal sub-module *)
"Basics"
let
tables
=
"Tables"
(* name of an internal sub-module *)
"Tables"
let
symbols
=
"Symbols"
let
shared
=
"Shared"
let
more
=
"
More"
(* name of an internal sub-module *)
let
ti
=
"
TI"
(* ------------------------------------------------------------------------ *)
...
...
@@ -934,11 +939,23 @@ let program =
(* Define the tables. *)
SIModuleDef
(
shared
,
MStruct
[
SIValDefs
(
false
,
[
lhs
;
])
]
)
::
SIModuleDef
(
tables
,
MStruct
[
(* The internal sub-module [basics] contains the definitions of the
exception [Error] and of the type [token]. *)
SIInclude
(
MVar
basics
);
(* The internal sub-module [shared] contains the tables that are
used both in normal mode and in [--inspection] mode. *)
SIInclude
(
MVar
shared
);
(* This is a non-recursive definition, so none of the names
defined here are visible in the semantic actions. *)
SIValDefs
(
false
,
[
...
...
@@ -949,7 +966,7 @@ let program =
error
;
start_def
;
action
;
lhs
;
(* [lhs] is part of [shared] *)
goto
;
semantic_action
;
trace
;
...
...
@@ -957,43 +974,40 @@ let program =
]
)
::
(* Apply the functor [TableInterpreter.Make] to the tables. *)
SIModuleDef
(
interpreter
,
MStruct
(
SIModuleDef
(
interpreter
,
MApp
(
MVar
make
,
MVar
tables
)
)
::
(* Apply the functor [TableInterpreter.Make] to the tables. *)
SIModuleDef
(
ti
,
MApp
(
MVar
make_engine
,
MVar
tables
))
::
SIInclude
(
MVar
ti
)
::
listiflazy
Settings
.
inspection
(
fun
()
->
[
SIModuleDef
(
inspection
,
MStruct
(
listiflazy
Settings
.
inspection
(
fun
()
->
(* Define the internal sub-module [
more
], which contains type
(* Define the internal sub-module [
symbols
], which contains type
definitions. Then, include this sub-module. This sub-module is used
again below, as part of the application of the functor
[TableInterpreter.MakeInspection]. *)
SIModuleDef
(
more
,
MStruct
(
SIModuleDef
(
symbols
,
MStruct
(
interface_to_structure
(
tokengadtdef
grammar
@
nonterminalgadtdef
grammar
)
))
::
SIInclude
(
MVar
more
)
::
SIInclude
(
MVar
symbols
)
::
SIInclude
(
MApp
(
MVar
make_inspection
,
MStruct
(
(* This module must satisfy [InspectionTableFormat.TABLES]. *)
(* [lr1state] *)
interface_to_structure
[
lr1state_redef
;
]
@
SIInclude
(
MVar
ti
)
::
(* [terminal], [nonterminal]. *)
SIInclude
(
MVar
more
)
::
SIInclude
(
MVar
symbols
)
::
(* This functor application builds the types [symbol] and [xsymbol]
in terms of the types [terminal] and [nonterminal]. This saves
us the trouble of generating these definitions. *)
SIInclude
(
MApp
(
MVar
make_symbol
,
MVar
more
))
::
SIInclude
(
MApp
(
MVar
make_symbol
,
MVar
symbols
))
::
(* [lhs] *)
SIInclude
(
MVar
tables
)
::
SIInclude
(
MVar
shared
)
::
SIValDefs
(
false
,
terminal
()
::
nonterminal
()
::
...
...
@@ -1008,9 +1022,9 @@ let program =
[]
)
)
)
])
@
))
::
SIValDefs
(
false
,
monolithic_api
)
::
...
...
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