Add the module [Lr1.BackwardEdges]. Remove the function [Lr1.reverse_dfs].

src/lr1.ml

@@ -763,31 +763,6 @@ let () =
     Time.tick "Dumping the LR(1) automaton"
   end
 
-(* ------------------------------------------------------------------------ *)
-(* [reverse_dfs goal] performs a reverse depth-first search through
-   the automaton, starting at node [goal], and marking the nodes
-   traversed. It returns a function that tells whether a node is
-   marked, that is, whether a path leads from that node to the goal
-   node. *)
-
-let reverse_dfs goal =
-
-  let mark = Mark.fresh() in
-
-  let marked node =
-    Mark.same node.mark mark
-  in
-
-  let rec visit node =
-     if not (marked node) then begin
-       node.mark <- mark;
-       List.iter visit node.predecessors
-     end
-  in
-
-  visit goal;
-  marked
-
 (* ------------------------------------------------------------------------ *)
 (* Iterating over all nodes that are targets of edges carrying a
    certain symbol. The sources of the corresponding edges are also
@@ -833,6 +808,13 @@ let conflicts f =
 let predecessors node =
   node.predecessors
 
+module BackwardEdges = struct
+  type nonrec node = node
+  type label = unit
+  let foreach_outgoing_edge node f =
+    List.iter (fun node -> f () node) (predecessors node)
+end
+
 (* ------------------------------------------------------------------------ *)
 
 (* This inverts a mapping of tokens to productions into a mapping of

src/lr1.mli

@@ -80,6 +80,14 @@ val incoming_symbol: node -> Symbol.t option
 
 val predecessors: node -> node list
 
+(* A view of the backward (reverse) edges as a graph. *)
+
+module BackwardEdges : sig
+  type nonrec node = node
+  type label = unit
+  val foreach_outgoing_edge: node -> (label -> node -> unit) -> unit
+end
+
 (* This provides access to a node's transitions and reductions. *)
 
 val transitions: node -> node SymbolMap.t
@@ -136,14 +144,6 @@ val targets: ('a -> node list -> node -> 'a) -> 'a -> Symbol.t -> 'a
 
 val conflicts: (TerminalSet.t -> node -> unit) -> unit
 
-(* [reverse_dfs goal] performs a reverse depth-first search through
-   the automaton, starting at node [goal], and marking the nodes
-   traversed. It returns a function that tells whether a node is
-   marked, that is, whether a path leads from that node to the goal
-   node. *)
-
-val reverse_dfs: node -> (node -> bool)
-
 (* ------------------------------------------------------------------------- *)
 (* Modifications of the automaton. *)
 

src/lr1partial.ml

@@ -33,8 +33,19 @@ end) = struct
      show that this can involve one tenth to one half of all nodes.
      This optimization seems minor, but is easy to implement. *)
 
-  let relevant =
-    Lr1.reverse_dfs X.goal
+  let relevant : Lr1.node -> bool =
+    let module G = struct
+      include Lr1.BackwardEdges
+      let foreach_root f =
+        f X.goal
+    end in
+    let module M = DFS.MarkArray(Lr1) in
+    let module D = struct
+      let discover _node = ()
+      let traverse _source _label _target = ()
+    end in
+    let module R = DFS.Run(G)(M)(D) in
+    M.is_marked
 
   (* Second, all of the states that we shall consider are restricted
      to the set of tokens of interest. This is an important idea: by
@@ -222,4 +233,3 @@ end) = struct
     Lr0.export goal.state
 
 end
-