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