Commit 737d3a4c authored by POTTIER Francois's avatar POTTIER Francois

More abstraction in the signature of [Grammar.OnErrorReduce].

New function [Grammar.OnErrorReduce.compare], unused for now.
parent 2338debe
......@@ -1464,12 +1464,60 @@ let diagnostics () =
module OnErrorReduce = struct
let declarations =
(* We keep a [StringMap] internally, and convert back and forth between
the types [Nonterminal.t] and [string] when querying this map. This
is not very elegant, and could be changed if desired. *)
let declarations : Syntax.on_error_reduce_level StringMap.t =
grammar.on_error_reduce
let print (nt : Nonterminal.t) : string =
Nonterminal.print false nt
let lookup (nt : string) : Nonterminal.t =
try
Nonterminal.lookup nt
with Not_found ->
(* If this fails, then we have an [%on_error_reduce] declaration
for an invalid symbol. *)
assert false
let reduce prod =
let nt = Production.nt prod in
StringMap.mem (print nt) declarations
let iter f =
StringMap.iter (fun nt _prec ->
f (lookup nt)
) declarations
open Precedence
let compare nt1 nt2 =
let prec1, prec2 =
try
StringMap.find (print nt1) declarations,
StringMap.find (print nt2) declarations
with Not_found ->
(* [compare] should be used to compare two symbols for which
there exist [%on_error_reduce] declarations. *)
assert false
in
match production_order prec1 prec2 with
| Gt ->
(* [prec1] is a higher integer than [prec2], therefore comes later
in the file. By analogy with [%left] and friends, we give higher
priority to later declarations. *)
Some nt1
| Lt ->
Some nt2
| Eq
| Ic ->
(* We could issue a warning or an information message in these cases. *)
None
end
(* ------------------------------------------------------------------------ *)
end (* module Make *)
......@@ -515,14 +515,28 @@ module Precedence : sig
end
(* ------------------------------------------------------------------------ *)
(* %on_error_reduce declarations. *)
(* [%on_error_reduce] declarations. *)
module OnErrorReduce : sig
(* This is the set of %on_error_reduce declarations. Each declaration
carries a level, which is used when several declarations are
applicable in a single state. *)
val declarations: Syntax.on_error_reduce_level StringMap.t
(* [reduce prod] tells whether the left-hand side of [prod] (a nonterminal
symbol) appears in an [%on_error_reduce] declaration. *)
val reduce: Production.index -> bool
(* [iter f] applies the function [f] in turn, in an arbitrary order, to
every nonterminal symbol that appears in an [%on_error_reduce]
declaration. *)
val iter: (Nonterminal.t -> unit) -> unit
(* When two [%on_error_reduce] declarations are applicable in a single
state, they can be compared, using [compare], to test if one of them
takes precedence over the other. This is a partial order; two symbols may
be incomparable (either because they appear one the same line, or because
they originate in different files). *)
val compare: Nonterminal.t -> Nonterminal.t -> Nonterminal.t option
end
......
......@@ -1100,10 +1100,7 @@ let extra =
(* 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)
ref NonterminalSet.empty
let extra_reductions () =
iter (fun node ->
......@@ -1115,7 +1112,7 @@ 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 _ ->
StringMap.mem (lhs prod) OnErrorReduce.declarations
OnErrorReduce.reduce prod
) productions in
(* Check if this only one such production remains. *)
match ProductionMap.is_singleton productions with
......@@ -1128,7 +1125,7 @@ let extra_reductions () =
with a reduction, update [extra] and [extra_nts]. *)
let triggered = lazy (
incr extra;
extra_nts := StringSet.add (lhs prod) !extra_nts
extra_nts := NonterminalSet.add (Production.nt prod) !extra_nts
) in
Terminal.iter_real (fun tok ->
if not (TerminalSet.mem tok acceptable) then begin
......@@ -1145,11 +1142,12 @@ let extra_reductions () =
Printf.fprintf f "Extra reductions on error were added in %d states.\n" !extra
);
(* Warn about useless %on_error_reduce declarations. *)
StringMap.iter (fun nt _prec ->
if not (StringSet.mem nt !extra_nts) then
OnErrorReduce.iter (fun nt ->
if not (NonterminalSet.mem nt !extra_nts) then
Error.grammar_warning []
"the declaration %%on_error_reduce %s is never useful." nt
) OnErrorReduce.declarations
"the declaration %%on_error_reduce %s is never useful."
(Nonterminal.print false nt)
)
(* ------------------------------------------------------------------------ *)
(* Define [fold_entry], which in some cases facilitates the use of [entry]. *)
......
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