diff options
| author | Alasdair Armstrong | 2018-08-16 17:22:32 +0100 |
|---|---|---|
| committer | Alasdair Armstrong | 2018-08-16 17:22:32 +0100 |
| commit | eee4d26e53a5e33cdb71e9a338154e2dbf18830c (patch) | |
| tree | b63a93ec9052f78dd586857cc31bd46d7401d14e /src/graph.ml | |
| parent | d00c376141c62975880a1565931296a257fce97d (diff) | |
Use Set rather than Hashtbl in graph.ml
Removes the need for the node type to have a valid Hash function
Diffstat (limited to 'src/graph.ml')
| -rw-r--r-- | src/graph.ml | 22 |
1 files changed, 15 insertions, 7 deletions
diff --git a/src/graph.ml b/src/graph.ml index c08823cf..2fc09014 100644 --- a/src/graph.ml +++ b/src/graph.ml @@ -59,7 +59,7 @@ module type S = type node type graph type node_set - + val leaves : graph -> node_set val empty : graph @@ -69,6 +69,8 @@ module type S = val add_edge : node -> node -> graph -> graph val add_edges : node -> node list -> graph -> graph + val children : graph -> node -> node list + (** Return the set of nodes that are reachable from the first set of nodes (roots), without passing through the second set of nodes (cuts). *) @@ -102,10 +104,16 @@ module Make(Ord: OrderedType) = struct type node_set = NS.t let empty = NM.empty - + let leaves cg = List.fold_left (fun acc (fn, callees) -> NS.filter (fun callee -> callee <> fn) (NS.union acc callees)) NS.empty (NM.bindings cg) + let children cg caller = + try + NS.elements (NM.find caller cg) + with + | Not_found -> [] + let fix_leaves cg = NS.fold (fun leaf cg -> if NM.mem leaf cg then cg else NM.add leaf NS.empty cg) (leaves cg) cg @@ -122,7 +130,7 @@ module Make(Ord: OrderedType) = struct fix_leaves (NM.add caller (NS.union callees (NM.find caller cg)) cg) with | Not_found -> fix_leaves (NM.add caller callees cg) - + let reachable roots cuts cg = let visited = ref NS.empty in @@ -164,16 +172,16 @@ module Make(Ord: OrderedType) = struct reverse up let topsort cg = - let marked = Hashtbl.create (NM.cardinal cg) in + let marked = ref NS.empty in let temp_marked = ref NS.empty in let list = ref [] in let keys = NM.bindings cg |> List.map fst in - let find_unmarked keys = List.find (fun node -> not (Hashtbl.mem marked node)) keys in + let find_unmarked keys = List.find (fun node -> not (NS.mem node !marked)) keys in let rec visit node = if NS.mem node !temp_marked then raise (let lcg = prune_loop node cg in Not_a_DAG (node, lcg)) - else if Hashtbl.mem marked node + else if NS.mem node !marked then () else begin @@ -183,7 +191,7 @@ module Make(Ord: OrderedType) = struct in temp_marked := NS.add node !temp_marked; NS.iter (fun child -> visit child) children; - Hashtbl.add marked node (); + marked := NS.add node !marked; temp_marked := NS.remove node !temp_marked; list := node :: !list end |
