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
d5707d6e
Commit
d5707d6e
authored
Oct 23, 2015
by
POTTIER Francois
Browse files
Replaced the command line switch --on-error-reduce with a declaration %on_error_reduce.
parent
4b3b8c9f
Changes
16
Hide whitespace changes
Inline
Side-by-side
TODO
View file @
d5707d6e
* A %type declaration with parameters is not properly checked;
it could be useless or even ill-typed.
Same for %on_error_reduce.
* 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/fancy-parser.mly
View file @
d5707d6e
...
...
@@ -20,7 +20,7 @@ open Positions
/*
Tokens
.
*/
%
token
TOKEN
TYPE
LEFT
RIGHT
NONASSOC
START
PREC
PUBLIC
COLON
BAR
EOF
EQUAL
%
token
INLINE
LPAREN
RPAREN
COMMA
QUESTION
STAR
PLUS
PARAMETER
%
token
INLINE
LPAREN
RPAREN
COMMA
QUESTION
STAR
PLUS
PARAMETER
ON_ERROR_REDUCE
%
token
<
string
Positions
.
located
>
LID
UID
%
token
<
Stretch
.
t
>
HEADER
%
token
<
Stretch
.
ocamltype
>
OCAMLTYPE
...
...
@@ -96,6 +96,10 @@ declaration:
|
PARAMETER
t
=
OCAMLTYPE
{
[
with_poss
$
startpos
$
endpos
(
DParameter
t
)
]
}
|
ON_ERROR_REDUCE
ss
=
clist
(
strict_actual
)
{
List
.
map
(
Positions
.
map
(
fun
nt
->
DOnErrorReduce
nt
))
(
List
.
map
Parameters
.
with_pos
ss
)
}
/*
This
production
recognizes
tokens
that
are
valid
in
the
rules
section
,
but
not
in
the
declarations
section
.
This
is
a
hint
that
a
%%
was
forgotten
.
*/
...
...
src/grammar.ml
View file @
d5707d6e
...
...
@@ -1559,3 +1559,13 @@ let diagnostics () =
TokPrecedence
.
diagnostics
()
;
Production
.
diagnostics
()
(* ------------------------------------------------------------------------ *)
(* %on_error_reduce declarations. *)
module
OnErrorReduce
=
struct
let
declarations
=
Front
.
grammar
.
on_error_reduce
end
src/grammar.mli
View file @
d5707d6e
...
...
@@ -497,6 +497,16 @@ module Precedence : sig
end
(* ------------------------------------------------------------------------ *)
(* %on_error_reduce declarations. *)
module
OnErrorReduce
:
sig
(* This is the set of %on_error_reduce declarations. *)
val
declarations
:
StringSet
.
t
end
(* ------------------------------------------------------------------------ *)
(* Diagnostics. *)
...
...
src/internalSyntax.mli
View file @
d5707d6e
...
...
@@ -7,4 +7,5 @@ type grammar =
p_types
:
(
Syntax
.
parameter
*
Stretch
.
ocamltype
Positions
.
located
)
list
;
p_tokens
:
Syntax
.
token_properties
StringMap
.
t
;
p_rules
:
Syntax
.
parameterized_rule
StringMap
.
t
;
p_on_error_reduce
:
Syntax
.
parameter
list
;
}
src/lexer.mll
View file @
d5707d6e
...
...
@@ -305,6 +305,8 @@ rule main = parse
{
PARAMETER
}
|
"%inline"
{
INLINE
}
|
"%on_error_reduce"
{
ON_ERROR_REDUCE
}
|
"%%"
{
(* The token [PERCENTPERCENT] carries a stretch that contains
everything that follows %% in the input file. This string
...
...
src/lr1.ml
View file @
d5707d6e
...
...
@@ -1058,7 +1058,7 @@ let default_conflict_resolution () =
(* Extra reductions. 2015/10/19 *)
(* If a state can reduce one production whose left-hand symbol has been marked
[
--
on
-
error
-
reduce], and only one such production, then every error action
[
%
on
_
error
_
reduce], and only one such production, 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. *)
...
...
@@ -1066,7 +1066,7 @@ let default_conflict_resolution () =
(* The above is the lax interpretation of the criterion. In a stricter
interpretation, one could require the state to be able to reduce only
one production, and furthermore require this production to be marked.
In practice, the lax interpretation makes [
--
on
-
error
-
reduce] more
In practice, the lax interpretation makes [
%
on
_
error
_
reduce] more
powerful, and this extra power seems useful. *)
(* The code below looks like the decision on a default reduction in
...
...
@@ -1099,9 +1099,9 @@ let extra_reductions () =
(* Compute the productions which this node can reduce. *)
let
productions
=
invert
(
reductions
node
)
in
(* Keep only those whose left-hand symbol is marked [
--
on
-
error
-
reduce]. *)
(* Keep only those whose left-hand symbol is marked [
%
on
_
error
_
reduce]. *)
let
productions
=
ProductionMap
.
filter
(
fun
prod
_
->
StringSet
.
mem
(
lhs
prod
)
Settings
.
on_e
rror
_r
educe
StringSet
.
mem
(
lhs
prod
)
OnE
rror
R
educe
.
declarations
)
productions
in
(* Check if this only one such production remains. *)
match
ProductionMap
.
is_singleton
productions
with
...
...
@@ -1130,12 +1130,12 @@ let extra_reductions () =
Error
.
logA
1
(
fun
f
->
Printf
.
fprintf
f
"Extra reductions on error were added in %d states.
\n
"
!
extra
);
(* Warn
ing
about useless
--
on
-
error
-
reduce
switche
s. *)
(* Warn about useless
%
on
_
error
_
reduce
declaration
s. *)
StringSet
.
iter
(
fun
nt
->
if
not
(
StringSet
.
mem
nt
!
extra_nts
)
then
Error
.
grammar_warning
[]
(
Printf
.
sprintf
"the
command line op
tion
--
on
-
error
-
reduce %s is never useful."
nt
)
)
Settings
.
on_e
rror
_r
educe
(
Printf
.
sprintf
"the
declara
tion
%%
on
_
error
_
reduce %s is never useful."
nt
)
)
OnE
rror
R
educe
.
declarations
(* ------------------------------------------------------------------------ *)
(* Define [fold_entry], which in some cases facilitates the use of [entry]. *)
...
...
src/lr1.mli
View file @
d5707d6e
...
...
@@ -143,13 +143,13 @@ 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]. *)
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
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. *)
...
...
src/parameterizedGrammar.ml
View file @
d5707d6e
...
...
@@ -589,7 +589,12 @@ let expand p_grammar =
Expansion is not needed. *)
with
Not_found
->
Positions
.
value
sym
in
let
rec
types_from_list
=
function
(* Process %type declarations. *)
let
rec
types_from_list
(
ps
:
(
Syntax
.
parameter
*
'
a
Positions
.
located
)
list
)
:
'
a
StringMap
.
t
=
match
ps
with
|
[]
->
StringMap
.
empty
|
(
nt
,
ty
)
::
q
->
let
accu
=
types_from_list
q
in
...
...
@@ -597,11 +602,27 @@ let expand p_grammar =
if
StringMap
.
mem
mangled
accu
then
Error
.
error
[
Positions
.
position
(
Parameters
.
with_pos
nt
)]
(
Printf
.
sprintf
"There are multiple %%type de
fini
tions for nonterminal %s."
"There are multiple %%type de
clara
tions for nonterminal %s."
mangled
);
StringMap
.
add
mangled
(
Positions
.
value
ty
)
accu
in
(* Process %on_error_reduce declarations. *)
let
rec
on_error_reduce_from_list
(
ps
:
Syntax
.
parameter
list
)
:
StringSet
.
t
=
match
ps
with
|
[]
->
StringSet
.
empty
|
nt
::
ps
->
let
accu
=
on_error_reduce_from_list
ps
in
let
mangled
=
mangle
nt
in
if
StringSet
.
mem
mangled
accu
then
Error
.
error
[
Positions
.
position
(
Parameters
.
with_pos
nt
)]
(
Printf
.
sprintf
"There are multiple %%on_error_reduce declarations for nonterminal %s."
mangled
);
StringSet
.
add
mangled
accu
in
let
start_symbols
=
StringMap
.
domain
(
p_grammar
.
p_start_symbols
)
in
{
preludes
=
p_grammar
.
p_preludes
;
...
...
@@ -609,6 +630,7 @@ let expand p_grammar =
parameters
=
p_grammar
.
p_parameters
;
start_symbols
=
start_symbols
;
types
=
types_from_list
p_grammar
.
p_types
;
on_error_reduce
=
on_error_reduce_from_list
p_grammar
.
p_on_error_reduce
;
tokens
=
p_grammar
.
p_tokens
;
rules
=
let
closed_rules
=
StringMap
.
fold
...
...
src/parserMessages.messages
View file @
d5707d6e
...
...
@@ -20,12 +20,19 @@ grammar: TYPE OCAMLTYPE UID COMMA TYPE
grammar: TYPE OCAMLTYPE UID LPAREN UID UID
grammar: TYPE OCAMLTYPE UID LPAREN UID COMMA TYPE
grammar: TYPE OCAMLTYPE UID PLUS RPAREN
grammar: ON_ERROR_REDUCE TYPE
Ill-formed %type declaration.
# %type<ocamltype> and %on_error_reduce are both followed with clist(strict_actual),
# so they are not distinguished in the automaton.
Ill-formed declaration.
Examples of well-formed declarations:
%type <Syntax.expression> expression
%type <int> date time
%type <int option> option(date)
%on_error_reduce expression
%on_error_reduce date time
%on_error_reduce option(date)
# ----------------------------------------------------------------------------
...
...
src/partialGrammar.ml
View file @
d5707d6e
...
...
@@ -84,6 +84,12 @@ let join_declaration filename (grammar : grammar) decl =
{
grammar
with
p_types
=
(
nonterminal
,
with_pos
(
position
decl
)
ocamltype
)
::
grammar
.
p_types
}
(* Reductions on error for nonterminals. *)
|
DOnErrorReduce
(
nonterminal
)
->
{
grammar
with
p_on_error_reduce
=
nonterminal
::
grammar
.
p_on_error_reduce
}
(* Token associativity and precedence. *)
|
DTokenProperties
(
terminal
,
assoc
,
prec
)
->
...
...
@@ -571,7 +577,8 @@ let empty_grammar =
p_start_symbols
=
StringMap
.
empty
;
p_types
=
[]
;
p_tokens
=
StringMap
.
empty
;
p_rules
=
StringMap
.
empty
p_rules
=
StringMap
.
empty
;
p_on_error_reduce
=
[]
;
}
let
join
grammar
pgrammar
=
...
...
@@ -618,14 +625,22 @@ let check_parameterized_grammar_is_well_defined grammar =
|
ParameterApp
(
id
,
_
)
->
id
in
List
.
iter
(
fun
(
symbol
,
_
)
->
let
head_symb
=
parameter_head_symb
symbol
in
if
not
(
StringMap
.
mem
(
value
head_symb
)
grammar
.
p_rules
)
then
Error
.
errorp
(
Parameters
.
with_pos
symbol
)
(
Printf
.
sprintf
"this is a terminal symbol.
\n
\
%%type declarations are applicable only to nonterminal symbols."
))
grammar
.
p_types
;
(* Every %type definition has, at its head, a nonterminal symbol. *)
(* Same check for %on_error_reduce definitions. *)
(* Apparently we do not check the parameters at this point. Maybe this is
done later, or not at all. *)
let
check
(
kind
:
string
)
(
ps
:
Syntax
.
parameter
list
)
=
List
.
iter
(
fun
p
->
let
head_symb
=
parameter_head_symb
p
in
if
not
(
StringMap
.
mem
(
value
head_symb
)
grammar
.
p_rules
)
then
Error
.
errorp
(
Parameters
.
with_pos
p
)
(
Printf
.
sprintf
"this should be a nonterminal symbol.
\n
\
%s declarations are applicable only to nonterminal symbols."
kind
)
)
ps
in
check
"%type"
(
List
.
map
fst
grammar
.
p_types
);
check
"%on_error_reduce"
grammar
.
p_on_error_reduce
;
(* Every reference to a symbol is well defined. *)
let
reserved
=
[
"error"
]
in
...
...
src/settings.ml
View file @
d5707d6e
...
...
@@ -197,12 +197,6 @@ let echo_errors =
let
set_echo_errors
filename
=
echo_errors
:=
Some
filename
let
on_error_reduce
=
ref
StringSet
.
empty
let
on_error_reduce_symbol
nt
=
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)"
;
"--canonical"
,
Arg
.
Unit
(
fun
()
->
construction_mode
:=
ModeCanonical
)
,
" Construct a canonical Knuth LR(1) automaton"
;
...
...
@@ -238,7 +232,6 @@ 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
)
,
...
...
@@ -475,6 +468,3 @@ let update_errors =
let
echo_errors
=
!
echo_errors
let
on_error_reduce
=
!
on_error_reduce
src/settings.mli
View file @
d5707d6e
...
...
@@ -208,9 +208,3 @@ val update_errors: string option
val
echo_errors
:
string
option
(* This is the set of non-terminal symbols 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
:
StringSet
.
t
src/syntax.mli
View file @
d5707d6e
...
...
@@ -85,6 +85,10 @@ type declaration =
|
DType
of
Stretch
.
ocamltype
*
parameter
(* On-error-reduce declaration. *)
|
DOnErrorReduce
of
parameter
(* A [%prec] annotation is optional. A production can carry at most one.
If there is one, it is a symbol name. See [ParserAux]. *)
...
...
src/unparameterizedSyntax.ml
View file @
d5707d6e
...
...
@@ -40,6 +40,7 @@ type grammar =
parameters
:
Stretch
.
t
list
;
start_symbols
:
StringSet
.
t
;
types
:
Stretch
.
ocamltype
StringMap
.
t
;
on_error_reduce
:
StringSet
.
t
;
tokens
:
Syntax
.
token_properties
StringMap
.
t
;
rules
:
rule
StringMap
.
t
;
}
...
...
src/yacc-parser.mly
View file @
d5707d6e
...
...
@@ -14,7 +14,7 @@ open Positions
%
}
%
token
TOKEN
TYPE
LEFT
RIGHT
NONASSOC
START
PREC
PUBLIC
COLON
BAR
EOF
EQUAL
%
token
INLINE
LPAREN
RPAREN
COMMA
QUESTION
STAR
PLUS
PARAMETER
%
token
INLINE
LPAREN
RPAREN
COMMA
QUESTION
STAR
PLUS
PARAMETER
ON_ERROR_REDUCE
%
token
<
string
Positions
.
located
>
LID
UID
%
token
<
Stretch
.
t
>
HEADER
%
token
<
Stretch
.
ocamltype
>
OCAMLTYPE
...
...
@@ -92,6 +92,10 @@ declaration:
|
PARAMETER
OCAMLTYPE
{
[
unknown_pos
(
DParameter
$
2
)
]
}
|
ON_ERROR_REDUCE
actuals
{
List
.
map
(
Positions
.
map
(
fun
nt
->
DOnErrorReduce
nt
))
(
List
.
map
Parameters
.
with_pos
$
2
)
}
optional_ocamltype
:
/*
epsilon
*/
{
None
}
...
...
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