Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
POTTIER Francois
menhir
Commits
4c65eb03
Commit
4c65eb03
authored
Apr 06, 2017
by
POTTIER Francois
Browse files
Moved [production_where] from [Invariant] to [Lr1].
parent
cdced2f0
Changes
6
Hide whitespace changes
Inline
Side-by-side
src/codeBackend.ml
View file @
4c65eb03
...
...
@@ -439,7 +439,7 @@ let (shiftreduce : Production.index -> bool), shiftreducecount =
(* Check that all call sites push a stack cell and have a
default reduction. *)
Invariant
.
fold_reduced
(
fun
s
accu
->
Lr1
.
fold_reduced
(
fun
s
accu
->
accu
&&
(
match
Default
.
has_default_reduction
s
with
None
->
false
|
Some
_
->
true
)
&&
(
runpushes
s
)
)
prod
true
...
...
@@ -1665,7 +1665,7 @@ let program =
Nonterminal
.
foldx
(
fun
nt
defs
->
gotodef
nt
::
defs
)
(
Production
.
fold
(
fun
prod
defs
->
if
Invariant
.
ever_reduced
prod
then
if
Lr1
.
ever_reduced
prod
then
reducedef
prod
::
defs
else
defs
...
...
src/invariant.ml
View file @
4c65eb03
...
...
@@ -236,43 +236,6 @@ let stack_states (node : Lr1.node) : StateVector.property =
|
NonBottom
v
->
v
(* ------------------------------------------------------------------------ *)
(* For each production, compute where (that is, in which states) this
production can be reduced. *)
let
production_where
:
Lr1
.
NodeSet
.
t
ProductionMap
.
t
=
Lr1
.
fold
(
fun
accu
node
->
TerminalMap
.
fold
(
fun
_
prods
accu
->
let
prod
=
Misc
.
single
prods
in
let
nodes
=
try
ProductionMap
.
lookup
prod
accu
with
Not_found
->
Lr1
.
NodeSet
.
empty
in
ProductionMap
.
add
prod
(
Lr1
.
NodeSet
.
add
node
nodes
)
accu
)
(
Lr1
.
reductions
node
)
accu
)
ProductionMap
.
empty
let
production_where
(
prod
:
Production
.
index
)
:
Lr1
.
NodeSet
.
t
=
try
(* Production [prod] may be reduced at [nodes]. *)
let
nodes
=
ProductionMap
.
lookup
prod
production_where
in
assert
(
not
(
Lr1
.
NodeSet
.
is_empty
nodes
));
nodes
with
Not_found
->
(* The production [prod] is never reduced. *)
Lr1
.
NodeSet
.
empty
let
may_reduce
node
prod
=
Lr1
.
NodeSet
.
mem
node
(
production_where
prod
)
let
ever_reduced
prod
=
not
(
Lr1
.
NodeSet
.
is_empty
(
production_where
prod
))
let
fold_reduced
f
prod
accu
=
Lr1
.
NodeSet
.
fold
f
(
production_where
prod
)
accu
(* ------------------------------------------------------------------------ *)
(* Warn about productions that are never reduced. *)
...
...
@@ -286,7 +249,7 @@ let fold_reduced f prod accu =
let
()
=
let
count
=
ref
0
in
Production
.
iter
(
fun
prod
->
if
Lr1
.
NodeSet
.
is_empty
(
production_where
prod
)
then
if
Lr1
.
NodeSet
.
is_empty
(
Lr1
.
production_where
prod
)
then
match
Production
.
classify
prod
with
|
Some
nt
->
incr
count
;
...
...
@@ -312,7 +275,7 @@ let () =
let
production_states
:
Production
.
index
->
StateLattice
.
property
=
Production
.
tabulate
(
fun
prod
->
let
nodes
=
production_where
prod
in
let
nodes
=
Lr1
.
production_where
prod
in
let
height
=
Production
.
length
prod
in
Lr1
.
NodeSet
.
fold
(
fun
node
accu
->
join
accu
...
...
@@ -439,7 +402,7 @@ let () =
|
Bottom
->
()
|
NonBottom
v
->
let
sites
=
production_where
prod
in
let
sites
=
Lr1
.
production_where
prod
in
let
length
=
Production
.
length
prod
in
if
length
=
0
then
Lr1
.
NodeSet
.
iter
represent
sites
...
...
src/invariant.mli
View file @
4c65eb03
...
...
@@ -113,22 +113,6 @@ val endp: Symbol.t -> bool
val
errorpeeker
:
Lr1
.
node
->
bool
(* ------------------------------------------------------------------------- *)
(* Information about which productions are reduced and where. *)
(* [may_reduce s prod] tells whether state [s] may reduce production [prod]. *)
val
may_reduce
:
Lr1
.
node
->
Production
.
index
->
bool
(* [ever_reduced prod] tells whether production [prod] is ever reduced. *)
val
ever_reduced
:
Production
.
index
->
bool
(* [fold_reduced prod] folds over all states that can reduce
production [prod]. *)
val
fold_reduced
:
(
Lr1
.
node
->
'
a
->
'
a
)
->
Production
.
index
->
'
a
->
'
a
(* ------------------------------------------------------------------------- *)
(* Miscellaneous. *)
...
...
src/lr1.ml
View file @
4c65eb03
...
...
@@ -934,6 +934,56 @@ let () =
if
Error
.
errors
()
then
exit
1
(* ------------------------------------------------------------------------ *)
(* For each production, compute where (that is, in which states) this
production can be reduced. This computation is done AFTER default conflict
resolution (see below). It is an error to call the accessor functions
[may_reduce], [ever_reduced], [fold_reduced] before conflict resolution. *)
let
production_where
:
NodeSet
.
t
ProductionMap
.
t
option
ref
=
ref
None
let
initialize_production_where
()
=
production_where
:=
Some
(
fold
(
fun
accu
node
->
TerminalMap
.
fold
(
fun
_
prods
accu
->
let
prod
=
Misc
.
single
prods
in
let
nodes
=
try
ProductionMap
.
lookup
prod
accu
with
Not_found
->
NodeSet
.
empty
in
ProductionMap
.
add
prod
(
NodeSet
.
add
node
nodes
)
accu
)
(
reductions
node
)
accu
)
ProductionMap
.
empty
)
let
production_where
(
prod
:
Production
.
index
)
:
NodeSet
.
t
=
match
!
production_where
with
|
None
->
(* It is an error to call this function before conflict resolution. *)
assert
false
|
Some
production_where
->
try
(* Production [prod] may be reduced at [nodes]. *)
let
nodes
=
ProductionMap
.
lookup
prod
production_where
in
assert
(
not
(
NodeSet
.
is_empty
nodes
));
nodes
with
Not_found
->
(* The production [prod] is never reduced. *)
NodeSet
.
empty
let
may_reduce
node
prod
=
NodeSet
.
mem
node
(
production_where
prod
)
let
ever_reduced
prod
=
not
(
NodeSet
.
is_empty
(
production_where
prod
))
let
fold_reduced
f
prod
accu
=
NodeSet
.
fold
f
(
production_where
prod
)
accu
(* ------------------------------------------------------------------------ *)
(* When requested by the code generator, apply default conflict
resolution to ensure that the automaton is deterministic. *)
...
...
@@ -1084,7 +1134,10 @@ let default_conflict_resolution () =
if
!
ambiguities
=
1
then
Error
.
grammar_warning
[]
"one state has an end-of-stream conflict."
else
if
!
ambiguities
>
1
then
Error
.
grammar_warning
[]
"%d states have an end-of-stream conflict."
!
ambiguities
Error
.
grammar_warning
[]
"%d states have an end-of-stream conflict."
!
ambiguities
;
(* We can now compute where productions are reduced. *)
initialize_production_where
()
(* ------------------------------------------------------------------------ *)
(* Extra reductions. *)
...
...
src/lr1.mli
View file @
4c65eb03
...
...
@@ -176,3 +176,25 @@ val default_conflict_resolution: unit -> unit
val
extra_reductions
:
unit
->
unit
(* ------------------------------------------------------------------------- *)
(* Information about which productions are reduced and where. It is an error
to call one of these functions before default conflict resolution has taken
place. *)
(* [production_where prod] is the set of all states [s] where production
[prod] might be reduced. *)
val
production_where
:
Production
.
index
->
NodeSet
.
t
(* [may_reduce s prod] tells whether state [s] may reduce production [prod]. *)
val
may_reduce
:
node
->
Production
.
index
->
bool
(* [ever_reduced prod] tells whether production [prod] is ever reduced. *)
val
ever_reduced
:
Production
.
index
->
bool
(* [fold_reduced prod] folds over all states that can reduce
production [prod]. *)
val
fold_reduced
:
(
node
->
'
a
->
'
a
)
->
Production
.
index
->
'
a
->
'
a
src/referenceInterpreter.ml
View file @
4c65eb03
...
...
@@ -195,7 +195,7 @@ module T = struct
}
let
may_reduce
=
Invariant
.
may_reduce
Lr1
.
may_reduce
(* The logging functions that follow are called only if [log] is [true]. *)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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