Attention une mise à jour du service Gitlab va être effectuée le mardi 18 janvier (et non lundi 17 comme annoncé précédemment) entre 18h00 et 18h30. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes.

Commit dbc713c5 authored by POTTIER Francois's avatar POTTIER Francois
Browse files

Reorganized the construction of the internal table [Lr1.incoming].

parent d8ab9093
......@@ -419,6 +419,26 @@ let n =
let () =
Error.logA 1 (fun f -> Printf.fprintf f "Built an LR(1) automaton with %d states.\n" !num)
(* ------------------------------------------------------------------------ *)
(* A mapping of symbols to lists of nodes that admit this incoming
symbol. This mapping is constructed by [visit] below. *)
let incoming : node list SymbolMap.t ref =
ref SymbolMap.empty
let lookup_incoming symbol =
try
SymbolMap.find symbol !incoming
with Not_found ->
[]
let record_incoming osymbol target =
Option.iter (fun symbol ->
let targets = lookup_incoming symbol in
incoming := SymbolMap.add symbol (target :: targets) !incoming
) osymbol
(* ------------------------------------------------------------------------ *)
(* We now perform one depth-first traversal of the automaton,
recording predecessor edges, numbering nodes, sorting nodes
......@@ -454,22 +474,17 @@ let reduce_reduce =
let silently_solved =
ref 0
(* A mapping of symbols to lists of nodes that admit this incoming
symbol. *)
let incoming : node list SymbolMap.t ref =
ref SymbolMap.empty
(* Go ahead. *)
let () =
let marked = Mark.fresh() in
let rec visit node =
let rec visit osymbol node =
if not (Mark.same node.mark marked) then begin
node.mark <- marked;
nodes := node :: !nodes;
record_incoming osymbol node;
(* Number this node. *)
......@@ -649,24 +664,17 @@ let () =
begin
match son.incoming_symbol with
| None ->
son.incoming_symbol <- Some symbol;
let others =
try
SymbolMap.find symbol !incoming
with Not_found ->
[]
in
incoming := SymbolMap.add symbol (son :: others) !incoming
son.incoming_symbol <- Some symbol
| Some symbol' ->
assert (Symbol.equal symbol symbol')
end;
son.predecessors <- node :: son.predecessors;
visit son
visit (Some symbol) son
) node.transitions
end
in
ProductionMap.iter (fun _ node -> visit node) entry
ProductionMap.iter (fun _ node -> visit None node) entry
let nodes =
List.rev !nodes (* list is now sorted by increasing node numbers *)
......@@ -674,9 +682,6 @@ let nodes =
let conflict_nodes =
!conflict_nodes
let incoming =
!incoming
let () =
if !silently_solved = 1 then
Error.logA 1 (fun f -> Printf.fprintf f "One shift/reduce conflict was silently solved.\n")
......@@ -803,13 +808,8 @@ let reverse_dfs goal =
provided. *)
let targets f accu symbol =
let targets =
try
SymbolMap.find symbol incoming
with Not_found ->
(* There are no incoming transitions on the start symbols. *)
[]
in
(* There are no incoming transitions on the start symbols. *)
let targets = lookup_incoming symbol in
List.fold_left (fun accu target ->
f accu target.predecessors target
) accu targets
......
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