some signature changes in CCGraph

src/data/CCGraph.ml

@@ -158,6 +158,8 @@ let mk_heap ~leq =
 (** {2 Traversals} *)
 
 module Traverse = struct
+  type 'e path = 'e list
+
   let generic_tag ~tags ~bag ~graph seq =
     let first = ref true in
     fun k ->
@@ -190,16 +192,16 @@ module Traverse = struct
 
   let dijkstra_tag ?(dist=fun _ -> 1) ~tags ~graph seq =
     let tags' = {
-      get_tag=(fun (v,_) -> tags.get_tag v);
+      get_tag=(fun (v,_,_) -> tags.get_tag v);
-      set_tag=(fun (v,_) -> tags.set_tag v);
+      set_tag=(fun (v,_,_) -> tags.set_tag v);
     }
-    and seq' = Seq.map (fun v -> v, 0) seq
+    and seq' = Seq.map (fun v -> v, 0, []) seq
     and graph' = {
-      children=(fun (v,d) -> Seq.map (fun e -> e, d) (graph.children v));
+      children=(fun (v,d,p) -> Seq.map (fun e -> e, d, p) (graph.children v));
-      origin=(fun (e, d) -> graph.origin e, d);
+      origin=(fun (e, d, p) -> graph.origin e, d, p);
-      dest=(fun (e, d) -> graph.dest e, d + dist e);
+      dest=(fun (e, d, p) -> graph.dest e, d + dist e, e :: p);
     } in
-    let bag = mk_heap ~leq:(fun (_, d1) (_, d2) -> d1 <= d2) in
+    let bag = mk_heap ~leq:(fun (_,d1,_) (_,d2,_) -> d1 <= d2) in
     generic_tag ~tags:tags' ~bag ~graph:graph' seq'
 
   let dijkstra ?(tbl=mk_table 128) ?dist ~graph seq =
@@ -218,8 +220,6 @@ module Traverse = struct
   module Event = struct
     type edge_kind = [`Forward | `Back | `Cross ]
 
-    type 'e path = 'e list
-
     (** A traversal is a sequence of such events *)
     type ('v,'e) t =
       [ `Enter of 'v * int * 'e path  (* unique index in traversal, path from start *)
@@ -360,16 +360,16 @@ module LazyTree = struct
         (Lazy.force l)
 end
 
-let spanning_tree ?(tbl=mk_table 128) ~graph v =
+let spanning_tree_tag ~tags ~graph v =
   let rec mk_node v =
     let children = lazy (
       Seq.fold
         (fun acc e ->
            let v' = graph.dest e in
-           if tbl.mem v'
+           if tags.get_tag v'
            then acc
            else (
-             tbl.add v' ();
+             tags.set_tag v';
              (e, mk_node v') :: acc
            )
         ) [] (graph.children v)
@@ -379,6 +379,13 @@ let spanning_tree ?(tbl=mk_table 128) ~graph v =
   in
   mk_node v
 
+let spanning_tree ?(tbl=mk_table 128) ~graph v =
+  let tags = {
+    get_tag=tbl.mem;
+    set_tag=(fun v -> tbl.add v ());
+  } in
+  spanning_tree_tag ~tags ~graph v
+
 (** {2 Strongly Connected Components} *)
 
 module SCC = struct

src/data/CCGraph.mli

@@ -24,7 +24,9 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
-(** {1 Simple Graph Interface} *)
+(** {1 Simple Graph Interface}
+
+    @since NEXT_RELEASE *)
 
 type 'a sequence = ('a -> unit) -> unit
 (** A sequence of items of type ['a], possibly infinite *)
@@ -98,6 +100,8 @@ val mk_heap: leq:('a -> 'a -> bool) -> 'a bag
 (** {2 Traversals} *)
 
 module Traverse : sig
+  type 'e path = 'e list
+
   val generic: ?tbl:'v set ->
                 bag:'v bag ->
                 graph:('v, 'e) t ->
@@ -138,7 +142,7 @@ module Traverse : sig
                   ?dist:('e -> int) ->
                   graph:('v, 'e) t ->
                   'v sequence ->
-                  ('v * int) sequence_once
+                  ('v * int * 'e path) sequence_once
   (** Dijkstra algorithm, traverses a graph in increasing distance order.
       Yields each vertex paired with its distance to the set of initial vertices
       (the smallest distance needed to reach the node from the initial vertices)
@@ -149,14 +153,12 @@ module Traverse : sig
                       tags:'v tag_set ->
                       graph:('v, 'e) t ->
                       'v sequence ->
-                      ('v * int) sequence_once
+                      ('v * int * 'e path) sequence_once
 
   (** {2 More detailed interface} *)
   module Event : sig
     type edge_kind = [`Forward | `Back | `Cross ]
 
-    type 'e path = 'e list
-
     (** A traversal is a sequence of such events *)
     type ('v,'e) t =
       [ `Enter of 'v * int * 'e path  (* unique index in traversal, path from start *)
@@ -235,6 +237,11 @@ val spanning_tree : ?tbl:'v set ->
 (** [spanning_tree ~graph v] computes a lazy spanning tree that has [v]
     as a root. The table [tbl] is used for the memoization part *)
 
+val spanning_tree_tag : tags:'v tag_set ->
+                        graph:('v, 'e) t ->
+                        'v ->
+                        ('v, 'e) LazyTree.t
+
 (** {2 Strongly Connected Components} *)
 
 type 'v scc_state