diff --git a/src/data/CCGraph.ml b/src/data/CCGraph.ml index 748e79d4..e96b1a27 100644 --- a/src/data/CCGraph.ml +++ b/src/data/CCGraph.ml @@ -30,6 +30,8 @@ type 'a sequence_once = 'a sequence exception Sequence_once +let (|>) x f = f x + module Seq = struct type 'a t = 'a sequence let return x k = k x @@ -44,8 +46,6 @@ module Seq = struct let to_list seq = fold (fun acc x->x::acc) [] seq |> List.rev end -let (|>) x f = f x - (** {2 Interfaces for graphs} *) (** Directed graph with vertices of type ['v] and edges of type [e'] *) @@ -594,6 +594,38 @@ module Dot = struct raise e end +(** {2 Mutable Graph} *) + +type ('v, 'e) mut_graph = < + graph: ('v, 'e) t; + add_edge: 'e -> unit; + remove : 'v -> unit; +> + +let mk_mut_tbl (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size = + let module Tbl = Hashtbl.Make(struct + type t = k + let hash = hash + let equal = eq + end) in + let tbl = Tbl.create size in + object + method graph = { + origin=(fun (x,_,_) -> x); + dest=(fun (_,_,x) -> x); + children=(fun v k -> + try List.iter k (Tbl.find tbl v) + with Not_found -> () + ); + } + method add_edge (v1,e,v2) = + let l = try Tbl.find tbl v1 with Not_found -> [] in + Tbl.replace tbl v1 ((v1,e,v2)::l) + method remove v = Tbl.remove tbl v + end + +(** {2 Misc} *) + let of_list ?(eq=(=)) l = { origin=fst; dest=snd; diff --git a/src/data/CCGraph.mli b/src/data/CCGraph.mli index 9ea4e02a..43cc4fe7 100644 --- a/src/data/CCGraph.mli +++ b/src/data/CCGraph.mli @@ -305,6 +305,20 @@ module Dot : sig (** Shortcut to open a file and write to it *) end +(** {2 Mutable Graph} *) + +type ('v, 'e) mut_graph = < + graph: ('v, 'e) t; + add_edge: 'e -> unit; + remove : 'v -> unit; +> + +val mk_mut_tbl : ?eq:('v -> 'v -> bool) -> + ?hash:('v -> int) -> + int -> + ('v, ('v * 'a * 'v)) mut_graph +(** make a new mutable graph from a Hashtbl. Edges are labelled with type ['a] *) + (** {2 Misc} *) val of_list : ?eq:('v -> 'v -> bool) -> ('v * 'v) list -> ('v, ('v * 'v)) t