Commit d5707d6e authored by POTTIER Francois's avatar POTTIER Francois

Replaced the command line switch --on-error-reduce with a declaration %on_error_reduce.

parent 4b3b8c9f
* 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).
......
......@@ -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. */
......
......@@ -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
......@@ -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. *)
......
......@@ -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;
}
......@@ -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
......
......@@ -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_error_reduce
StringSet.mem (lhs prod) OnErrorReduce.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
);
(* Warning about useless --on-error-reduce switches. *)
(* Warn about useless %on_error_reduce declarations. *)
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
(Printf.sprintf "the declaration %%on_error_reduce %s is never useful." nt)
) OnErrorReduce.declarations
(* ------------------------------------------------------------------------ *)
(* Define [fold_entry], which in some cases facilitates the use of [entry]. *)
......
......@@ -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. *)
......
......@@ -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 definitions for nonterminal %s."
"There are multiple %%type declarations 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
......
......@@ -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)
# ----------------------------------------------------------------------------
......
......@@ -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
......
......@@ -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
......@@ -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
......@@ -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]. *)
......
......@@ -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;
}
......
......@@ -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 }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment