TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2017-01-28 17:15:27 +01:00
parent 55b2d92145
commit c9134e82fe
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 22 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
guix/packages.scm
View File

@ -28,6 +28,7 @@
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix memoization)
#:use-module (guix build-system) #:use-module (guix build-system)
#:use-module (guix search-paths) #:use-module (guix search-paths)
#:use-module (guix gexp) #:use-module (guix gexp)
@ -697,38 +698,19 @@ in INPUTS and their transitive propagated inputs."
`(assoc-ref ,alist ,(label input))) `(assoc-ref ,alist ,(label input)))
(transitive-inputs inputs))) (transitive-inputs inputs)))
(define-syntax define-memoized/v (define package-transitive-supported-systems
(lambda (form) (mlambdaq (package)
"Define a memoized single-valued unary procedure with docstring. "Return the intersection of the systems supported by PACKAGE and those
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
supported by its dependencies." supported by its dependencies."
(fold (lambda (input systems) (fold (lambda (input systems)
(match input (match input
((label (? package? p) . _) ((label (? package? p) . _)
(lset-intersection (lset-intersection
string=? systems (package-transitive-supported-systems p))) string=? systems (package-transitive-supported-systems p)))
(_ (_
systems))) systems)))
(package-supported-systems package) (package-supported-systems package)
(bag-direct-inputs (package->bag package)))) (bag-direct-inputs (package->bag package)))))
(define* (supported-package? package #:optional (system (%current-system))) (define* (supported-package? package #:optional (system (%current-system)))
"Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its "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))) input)))
(define-memoized/v (replace p) (define replace
"Return a variant of P with its inputs rewritten." (mlambdaq (p)
(package ;; Return a variant of P with its inputs rewritten.
(inherit p) (package
(name (rewrite-name (package-name p))) (inherit p)
(inputs (map rewrite (package-inputs p))) (name (rewrite-name (package-name p)))
(native-inputs (map rewrite (package-native-inputs p))) (inputs (map rewrite (package-inputs p)))
(propagated-inputs (map rewrite (package-propagated-inputs p))))) (native-inputs (map rewrite (package-native-inputs p)))
(propagated-inputs (map rewrite (package-propagated-inputs p))))))
replace) replace)