summaryrefslogtreecommitdiff
path: root/guix/gnu-maintenance.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-01-28 17:09:34 +0100
committerLudovic Courtès <ludo@gnu.org>2017-01-28 18:55:20 +0100
commit55b2d921456e888f097bf4e43a3d25b112f3e563 (patch)
tree5e2e834a2aa37f50dd27a33ae38a2f82c30091a7 /guix/gnu-maintenance.scm
parentf9704f179a5160013c4a401dce3761714bba8e72 (diff)
downloadgnu-guix-55b2d921456e888f097bf4e43a3d25b112f3e563.tar
gnu-guix-55b2d921456e888f097bf4e43a3d25b112f3e563.tar.gz
Use 'mlambda' instead of 'memoize'.
* gnu/packages.scm (find-newest-available-packages): Use 'mlambda' instead of (memoize (lambda ...) ...). * gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Likewise. * guix/build-system/gnu.scm (package-with-explicit-inputs)[rewritten-input]: Likewise. * guix/build-system/python.scm (package-with-explicit-python)[transform]: Likewise. * guix/derivations.scm (derivation->string): Likewise. * guix/gnu-maintenance.scm (gnu-package?): Likewise. * guix/modules.scm (module-file-dependencies): Likewise. * guix/scripts/graph.scm (standard-package-set): Likewise. * guix/scripts/lint.scm (official-gnu-packages*): Likewise. * guix/store.scm (store-regexp*): Likewise. * guix/utils.scm (location): Likewise.
Diffstat (limited to 'guix/gnu-maintenance.scm')
-rw-r--r--guix/gnu-maintenance.scm83
1 files changed, 41 insertions, 42 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 05ea19236b..012f587525 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -165,49 +165,48 @@ found."
(official-gnu-packages)))
(define gnu-package?
- (memoize
- (let ((official-gnu-packages (memoize official-gnu-packages)))
- (lambda (package)
- "Return true if PACKAGE is a GNU package. This procedure may access the
+ (let ((official-gnu-packages (memoize official-gnu-packages)))
+ (mlambda (package)
+ "Return true if PACKAGE is a GNU package. This procedure may access the
network to check in GNU's database."
- (define (mirror-type url)
- (let ((uri (string->uri url)))
- (and (eq? (uri-scheme uri) 'mirror)
- (cond
- ((member (uri-host uri)
- '("gnu" "gnupg" "gcc" "gnome"))
- ;; Definitely GNU.
- 'gnu)
- ((equal? (uri-host uri) "cran")
- ;; Possibly GNU: mirror://cran could be either GNU R itself
- ;; or a non-GNU package.
- #f)
- (else
- ;; Definitely non-GNU.
- 'non-gnu)))))
-
- (define (gnu-home-page? package)
- (letrec-syntax ((>> (syntax-rules ()
- ((_ value proc)
- (and=> value proc))
- ((_ value proc rest ...)
- (and=> value
- (lambda (next)
- (>> (proc next) rest ...)))))))
- (>> package package-home-page
- string->uri uri-host
- (lambda (host)
- (member host '("www.gnu.org" "gnu.org"))))))
-
- (or (gnu-home-page? package)
- (let ((url (and=> (package-source package) origin-uri))
- (name (package-upstream-name package)))
- (case (and (string? url) (mirror-type url))
- ((gnu) #t)
- ((non-gnu) #f)
- (else
- (and (member name (map gnu-package-name (official-gnu-packages)))
- #t)))))))))
+ (define (mirror-type url)
+ (let ((uri (string->uri url)))
+ (and (eq? (uri-scheme uri) 'mirror)
+ (cond
+ ((member (uri-host uri)
+ '("gnu" "gnupg" "gcc" "gnome"))
+ ;; Definitely GNU.
+ 'gnu)
+ ((equal? (uri-host uri) "cran")
+ ;; Possibly GNU: mirror://cran could be either GNU R itself
+ ;; or a non-GNU package.
+ #f)
+ (else
+ ;; Definitely non-GNU.
+ 'non-gnu)))))
+
+ (define (gnu-home-page? package)
+ (letrec-syntax ((>> (syntax-rules ()
+ ((_ value proc)
+ (and=> value proc))
+ ((_ value proc rest ...)
+ (and=> value
+ (lambda (next)
+ (>> (proc next) rest ...)))))))
+ (>> package package-home-page
+ string->uri uri-host
+ (lambda (host)
+ (member host '("www.gnu.org" "gnu.org"))))))
+
+ (or (gnu-home-page? package)
+ (let ((url (and=> (package-source package) origin-uri))
+ (name (package-upstream-name package)))
+ (case (and (string? url) (mirror-type url))
+ ((gnu) #t)
+ ((non-gnu) #f)
+ (else
+ (and (member name (map gnu-package-name (official-gnu-packages)))
+ #t))))))))
;;;