Commit 4c65eb03 authored by POTTIER Francois's avatar POTTIER Francois

Moved [production_where] from [Invariant] to [Lr1].

parent cdced2f0
......@@ -439,7 +439,7 @@ let (shiftreduce : Production.index -> bool), shiftreducecount =
(* Check that all call sites push a stack cell and have a
default reduction. *)
Invariant.fold_reduced (fun s accu ->
Lr1.fold_reduced (fun s accu ->
accu && (match Default.has_default_reduction s with None -> false | Some _ -> true)
&& (runpushes s)
) prod true
......@@ -1665,7 +1665,7 @@ let program =
Nonterminal.foldx (fun nt defs ->
gotodef nt :: defs
) (Production.fold (fun prod defs ->
if Invariant.ever_reduced prod then
if Lr1.ever_reduced prod then
reducedef prod :: defs
else
defs
......
......@@ -236,43 +236,6 @@ let stack_states (node : Lr1.node) : StateVector.property =
| NonBottom v ->
v
(* ------------------------------------------------------------------------ *)
(* For each production, compute where (that is, in which states) this
production can be reduced. *)
let production_where : Lr1.NodeSet.t ProductionMap.t =
Lr1.fold (fun accu node ->
TerminalMap.fold (fun _ prods accu ->
let prod = Misc.single prods in
let nodes =
try
ProductionMap.lookup prod accu
with Not_found ->
Lr1.NodeSet.empty
in
ProductionMap.add prod (Lr1.NodeSet.add node nodes) accu
) (Lr1.reductions node) accu
) ProductionMap.empty
let production_where (prod : Production.index) : Lr1.NodeSet.t =
try
(* Production [prod] may be reduced at [nodes]. *)
let nodes = ProductionMap.lookup prod production_where in
assert (not (Lr1.NodeSet.is_empty nodes));
nodes
with Not_found ->
(* The production [prod] is never reduced. *)
Lr1.NodeSet.empty
let may_reduce node prod =
Lr1.NodeSet.mem node (production_where prod)
let ever_reduced prod =
not (Lr1.NodeSet.is_empty (production_where prod))
let fold_reduced f prod accu =
Lr1.NodeSet.fold f (production_where prod) accu
(* ------------------------------------------------------------------------ *)
(* Warn about productions that are never reduced. *)
......@@ -286,7 +249,7 @@ let fold_reduced f prod accu =
let () =
let count = ref 0 in
Production.iter (fun prod ->
if Lr1.NodeSet.is_empty (production_where prod) then
if Lr1.NodeSet.is_empty (Lr1.production_where prod) then
match Production.classify prod with
| Some nt ->
incr count;
......@@ -312,7 +275,7 @@ let () =
let production_states : Production.index -> StateLattice.property =
Production.tabulate (fun prod ->
let nodes = production_where prod in
let nodes = Lr1.production_where prod in
let height = Production.length prod in
Lr1.NodeSet.fold (fun node accu ->
join accu
......@@ -439,7 +402,7 @@ let () =
| Bottom ->
()
| NonBottom v ->
let sites = production_where prod in
let sites = Lr1.production_where prod in
let length = Production.length prod in
if length = 0 then
Lr1.NodeSet.iter represent sites
......
......@@ -113,22 +113,6 @@ val endp: Symbol.t -> bool
val errorpeeker: Lr1.node -> bool
(* ------------------------------------------------------------------------- *)
(* Information about which productions are reduced and where. *)
(* [may_reduce s prod] tells whether state [s] may reduce production [prod]. *)
val may_reduce: Lr1.node -> Production.index -> bool
(* [ever_reduced prod] tells whether production [prod] is ever reduced. *)
val ever_reduced: Production.index -> bool
(* [fold_reduced prod] folds over all states that can reduce
production [prod]. *)
val fold_reduced: (Lr1.node -> 'a -> 'a) -> Production.index -> 'a -> 'a
(* ------------------------------------------------------------------------- *)
(* Miscellaneous. *)
......
......@@ -934,6 +934,56 @@ let () =
if Error.errors() then
exit 1
(* ------------------------------------------------------------------------ *)
(* For each production, compute where (that is, in which states) this
production can be reduced. This computation is done AFTER default conflict
resolution (see below). It is an error to call the accessor functions
[may_reduce], [ever_reduced], [fold_reduced] before conflict resolution. *)
let production_where : NodeSet.t ProductionMap.t option ref =
ref None
let initialize_production_where () =
production_where := Some (
fold (fun accu node ->
TerminalMap.fold (fun _ prods accu ->
let prod = Misc.single prods in
let nodes =
try
ProductionMap.lookup prod accu
with Not_found ->
NodeSet.empty
in
ProductionMap.add prod (NodeSet.add node nodes) accu
) (reductions node) accu
) ProductionMap.empty
)
let production_where (prod : Production.index) : NodeSet.t =
match !production_where with
| None ->
(* It is an error to call this function before conflict resolution. *)
assert false
| Some production_where ->
try
(* Production [prod] may be reduced at [nodes]. *)
let nodes = ProductionMap.lookup prod production_where in
assert (not (NodeSet.is_empty nodes));
nodes
with Not_found ->
(* The production [prod] is never reduced. *)
NodeSet.empty
let may_reduce node prod =
NodeSet.mem node (production_where prod)
let ever_reduced prod =
not (NodeSet.is_empty (production_where prod))
let fold_reduced f prod accu =
NodeSet.fold f (production_where prod) accu
(* ------------------------------------------------------------------------ *)
(* When requested by the code generator, apply default conflict
resolution to ensure that the automaton is deterministic. *)
......@@ -1084,7 +1134,10 @@ let default_conflict_resolution () =
if !ambiguities = 1 then
Error.grammar_warning [] "one state has an end-of-stream conflict."
else if !ambiguities > 1 then
Error.grammar_warning [] "%d states have an end-of-stream conflict." !ambiguities
Error.grammar_warning [] "%d states have an end-of-stream conflict." !ambiguities;
(* We can now compute where productions are reduced. *)
initialize_production_where()
(* ------------------------------------------------------------------------ *)
(* Extra reductions. *)
......
......@@ -176,3 +176,25 @@ val default_conflict_resolution: unit -> unit
val extra_reductions: unit -> unit
(* ------------------------------------------------------------------------- *)
(* Information about which productions are reduced and where. It is an error
to call one of these functions before default conflict resolution has taken
place. *)
(* [production_where prod] is the set of all states [s] where production
[prod] might be reduced. *)
val production_where: Production.index -> NodeSet.t
(* [may_reduce s prod] tells whether state [s] may reduce production [prod]. *)
val may_reduce: node -> Production.index -> bool
(* [ever_reduced prod] tells whether production [prod] is ever reduced. *)
val ever_reduced: Production.index -> bool
(* [fold_reduced prod] folds over all states that can reduce
production [prod]. *)
val fold_reduced: (node -> 'a -> 'a) -> Production.index -> 'a -> 'a
......@@ -195,7 +195,7 @@ module T = struct
}
let may_reduce =
Invariant.may_reduce
Lr1.may_reduce
(* The logging functions that follow are called only if [log] is [true]. *)
......
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