Re: [PATCH] Inhibit duplicates in fold-packages

[Mark H Weaver]

I wrote:
> Here's a patch to inhibit the same package (in the sense of eq?) from
> being traversed more than once by fold-packages.  One example where this
> helps is the guile-2.0 package in (gnu packages guile), which is
> exported in two different variables: guile-2.0 and guile-2.0/fixed.
>
> Note that even after applying this patch, there are still cases where
> "guix-package -A ." produces the same output twice, but that's a
> different problem.  [...]

Sorry, the patch I posted did not apply cleanly, because it was layered
on top of a preliminary version of my upgrade patch.  Here's a fixed
version.

     Mark


>From fcb78e4af6d4f7304582fa2ad44eb99236b6ae23 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Tue, 12 Feb 2013 20:29:30 -0500
Subject: [PATCH] Inhibit duplicates in fold-packages.

* gnu/packages.scm (fold2): New procedure.
  (fold-packages): Rework to suppress duplicates.
---
 gnu/packages.scm |   36 +++++++++++++++++++++++++-----------
 1 file changed, 25 insertions(+), 11 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 792fe44..ee661d7 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -20,6 +20,7 @@
   #:use-module (guix packages)
   #:use-module (guix utils)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-39)
@@ -106,20 +107,33 @@
                   (false-if-exception (resolve-interface name))))
               (package-files)))
 
+(define (fold2 f seed1 seed2 lst)
+  (if (null? lst)
+      (values seed1 seed2)
+      (call-with-values
+          (lambda () (f (car lst) seed1 seed2))
+        (lambda (seed1 seed2)
+          (fold2 f seed1 seed2 (cdr lst))))))
+
 (define (fold-packages proc init)
   "Call (PROC PACKAGE RESULT) for each available package, using INIT as
 the initial value of RESULT."
-  (fold (lambda (module result)
-          (fold (lambda (var result)
-                  (if (package? var)
-                      (proc var result)
-                      result))
-                result
-                (module-map (lambda (sym var)
-                              (false-if-exception (variable-ref var)))
-                            module)))
-        init
-        (package-modules)))
+  (identity   ; discard second return value
+   (fold2 (lambda (module result seen)
+            (fold2 (lambda (var result seen)
+                     (if (and (package? var)
+                              (not (vhash-assq var seen)))
+                         (values (proc var result)
+                                 (vhash-consq var #t seen))
+                         (values result seen)))
+                   result
+                   seen
+                   (module-map (lambda (sym var)
+                                 (false-if-exception (variable-ref var)))
+                               module)))
+          init
+          vlist-null
+          (package-modules))))
 
 (define* (find-packages-by-name name #:optional version)
   "Return the list of packages with the given NAME.  If VERSION is not #f,
-- 
1.7.10.4