nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Inhibit duplicates in fold-packages. 

* gnu/packages.scm (fold2): New procedure.
  (fold-packages): Rework to suppress duplicates.
master
Mark H Weaver 2013-02-12 20:29:30 -05:00
parent 9011e97f8d
commit c2868b1e0c
1 changed files with 28 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
gnu/packages.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -20,6 +21,7 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 vlist)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-39) #:use-module (srfi srfi-39)
@ -106,20 +108,34 @@
(false-if-exception (resolve-interface name)))) (false-if-exception (resolve-interface name))))
(package-files))) (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) (define (fold-packages proc init)
"Call (PROC PACKAGE RESULT) for each available package, using INIT as "Call (PROC PACKAGE RESULT) for each available package, using INIT as
the initial value of RESULT." the initial value of RESULT. It is guaranteed to never traverse the
(fold (lambda (module result) same package twice."
(fold (lambda (var result) (identity ; discard second return value
(if (package? var) (fold2 (lambda (module result seen)
(proc var result) (fold2 (lambda (var result seen)
result)) (if (and (package? var)
result (not (vhash-assq var seen)))
(module-map (lambda (sym var) (values (proc var result)
(false-if-exception (variable-ref var))) (vhash-consq var #t seen))
module))) (values result seen)))
init result
(package-modules))) 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) (define* (find-packages-by-name name #:optional version)
"Return the list of packages with the given NAME. If VERSION is not #f, "Return the list of packages with the given NAME. If VERSION is not #f,