diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-01-28 17:15:27 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-01-28 18:55:20 +0100 |
commit | c9134e82fe0332787468dcd27f18bdc8609738fd (patch) | |
tree | 7d9de18d0ae4017b552261b28c975be3f18876e7 | |
parent | 55b2d921456e888f097bf4e43a3d25b112f3e563 (diff) | |
download | patches-c9134e82fe0332787468dcd27f18bdc8609738fd.tar patches-c9134e82fe0332787468dcd27f18bdc8609738fd.tar.gz |
packages: Remove 'define-memoized/v' and use 'mlambdaq' instead.
* guix/packages.scm (define-memoized/v): Remove.
(package-transitive-supported-systems): Use 'mlambdaq' instead of
'define-memoized/v'.
(package-input-rewriting)[replace]: Likewise.
-rw-r--r-- | guix/packages.scm | 61 |
1 files changed, 22 insertions, 39 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index defde2478a..4bc4b017f4 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -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) @@ -697,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 @@ -775,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) |