optional argument ~eq to CCGraph.Dot.pp

This commit is contained in:
Simon Cruanes 2015-12-31 16:18:33 +01:00
parent 4409f79ed4
commit 03a29d72cb
2 changed files with 12 additions and 8 deletions

View file

@ -519,10 +519,11 @@ module Dot = struct
let pp_list pp_x out l = let pp_list pp_x out l =
Format.pp_print_string out "["; Format.pp_print_string out "[";
List.iteri (fun i x -> List.iteri
(fun i x ->
if i > 0 then Format.fprintf out ",@;"; if i > 0 then Format.fprintf out ",@;";
pp_x out x pp_x out x)
) l; l;
Format.pp_print_string out "]" Format.pp_print_string out "]"
type vertex_state = { type vertex_state = {
@ -533,6 +534,7 @@ module Dot = struct
(** Print an enum of Full.traverse_event *) (** Print an enum of Full.traverse_event *)
let pp_seq let pp_seq
?(tbl=mk_table 128) ?(tbl=mk_table 128)
?(eq=(=))
?(attrs_v=fun _ -> []) ?(attrs_v=fun _ -> [])
?(attrs_e=fun _ -> []) ?(attrs_e=fun _ -> [])
?(name="graph") ?(name="graph")
@ -570,18 +572,18 @@ module Dot = struct
get_tag=vertex_explored; get_tag=vertex_explored;
set_tag=set_explored; (* allocate new ID *) set_tag=set_explored; (* allocate new ID *)
} in } in
let events = Traverse.Event.dfs_tag ~tags ~graph seq in let events = Traverse.Event.dfs_tag ~eq ~tags ~graph seq in
Seq.iter Seq.iter
(function (function
| `Enter (v, _n, _path) -> | `Enter (v, _n, _path) ->
let attrs = attrs_v v in let attrs = attrs_v v in
Format.fprintf out " @[<h>%a %a;@]@." pp_vertex v (pp_list pp_attr) attrs Format.fprintf out "@[<h>%a %a;@]@," pp_vertex v (pp_list pp_attr) attrs
| `Exit _ -> () | `Exit _ -> ()
| `Edge (e, _) -> | `Edge (e, _) ->
let v1 = graph.origin e in let v1 = graph.origin e in
let v2 = graph.dest e in let v2 = graph.dest e in
let attrs = attrs_e e in let attrs = attrs_e e in
Format.fprintf out " @[<h>%a -> %a %a;@]@." Format.fprintf out "@[<h>%a -> %a %a;@]@,"
pp_vertex v1 pp_vertex v2 pp_vertex v1 pp_vertex v2
(pp_list pp_attr) (pp_list pp_attr)
attrs attrs
@ -590,8 +592,8 @@ module Dot = struct
Format.fprintf out "}@]@;@?"; Format.fprintf out "}@]@;@?";
() ()
let pp ?tbl ?attrs_v ?attrs_e ?name ~graph fmt v = let pp ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt v =
pp_seq ?tbl ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v) pp_seq ?tbl ?eq ?attrs_v ?attrs_e ?name ~graph fmt (Seq.return v)
let with_out filename f = let with_out filename f =
let oc = open_out filename in let oc = open_out filename in

View file

@ -307,6 +307,7 @@ module Dot : sig
(** Hidden state associated to a vertex *) (** Hidden state associated to a vertex *)
val pp : ?tbl:('v,vertex_state) table -> val pp : ?tbl:('v,vertex_state) table ->
?eq:('v -> 'v -> bool) ->
?attrs_v:('v -> attribute list) -> ?attrs_v:('v -> attribute list) ->
?attrs_e:('e -> attribute list) -> ?attrs_e:('e -> attribute list) ->
?name:string -> ?name:string ->
@ -320,6 +321,7 @@ module Dot : sig
@param name name of the graph *) @param name name of the graph *)
val pp_seq : ?tbl:('v,vertex_state) table -> val pp_seq : ?tbl:('v,vertex_state) table ->
?eq:('v -> 'v -> bool) ->
?attrs_v:('v -> attribute list) -> ?attrs_v:('v -> attribute list) ->
?attrs_e:('e -> attribute list) -> ?attrs_e:('e -> attribute list) ->
?name:string -> ?name:string ->