ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-26 22:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Inhibit duplicates in fold-packages.

Browse source 
* gnu/packages.scm (fold2): New procedure.
  (fold-packages): Rework to suppress duplicates.
This commit is contained in:
Mark H Weaver 2013-02-12 20:29:30 -05:00 committed by Ludovic Courtès
parent 790b8e0ebe
commit 9ede36f0ed
1 changed files with 28 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
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 @@ (define-module (gnu packages)
#: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 @@ (define not-slash
(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)
(not (vhash-assq var seen)))
(values (proc var result)
(vhash-consq var #t seen))
(values result seen)))
result result
seen
(module-map (lambda (sym var) (module-map (lambda (sym var)
(false-if-exception (variable-ref var))) (false-if-exception (variable-ref var)))
module))) module)))
init init
(package-modules))) 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,