Commit 2338debe authored by POTTIER Francois's avatar POTTIER Francois

Internally assign priority levels to %on_error_reduce declarations.

For now, these levels are unused.
parent 065dc371
......@@ -96,7 +96,8 @@ declaration:
{ [ with_poss $startpos $endpos (DParameter t) ] }
| ON_ERROR_REDUCE ss = clist(strict_actual)
{ List.map (Positions.map (fun nt -> DOnErrorReduce nt))
{ let prec = ParserAux.new_on_error_reduce_level() in
List.map (Positions.map (fun nt -> DOnErrorReduce (nt, prec)))
(List.map Parameters.with_pos ss) }
/* This production recognizes tokens that are valid in the rules section,
......
......@@ -519,8 +519,10 @@ end
module OnErrorReduce : sig
(* This is the set of %on_error_reduce declarations. *)
val declarations: StringSet.t
(* 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
end
......@@ -536,5 +538,3 @@ val diagnostics: unit -> unit
(* ------------------------------------------------------------------------ *)
end (* module Make *)
......@@ -1115,7 +1115,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 _ ->
StringSet.mem (lhs prod) OnErrorReduce.declarations
StringMap.mem (lhs prod) OnErrorReduce.declarations
) productions in
(* Check if this only one such production remains. *)
match ProductionMap.is_singleton productions with
......@@ -1145,7 +1145,7 @@ let extra_reductions () =
Printf.fprintf f "Extra reductions on error were added in %d states.\n" !extra
);
(* Warn about useless %on_error_reduce declarations. *)
StringSet.iter (fun nt ->
StringMap.iter (fun nt _prec ->
if not (StringSet.mem nt !extra_nts) then
Error.grammar_warning []
"the declaration %%on_error_reduce %s is never useful." nt
......
......@@ -623,18 +623,18 @@ let expand p_grammar =
in
(* Process %on_error_reduce declarations. *)
let rec on_error_reduce_from_list (ps : Syntax.parameter list) : StringSet.t =
let rec on_error_reduce_from_list (ps : (Syntax.parameter * 'p) list) : 'p StringMap.t =
match ps with
| [] ->
StringSet.empty
| nt :: ps ->
StringMap.empty
| (nt, prec) :: ps ->
let accu = on_error_reduce_from_list ps in
let mangled = mangle nt in
if StringSet.mem mangled accu then
if StringMap.mem mangled accu then
Error.error [Parameters.position nt]
"there are multiple %%on_error_reduce declarations for nonterminal %s."
mangled;
StringSet.add mangled accu
StringMap.add mangled prec accu
in
let start_symbols = StringMap.domain (p_grammar.p_start_symbols) in
......
......@@ -13,6 +13,11 @@ let new_production_level =
incr c;
ProductionLevel (Error.get_filemark (), !c)
let new_on_error_reduce_level =
new_production_level
(* the counter is shared with [new_production_level],
but this is irrelevant *)
module IdSet = Set.Make (struct
type t = identifier located
let compare id1 id2 =
......
......@@ -24,6 +24,11 @@ val new_precedence_level: Lexing.position -> Lexing.position -> precedence_level
val new_production_level: unit -> branch_production_level
(* [new_on_error_reduce_level()] creates a new level, which is attached to an
[%on_error_reduce] declaration. *)
val new_on_error_reduce_level: unit -> on_error_reduce_level
(* [check_production_group] accepts a production group and checks that all
productions in the group define the same set of identifiers. *)
......
......@@ -83,9 +83,9 @@ let join_declaration filename (grammar : grammar) decl =
(* Reductions on error for nonterminals. *)
| DOnErrorReduce (nonterminal) ->
| DOnErrorReduce (nonterminal, prec) ->
{ grammar with
p_on_error_reduce = nonterminal :: grammar.p_on_error_reduce }
p_on_error_reduce = (nonterminal, prec) :: grammar.p_on_error_reduce }
(* Token associativity and precedence. *)
......@@ -603,7 +603,7 @@ let check_parameterized_grammar_is_well_defined grammar =
) ps
in
check "%type" (List.map fst grammar.p_types);
check "%on_error_reduce" grammar.p_on_error_reduce;
check "%on_error_reduce" (List.map fst grammar.p_on_error_reduce);
(* Every reference to a symbol is well defined. *)
let reserved = [ "error" ] in
......
......@@ -88,6 +88,15 @@ type branch_production_level =
(* ------------------------------------------------------------------------ *)
(* A level is attached to every [%on_error_reduce] declaration. It is used
to decide what to do when several such declarations are applicable in a
single state. *)
type on_error_reduce_level =
branch_production_level (* we re-use the above type, to save code *)
(* ------------------------------------------------------------------------ *)
(* A parameter is either just a symbol or an application of a symbol to a
nonempty tuple of parameters. Before anonymous rules have been eliminated,
it can also be an anonymous rule, represented as a list of branches. *)
......@@ -167,7 +176,7 @@ type declaration =
(* On-error-reduce declaration. *)
| DOnErrorReduce of parameter
| DOnErrorReduce of parameter * on_error_reduce_level
(* ------------------------------------------------------------------------ *)
......@@ -201,6 +210,6 @@ type grammar =
p_start_symbols : Positions.t StringMap.t;
p_types : (parameter * Stretch.ocamltype Positions.located) list;
p_tokens : token_properties StringMap.t;
p_on_error_reduce : parameter list;
p_on_error_reduce : (parameter * on_error_reduce_level) list;
p_rules : parameterized_rule StringMap.t;
}
......@@ -40,7 +40,7 @@ type grammar =
parameters : Stretch.t list;
start_symbols : StringSet.t;
types : Stretch.ocamltype StringMap.t;
on_error_reduce : StringSet.t;
on_error_reduce : on_error_reduce_level StringMap.t;
tokens : Syntax.token_properties StringMap.t;
rules : rule StringMap.t;
}
......@@ -87,4 +87,3 @@ let ocamltype_of_start_symbol grammar symbol : Stretch.ocamltype =
with Not_found ->
(* Every start symbol should have a type. *)
assert false
......@@ -92,7 +92,8 @@ declaration:
{ [ unknown_pos (DParameter $2) ] }
| ON_ERROR_REDUCE actuals
{ List.map (Positions.map (fun nt -> DOnErrorReduce nt))
{ let prec = ParserAux.new_on_error_reduce_level() in
List.map (Positions.map (fun nt -> DOnErrorReduce (nt, prec)))
(List.map Parameters.with_pos $2) }
optional_ocamltype:
......
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