rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests 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 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)