bundles/menhirLib/menhir-20120123/src/breadth.ml

   1 (**************************************************************************)
   2 (*                                                                        *)
   3 (*  Menhir                                                                *)
   4 (*                                                                        *)
   5 (*  François Pottier, INRIA Rocquencourt                                  *)
   6 (*  Yann Régis-Gianas, PPS, Université Paris Diderot                      *)
   7 (*                                                                        *)
   8 (*  Copyright 2005-2008 Institut National de Recherche en Informatique    *)
   9 (*  et en Automatique. All rights reserved. This file is distributed      *)
  10 (*  under the terms of the Q Public License version 1.0, with the change  *)
  11 (*  described in file LICENSE.                                            *)
  12 (*                                                                        *)
  13 (**************************************************************************)
  14
  15 (* This module implements generic breadth-first search
  16    over a graph with labeled edges. *)
  17
  18 module Make (G : sig
  19
  20   (* This is the type of graph vertices. *)
  21
  22   type vertex
  23
  24   (* This is the type of graph labels. *)
  25
  26   type label
  27
  28   (* These allow marking a vertex and checking whether
  29      it is marked. *)
  30
  31   val set_mark: vertex -> Mark.t -> unit
  32   val get_mark: vertex -> Mark.t
  33
  34   (* This is an iterator over the graph's entry vertices. *)
  35
  36   val entry: (vertex -> unit) -> unit
  37
  38   (* This provides access to a vertex' successors. *)
  39
  40   val successors: (label -> vertex -> unit) -> vertex -> unit
  41
  42 end) = struct
  43
  44   let search f =
  45
  46     let queue : G.vertex Queue.t =
  47       Queue.create ()
  48
  49     and mark =
  50       Mark.fresh()
  51
  52     in
  53
  54     let visited vertex =
  55       Mark.same mark (G.get_mark vertex)
  56
  57     and visit vertex =
  58       G.set_mark vertex mark;
  59       Queue.add vertex queue
  60
  61     in
  62
  63     G.entry visit;
  64     Misc.qiter (fun vertex ->
  65       G.successors (fun label son ->
  66         if not (visited son) then begin
  67           visit son;
  68           f true vertex label son
  69         end
  70         else
  71           f false vertex label son
  72       ) vertex
  73     ) queue
  74
  75 end
  76