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
facc2e90
Commit
facc2e90
authored
Jan 02, 2015
by
POTTIER Francois
Browse files
Cleanup in the generation of the .ml and .mli files.
Things are reasonably clean now.
parent
cca9e4f5
Changes
12
Hide whitespace changes
Inline
Side-by-side
src/IL.mli
View file @
facc2e90
...
...
@@ -21,7 +21,7 @@ and interface_item =
and
module_type
=
|
MTNamedModuleType
of
string
|
MTWithType
of
module_type
*
string
*
with_kind
*
typ
|
MTWithType
of
module_type
*
string
list
*
string
*
with_kind
*
typ
|
MTSigEnd
of
interface
and
with_kind
=
...
...
src/IncrementalEngine.ml
View file @
facc2e90
...
...
@@ -94,10 +94,16 @@ end
module
type
INSPECTION
=
sig
type
xsymbol
type
'
a
lr1state
type
production
type
'
a
symbol
type
xsymbol
val
symbol
:
'
a
lr1state
->
'
a
symbol
val
lhs
:
production
->
xsymbol
val
rhs
:
production
->
xsymbol
list
...
...
src/codeBits.ml
View file @
facc2e90
...
...
@@ -217,7 +217,7 @@ let interface_to_structure i =
constraints. *)
let
with_types
wk
name
tys
=
List
.
fold_left
(
fun
mt
(
name
,
ty
)
->
MTWithType
(
mt
,
name
,
wk
,
ty
)
List
.
fold_left
(
fun
mt
(
params
,
name
,
ty
)
->
MTWithType
(
mt
,
params
,
name
,
wk
,
ty
)
)
(
MTNamedModuleType
name
)
tys
src/codeBits.mli
View file @
facc2e90
...
...
@@ -84,5 +84,5 @@ val interface_to_structure: interface -> structure
(* Constructing a named module type together with a list of "with type"
constraints. *)
val
with_types
:
IL
.
with_kind
->
string
->
(
string
*
IL
.
typ
)
list
->
IL
.
module_type
val
with_types
:
IL
.
with_kind
->
string
->
(
string
list
*
string
*
IL
.
typ
)
list
->
IL
.
module_type
src/interface.ml
View file @
facc2e90
...
...
@@ -34,6 +34,27 @@ let interpreter =
let
result
t
=
TypApp
(
interpreter
^
".result"
,
[
t
])
let
raw_lr1state
=
"lr1state"
let
lr1state
=
interpreter
^
"."
^
raw_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. *)
...
...
@@ -87,6 +108,7 @@ let incremental_api grammar () =
with_types
WKDestructive
"MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE"
[
[]
,
"token"
,
(* NOT [tctoken], which is qualified if [--external-tokens] is used *)
TokenType
.
ttoken
]
...
...
@@ -109,29 +131,29 @@ let incremental_api grammar () =
let
inspection_api
grammar
()
=
let
a
=
"a"
in
IIComment
"The inspection API."
::
IIModule
(
inspection
,
MTSigEnd
(
(* Define the types [terminal], [nonterminal], [symbol], [xsymbol]. *)
TokenType
.
tokengadtdef
grammar
@
NonterminalType
.
nonterminalgadtdef
grammar
@
SymbolType
.
symbolgadtdef
()
@
SymbolType
.
xsymboldef
()
@
IIComment
"This function maps a state to its incoming symbol."
::
IIValDecls
[
let
ty
=
arrow
(
TypApp
(
interpreter
^
".lr1state"
,
[
TypVar
"a"
]))
(
TypApp
(
"symbol"
,
[
TypVar
"a"
]))
in
(* TEMPORARY code sharing with tableBackend *)
"symbol"
,
type2scheme
ty
]
::
(* Include the signature that lists the inspection functions, with
appropriate type instantiations. *)
IIComment
"The inspection functions."
::
IIInclude
(
with_types
WKDestructive
"MenhirLib.IncrementalEngine.INSPECTION"
[
SymbolType
.
tcxsymbol
,
SymbolType
.
txsymbol
;
"production"
,
TypApp
(
"MenhirInterpreter.production"
,
[]
)
[
a
]
,
"lr1state"
,
tlr1state
(
TypVar
a
);
[]
,
"production"
,
TypApp
(
"MenhirInterpreter.production"
,
[]
);
[
a
]
,
SymbolType
.
tcsymbolgadt
,
SymbolType
.
tsymbolgadt
(
TypVar
a
);
[]
,
SymbolType
.
tcxsymbol
,
SymbolType
.
txsymbol
;
]
)
::
...
...
src/interface.mli
View file @
facc2e90
...
...
@@ -18,6 +18,12 @@ 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/printer.ml
View file @
facc2e90
...
...
@@ -677,16 +677,16 @@ let with_kind f = function
let
rec
module_type
f
=
function
|
MTNamedModuleType
s
->
output_string
f
s
|
MTWithType
(
mt
,
name
,
wk
,
t
)
->
|
MTWithType
(
mt
,
params
,
name
,
wk
,
t
)
->
fprintf
f
"%a%a"
module_type
mt
(
indent
2
with_type
)
(
name
,
wk
,
t
)
(
indent
2
with_type
)
(
params
,
name
,
wk
,
t
)
|
MTSigEnd
i
->
sigend
f
i
and
with_type
f
(
name
,
wk
,
t
)
=
fprintf
f
"with type %
s
%a %a"
name
and
with_type
f
(
params
,
name
,
wk
,
t
)
=
fprintf
f
"with type %
a
%a %a"
typ
(
TypApp
(
name
,
List
.
map
(
fun
v
->
TypVar
v
)
params
))
with_kind
wk
typ
t
...
...
src/symbolType.mli
View file @
facc2e90
(* The symbol GADT is the union of the terminal and nonterminal GADTs. *)
val
tcsymbolgadt
:
string
val
tsymbolgadt
:
IL
.
typ
->
IL
.
typ
(* The conventional names of the data constructors. *)
...
...
src/tableBackend.ml
View file @
facc2e90
...
...
@@ -65,9 +65,6 @@ let entry =
let
start
=
interpreter
^
".start"
let
lr1state
=
interpreter
^
".lr1state"
let
basics
=
"Basics"
(* name of an internal sub-module *)
...
...
@@ -776,16 +773,13 @@ let esymbol (symbol : Symbol.t) : expr =
let
xsymbol
(
symbol
:
Symbol
.
t
)
:
expr
=
EData
(
dataX
,
[
esymbol
symbol
])
(* The type [MenhirInterpreter.lr1state] is known (to us) to be an
alias for [int], so we can pattern match on it. To the user,
though, it will be an abstract type. *)
let
tlr1state
a
:
typ
=
TypApp
(
lr1state
,
[
a
])
(* Produce a function [symbol] that maps a state of type ['a lr1state]
(represented as an integer value) to a value of type ['a symbol]. *)
(* The type [MenhirInterpreter.lr1state] is known (to us) to be an alias for
[int], so we can pattern match on it. To the user, though, it will be an
abstract type. *)
let
incoming_symbol_def
()
=
{
valpublic
=
true
;
valpat
=
PVar
"symbol"
;
...
...
@@ -912,6 +906,7 @@ let program =
SIModuleDef
(
more
,
MStruct
(
interface_to_structure
(
lr1state_redef
::
tokengadtdef
grammar
@
nonterminalgadtdef
grammar
@
symbolgadtdef
()
@
...
...
@@ -921,13 +916,10 @@ let program =
SIInclude
(
MVar
more
)
::
SIValDefs
(
false
,
[
incoming_symbol_def
()
])
::
SIInclude
(
MApp
(
MVar
make_inspection
,
MStruct
[
SIInclude
(
MVar
more
);
SIValDefs
(
false
,
[
incoming_symbol_def
()
;
production_defs
()
])
]))
::
...
...
src/tableFormat.ml
View file @
facc2e90
...
...
@@ -121,8 +121,14 @@ end
module
type
INSPECTION_TABLES
=
sig
type
'
a
lr1state
type
'
a
symbol
type
xsymbol
(* This function maps a state to its incoming symbol. *)
val
symbol
:
'
a
lr1state
->
'
a
symbol
(* The definition (i.e. left-hand side and right-hand side) of every
(non-start) production. *)
...
...
src/tableInterpreter.ml
View file @
facc2e90
...
...
@@ -171,6 +171,9 @@ end)
module
MakeInspection
(
T
:
TableFormat
.
INSPECTION_TABLES
)
=
struct
let
symbol
=
T
.
symbol
let
production_def
prod
=
assert
(
0
<=
prod
&&
prod
<
Array
.
length
T
.
production_defs
);
match
T
.
production_defs
.
(
prod
)
with
...
...
src/tableInterpreter.mli
View file @
facc2e90
...
...
@@ -24,6 +24,8 @@ module Make (T : TableFormat.TABLES)
module
MakeInspection
(
T
:
TableFormat
.
INSPECTION_TABLES
)
:
IncrementalEngine
.
INSPECTION
with
type
xsymbol
:=
T
.
xsymbol
with
type
'
a
lr1state
:=
'
a
T
.
lr1state
and
type
'
a
symbol
:=
'
a
T
.
symbol
and
type
xsymbol
:=
T
.
xsymbol
and
type
production
:=
int
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