aboutsummaryrefslogtreecommitdiff
path: root/guix/packages.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/packages.scm')
-rw-r--r--guix/packages.scm70
1 files changed, 30 insertions, 40 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index beb958f156..4bc4b017f4 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
@@ -28,6 +28,7 @@
#:use-module (guix base32)
#:use-module (guix grafts)
#:use-module (guix derivations)
+ #:use-module (guix memoization)
#:use-module (guix build-system)
#:use-module (guix search-paths)
#:use-module (guix gexp)
@@ -62,6 +63,7 @@
package
package?
package-name
+ package-upstream-name
package-version
package-full-name
package-source
@@ -296,6 +298,12 @@ name of its URI."
package)
16)))))
+(define (package-upstream-name package)
+ "Return the upstream name of PACKAGE, which could be different from the name
+it has in Guix."
+ (or (assq-ref (package-properties package) 'upstream-name)
+ (package-name package)))
+
(define (hidden-package p)
"Return a \"hidden\" version of P--i.e., one that 'fold-packages' and thus,
user interfaces, ignores."
@@ -690,38 +698,19 @@ in INPUTS and their transitive propagated inputs."
`(assoc-ref ,alist ,(label input)))
(transitive-inputs inputs)))
-(define-syntax define-memoized/v
- (lambda (form)
- "Define a memoized single-valued unary procedure with docstring.
-The procedure argument is compared to cached keys using `eqv?'."
- (syntax-case form ()
- ((_ (proc arg) docstring body body* ...)
- (string? (syntax->datum #'docstring))
- #'(define proc
- (let ((cache (make-hash-table)))
- (define (proc arg)
- docstring
- (match (hashv-get-handle cache arg)
- ((_ . value)
- value)
- (_
- (let ((result (let () body body* ...)))
- (hashv-set! cache arg result)
- result))))
- proc))))))
-
-(define-memoized/v (package-transitive-supported-systems package)
- "Return the intersection of the systems supported by PACKAGE and those
+(define package-transitive-supported-systems
+ (mlambdaq (package)
+ "Return the intersection of the systems supported by PACKAGE and those
supported by its dependencies."
- (fold (lambda (input systems)
- (match input
- ((label (? package? p) . _)
- (lset-intersection
- string=? systems (package-transitive-supported-systems p)))
- (_
- systems)))
- (package-supported-systems package)
- (bag-direct-inputs (package->bag package))))
+ (fold (lambda (input systems)
+ (match input
+ ((label (? package? p) . _)
+ (lset-intersection
+ string=? systems (package-transitive-supported-systems p)))
+ (_
+ systems)))
+ (package-supported-systems package)
+ (bag-direct-inputs (package->bag package)))))
(define* (supported-package? package #:optional (system (%current-system)))
"Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its
@@ -768,14 +757,15 @@ package and returns its new name after rewrite."
(_
input)))
- (define-memoized/v (replace p)
- "Return a variant of P with its inputs rewritten."
- (package
- (inherit p)
- (name (rewrite-name (package-name p)))
- (inputs (map rewrite (package-inputs p)))
- (native-inputs (map rewrite (package-native-inputs p)))
- (propagated-inputs (map rewrite (package-propagated-inputs p)))))
+ (define replace
+ (mlambdaq (p)
+ ;; Return a variant of P with its inputs rewritten.
+ (package
+ (inherit p)
+ (name (rewrite-name (package-name p)))
+ (inputs (map rewrite (package-inputs p)))
+ (native-inputs (map rewrite (package-native-inputs p)))
+ (propagated-inputs (map rewrite (package-propagated-inputs p))))))
replace)