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
b2d35f36
Commit
b2d35f36
authored
Oct 19, 2015
by
POTTIER Francois
Browse files
Added an experimental switch, [--on-error-reduce symbol].
parent
762c2d26
Changes
6
Hide whitespace changes
Inline
Side-by-side
TODO
View file @
b2d35f36
* If we keep --on-error-reduce, document it.
* Is it true that the warning "this production is never reduced" is
sound but incomplete? i.e. certain states could be unreachable and
we do not know it (but LRijkstra can tell us).
...
...
src/conflict.ml
View file @
b2d35f36
...
...
@@ -506,3 +506,9 @@ let () =
Lr1
.
default_conflict_resolution
()
;
Time
.
tick
"Resolving remaining conflicts"
(* This is a good place to add extra reductions, if requested by the user. *)
let
()
=
Lr1
.
extra_reductions
()
;
Time
.
tick
"Adding extra reductions"
src/lr1.ml
View file @
b2d35f36
...
...
@@ -1057,6 +1057,60 @@ let default_conflict_resolution () =
else
if
!
ambiguities
>
1
then
Error
.
grammar_warning
[]
(
Printf
.
sprintf
"%d states have an end-of-stream conflict."
!
ambiguities
)
(* ------------------------------------------------------------------------ *)
(* Extra reductions. 2015/10/19 *)
(* If a state can reduce only one production, whose left-hand symbol has
been declared [--on-error-reduce], then every error action in this
state is replaced with a reduction action. This is done even though
this state may have outgoing shift transitions: thus, we are forcing
one interpretation of the past, among several possible interpretations. *)
(* This code looks like the decision for a default reduction in [Invariant],
except we do not impose the absence of outgoing terminal transitions.
Also, we actually modify the automaton, so the back-ends, the reference
interpreter, etc. need not be aware of this feature, whereas they are
aware of default reductions. *)
let
extra
=
ref
0
let
extra_reductions
()
=
iter
(
fun
node
->
if
not
node
.
forbid_default_reduction
then
match
ProductionMap
.
is_singleton
(
invert
(
reductions
node
))
with
|
Some
(
prod
,
toks
)
when
Settings
.
on_error_reduce
(
Nonterminal
.
print
false
(
Production
.
nt
prod
))
->
(* An extra reduction is possible. Take the set of all (real) tokens,
subtract the tokens for which there is an outgoing transition,
and allow reduction of [prod] on all of the remaining tokens. *)
let
accu
=
SymbolMap
.
fold
(
fun
symbol
_target
accu
->
match
symbol
with
|
Symbol
.
T
tok
->
TerminalSet
.
remove
tok
accu
|
Symbol
.
N
_
->
accu
)
(
transitions
node
)
TerminalSet
.
universe
in
(* Since shift/reduce conflicts have been resolved already, we
should have this property: *)
assert
(
TerminalSet
.
subset
toks
accu
);
(* Allow reduction of [prod] on the tokens in [accu]. *)
TerminalSet
.
iter
(
fun
tok
->
node
.
reductions
<-
TerminalMap
.
add
tok
[
prod
]
node
.
reductions
)
accu
;
(* Statistics. *)
if
not
(
TerminalSet
.
subset
accu
toks
)
then
incr
extra
;
|
_
->
()
);
if
!
extra
>
0
then
Error
.
logA
1
(
fun
f
->
Printf
.
fprintf
f
"Extra reductions on error were added in %d states.
\n
"
!
extra
)
(* ------------------------------------------------------------------------ *)
(* Define [fold_entry], which in some cases facilitates the use of [entry]. *)
...
...
src/lr1.mli
View file @
b2d35f36
...
...
@@ -142,3 +142,17 @@ val reverse_dfs: node -> (node -> bool)
val
default_conflict_resolution
:
unit
->
unit
(* This function adds extra reduction actions in the face of an error, if
requested by the user via [--on-error-reduce]. *)
(* It must be called after conflict resolution has taken place. The
automaton is modified in place. *)
(* If a state can reduce only one production, whose left-hand symbol has
been declared [--on-error-reduce], then every error action in this
state is replaced with a reduction action. This is done even though
this state may have outgoing shift transitions: thus, we are forcing
one interpretation of the past, among several possible interpretations. *)
val
extra_reductions
:
unit
->
unit
src/settings.ml
View file @
b2d35f36
...
...
@@ -191,6 +191,12 @@ let update_errors =
let
set_update_errors
filename
=
update_errors
:=
Some
filename
let
on_error_reduce_symbols
=
ref
StringSet
.
empty
let
on_error_reduce_symbol
nt
=
on_error_reduce_symbols
:=
StringSet
.
add
nt
!
on_error_reduce_symbols
let
options
=
Arg
.
align
[
"--base"
,
Arg
.
Set_string
base
,
"<basename> Specifies a base name for the output file(s)"
;
"--canonical"
,
Arg
.
Unit
(
fun
()
->
construction_mode
:=
ModeCanonical
)
,
" Construct a canonical Knuth LR(1) automaton"
;
...
...
@@ -225,6 +231,7 @@ let options = Arg.align [
"--no-stdlib"
,
Arg
.
Set
no_stdlib
,
" Do not load the standard library"
;
"--ocamlc"
,
Arg
.
Set_string
ocamlc
,
"<command> Specifies how ocamlc should be invoked"
;
"--ocamldep"
,
Arg
.
Set_string
ocamldep
,
"<command> Specifies how ocamldep should be invoked"
;
"--on-error-reduce"
,
Arg
.
String
on_error_reduce_symbol
,
"<symbol> Reduce this nonterminal symbol upon an error"
;
"--only-preprocess"
,
Arg
.
Unit
(
fun
()
->
preprocess_mode
:=
PMOnlyPreprocess
PrintNormal
)
,
" Print grammar and exit"
;
"--only-preprocess-u"
,
Arg
.
Unit
(
fun
()
->
preprocess_mode
:=
PMOnlyPreprocess
PrintUnitActions
)
,
...
...
@@ -458,3 +465,6 @@ let compare_errors =
let
update_errors
=
!
update_errors
let
on_error_reduce
nt
=
StringSet
.
mem
nt
!
on_error_reduce_symbols
src/settings.mli
View file @
b2d35f36
...
...
@@ -202,3 +202,9 @@ val compare_errors: (string * string) option
val
update_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. *)
val
on_error_reduce
:
string
->
bool
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