diff options
| author | Alasdair Armstrong | 2019-06-04 16:37:48 +0100 |
|---|---|---|
| committer | Alasdair Armstrong | 2019-06-04 16:37:48 +0100 |
| commit | 6d3a6edcd616621eb40420cfb16a34762a32c5c1 (patch) | |
| tree | d3a753af05b4a3d40a5ce0c6eb7711770105caba /src/graph.ml | |
| parent | e24587857d1e61b428d784c699a683984c00ce36 (diff) | |
| parent | 239e13dc149af80f979ea95a3c9b42220481a0a1 (diff) | |
Merge branch 'sail2' into separate_bv
Diffstat (limited to 'src/graph.ml')
| -rw-r--r-- | src/graph.ml | 24 |
1 files changed, 8 insertions, 16 deletions
diff --git a/src/graph.ml b/src/graph.ml index 703deba9..62da3292 100644 --- a/src/graph.ml +++ b/src/graph.ml @@ -69,15 +69,6 @@ module type S = val add_edge : node -> node -> graph -> graph val add_edges : node -> node list -> graph -> graph - (** Add edges to the graph, but may leave the internal structure - of the graph in a non-normalized state. Fix leaves repairs any - such issue in the graph. These additional functions are much - faster than those above, but it is important to call fix_leaves - before calling reachable, prune, or any other function. *) - val add_edge' : node -> node -> graph -> graph - val add_edges' : node -> node list -> graph -> graph - val fix_leaves : graph -> graph - val children : graph -> node -> node list (** Return the set of nodes that are reachable from the first set @@ -125,25 +116,26 @@ module Make(Ord: OrderedType) = struct 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 + let fix_some_leaves cg nodes = + NS.fold (fun leaf cg -> if NM.mem leaf cg then cg else NM.add leaf NS.empty cg) nodes cg + + let fix_leaves cg = fix_some_leaves cg (leaves cg) - let add_edge' caller callee cg = + let add_edge caller callee cg = + let cg = fix_some_leaves cg (NS.singleton callee) in try NM.add caller (NS.add callee (NM.find caller cg)) cg with | Not_found -> NM.add caller (NS.singleton callee) cg - let add_edges' caller callees cg = + let add_edges caller callees cg = let callees = List.fold_left (fun s c -> NS.add c s) NS.empty callees in + let cg = fix_some_leaves cg callees in try NM.add caller (NS.union callees (NM.find caller cg)) cg with | Not_found -> NM.add caller callees cg - let add_edge caller callee cg = fix_leaves (add_edge' caller callee cg) - let add_edges caller callees cg = fix_leaves (add_edges' caller callees cg) - let reachable roots cuts cg = let visited = ref NS.empty in |