Build both parents and children dependencies. 'current' -> 'opened'.

diff --git a/rpmdepsize.ml b/rpmdepsize.ml
index 47df458..9570da6 100644 (file)
--- a/rpmdepsize.ml
+++ b/rpmdepsize.ml
@@ -29,25 +29,34 @@ open Printf
 (* This corresponds to the sexpr that we write out from the
  * Python code.  OCaml will type-check it.
  *)
-type root_packages = string * packages
+type root_packages = nevra * packages
 and packages = pkg list
 and pkg = {
-  nevra : string;                      (* name-[epoch:]version-release.arch *)
+  nevra : nevra;
   name : string;
   epoch : int;
   version : string;
   release : string;
   arch : string;
   size : int64;                                (* installed size, excl. dirs *)
-  deps : string list;
+  deps : nevra list;
 }
+and nevra = string                     (* Name-[Epoch:]Version-Release.Arch *)
  with sexp
 
 (* Full dependency representation.  This is actually a graph because
- * it contains dependency loops.  'deps list' is a ref because we
- * update it as we are building it.
+ * it contains dependency loops.  The only difference from the pkg
+ * structure is that we have resolved the nevra strings into direct
+ * links, so we can quickly recurse over the tree.
+ *
+ * Parents/deps are mutable only because we want to modify these
+ * lists when creating this graph in 'create_deps'.
  *)
-type deps = Deps of pkg * deps list ref
+type deps = {
+  pkg : pkg;                   (* the package *)
+  mutable children : deps list;        (* dependencies of this package (below) *)
+  mutable parents : deps list; (* parents of this package (above) *)
+}
 
 (* Final tree representation, loops removed, and everything we want to
  * display stored in the nodes.
@@ -138,16 +147,21 @@ sys.stdout.write (\"))\")  # suppress trailing newline" in
  * StringMap of nevra -> deps.
  *)
 let create_deps pkgs =
-  let deps = List.map (fun pkg -> Deps (pkg, ref [])) pkgs in
+  let deps =
+    List.map (fun pkg -> { pkg = pkg; children = []; parents = [] }) pkgs in
   let depsmap =
     List.fold_left (
-      fun map (Deps (pkg, _) as deps) ->
-       StringMap.add pkg.nevra deps map
+      fun map ({pkg = pkg} as deps) -> StringMap.add pkg.nevra deps map
     ) StringMap.empty deps in
   List.iter (
-    fun (Deps (pkg, deps)) ->
-      let deps' = List.map (fun n -> StringMap.find n depsmap) pkg.deps in
-      deps := List.append !deps deps'
+    fun dep ->
+      List.iter (
+       fun nevra ->
+         let dep' = StringMap.find nevra depsmap in
+         (* dep.pkg is parent of dep'.pkg *)
+         dep.children <- dep' :: dep.children;
+         dep'.parents <- dep :: dep'.parents
+      ) dep.pkg.deps;
   ) deps;
   depsmap
 
@@ -162,8 +176,8 @@ let create_totals pkgs depsmap =
   let total pkg =
     let seen = ref StringMap.empty in
     let rec _total = function
-      | Deps (pkg, _) when StringMap.mem pkg.nevra !seen -> 0L
-      | Deps (pkg, { contents = children }) ->
+      | { pkg = pkg } when StringMap.mem pkg.nevra !seen -> 0L
+      | { pkg = pkg; children = children } ->
          seen := StringMap.add pkg.nevra true !seen;
          pkg.size +^ sum (List.map _total children)
     in
@@ -190,12 +204,12 @@ let create_tree root depsmap totalsmap =
     let seen = StringMap.empty in
     let seen = StringMap.add root true seen in
     let seen = ref seen in
-    let mark_seen (Deps (pkg, _))= seen := StringMap.add pkg.nevra true !seen in
-    let not_seen (Deps (pkg, _)) = not (StringMap.mem pkg.nevra !seen) in
+    let mark_seen { pkg = pkg } = seen := StringMap.add pkg.nevra true !seen in
+    let not_seen { pkg = pkg } = not (StringMap.mem pkg.nevra !seen) in
     let rec build_tree = function
-      | Deps (pkg, { contents = children }) ->
+      | { pkg = pkg; children = children } ->
          (* Sort children by reverse total size. *)
-         let cmp (Deps (p1, _)) (Deps (p2, _)) =
+         let cmp { pkg = p1 } { pkg = p2 } =
            let t1 = StringMap.find p1.nevra totalsmap in
            let t2 = StringMap.find p2.nevra totalsmap in
            compare t2 t1
@@ -288,17 +302,17 @@ let debug_deps root depsmap =
   if !debug_flag then (
     let seen = ref StringMap.empty in
     let rec display ?(indent=0) = function
-      | Deps (pkg, deps) ->
+      | { pkg = pkg; children = children; parents = parents } ->
          if StringMap.mem pkg.nevra !seen then
            eprintf "%s%s -> ...\n" (spaces indent) pkg.nevra
          else (
-           eprintf "%s%s -> [%s]\n"
-             (spaces indent) pkg.nevra (
+           eprintf "%s%s ->\n%sparents:[%s]\n"
+             (spaces indent) pkg.nevra (spaces (indent+2)) (
                String.concat ", "
-                 (List.map (fun (Deps (pkg, _)) -> pkg.nevra) !deps)
+                 (List.map (fun { pkg = pkg } -> pkg.nevra) parents)
              );
            seen := StringMap.add pkg.nevra true !seen;
-           List.iter (display ~indent:(indent+2)) !deps
+           List.iter (display ~indent:(indent+2)) children
          )
     in
     display (StringMap.find root depsmap);
@@ -380,7 +394,7 @@ let open_window pkgstr =
   (* This is the currently open package, or None if nothing has
    * opened by the user yet.
    *)
-  let current = ref None in
+  let opened = ref None in
 
   (* Called from the "Open package" menu entry and other places. *)
   let open_package pkgstr =
@@ -416,7 +430,7 @@ let open_window pkgstr =
        let Tree (_, top_total, top_increm, _, _) = tree in
        assert (top_total = top_increm);
 
-       current :=
+       opened :=
          Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total);
 
        (* Update the window title. *)
@@ -428,7 +442,7 @@ let open_window pkgstr =
   in
 
   (* If the user selected something on the command line (pkgstr !=
-   * None) then set up an idle event to populate 'current' as soon as
+   * None) then set up an idle event to populate 'opened' as soon as
    * the window gets drawn on the screen.
    *)
   (match pkgstr with
@@ -711,7 +725,7 @@ Tot: %.1f%% %s" pkg.name
     draw_tree 0. 0 tree
 
   and repaint _ =
-    (match !current with
+    (match !opened with
      | None -> ()
      | Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total) ->
         real_repaint root pkgs depsmap totalsmap tree depth top_total
@@ -758,7 +772,7 @@ Total: %.1f%% %s (%Ld bytes)" pkg.nevra
     )
 
   and motion ev =
-    (match !current with
+    (match !opened with
      | None -> ()
      | Some (root, pkgs, depsmap, totalsmap, tree, depth, top_total) ->
         real_motion root pkgs depsmap totalsmap tree depth top_total ev