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
324acba3
Commit
324acba3
authored
Oct 20, 2015
by
POTTIER Francois
Browse files
Warn if an --on-error-reduce option is useless.
parent
1e34d32c
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/lr1.ml
View file @
324acba3
...
...
@@ -1078,9 +1078,19 @@ let default_conflict_resolution () =
(* This code can run before we decide on the default reductions; this does
not affect which default reductions will be permitted. *)
(* A count of how many states receive extra reductions through this mechanism. *)
let
extra
=
ref
0
(* The set of nonterminal symbols in the left-hand side of an extra reduction. *)
let
extra_nts
=
ref
StringSet
.
empty
let
lhs
prod
:
string
=
Nonterminal
.
print
false
(
Production
.
nt
prod
)
let
extra_reductions
()
=
iter
(
fun
node
->
(* Just like a default reduction, an extra reduction should be forbidden
...
...
@@ -1091,30 +1101,41 @@ let extra_reductions () =
let
productions
=
invert
(
reductions
node
)
in
(* Keep only those whose left-hand symbol is marked [--on-error-reduce]. *)
let
productions
=
ProductionMap
.
filter
(
fun
prod
_
->
S
ettings
.
on_error_reduce
(
Nonterminal
.
print
false
(
Production
.
nt
prod
))
S
tringSet
.
mem
(
lhs
prod
)
Settings
.
on_error_reduce
)
productions
in
(* Check if this only one such production remains. *)
match
ProductionMap
.
is_singleton
productions
with
|
None
->
()
|
Some
(
prod
,
_
)
->
(* An extra reduction is possible. Replace every error action with
a reduction of [prod]. *)
let
acceptable
=
acceptable_tokens
node
in
let
statistics
=
lazy
(
incr
extra
)
in
(* An extra reduction is possible. Replace every error action with
a reduction of [prod]. If we replace at least one error action
with a reduction, update [extra] and [extra_nts]. *)
let
triggered
=
lazy
(
incr
extra
;
extra_nts
:=
StringSet
.
add
(
lhs
prod
)
!
extra_nts
)
in
Terminal
.
iter_real
(
fun
tok
->
if
not
(
TerminalSet
.
mem
tok
acceptable
)
then
begin
node
.
reductions
<-
TerminalMap
.
add
tok
[
prod
]
node
.
reductions
;
Lazy
.
force
statistics
Lazy
.
force
triggered
end
)
end
);
(* Info message. *)
if
!
extra
>
0
then
Error
.
logA
1
(
fun
f
->
Printf
.
fprintf
f
"Extra reductions on error were added in %d states.
\n
"
!
extra
)
);
(* Warning about useless --on-error-reduce switches. *)
StringSet
.
iter
(
fun
nt
->
if
not
(
StringSet
.
mem
nt
!
extra_nts
)
then
Error
.
grammar_warning
[]
(
Printf
.
sprintf
"the command line option --on-error-reduce %s is never useful."
nt
)
)
Settings
.
on_error_reduce
(* ------------------------------------------------------------------------ *)
(* Define [fold_entry], which in some cases facilitates the use of [entry]. *)
...
...
src/settings.ml
View file @
324acba3
...
...
@@ -197,11 +197,11 @@ let echo_errors =
let
set_echo_errors
filename
=
echo_errors
:=
Some
filename
let
on_error_reduce
_symbols
=
let
on_error_reduce
=
ref
StringSet
.
empty
let
on_error_reduce_symbol
nt
=
on_error_reduce
_symbols
:=
StringSet
.
add
nt
!
on_error_reduce
_symbols
on_error_reduce
:=
StringSet
.
add
nt
!
on_error_reduce
let
options
=
Arg
.
align
[
"--base"
,
Arg
.
Set_string
base
,
"<basename> Specifies a base name for the output file(s)"
;
...
...
@@ -475,6 +475,6 @@ let update_errors =
let
echo_errors
=
!
echo_errors
let
on_error_reduce
nt
=
StringSet
.
mem
nt
!
on_error_reduce
_symbols
let
on_error_reduce
=
!
on_error_reduce
src/settings.mli
View file @
324acba3
...
...
@@ -208,9 +208,9 @@ val update_errors: string option
val
echo_errors
:
string
option
(* This
function takes a
non-terminal symbol
and tells whether it appears
in a command line
switch of the form [--on-error-reduce]. This switch
indicates that extra
reductions are desired when an error is detected. *)
(* This
is the set of
non-terminal symbol
s that appear in a command line
switch of the form [--on-error-reduce]. This switch
indicates that extra
reductions are desired when an error is detected. *)
val
on_error_reduce
:
s
tring
->
bool
val
on_error_reduce
:
S
tring
Set
.
t
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