From 1d30931a28af4ed6aa747a05bc3540e335ce1b32 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
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 6a5496e..d783e4c 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -21,6 +21,7 @@
   #:use-module (guix utils)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 vlist)
+  #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-39)
@@ -108,20 +109,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