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.
This commit is contained in:
Ludovic Courtès
parent
f9704f179a
commit
55b2d92145
|
|
@ -235,8 +235,7 @@ decreasing version order."
|
|||
matching)))))
|
||||
|
||||
(define find-newest-available-packages
|
||||
(memoize
|
||||
(lambda ()
|
||||
(mlambda ()
|
||||
"Return a vhash keyed by package names, and with
|
||||
associated values of the form
|
||||
|
||||
|
|
@ -256,7 +255,7 @@ where the preferred package is listed first."
|
|||
((=) (vhash-cons name `(,version ,p ,@pkgs) r))
|
||||
((<) r)))
|
||||
(#f (vhash-cons name `(,version ,p) r)))))
|
||||
vlist-null))))
|
||||
vlist-null)))
|
||||
|
||||
(define (find-best-packages-by-name name version)
|
||||
"If version is #f, return the list of packages named NAME with the highest
|
||||
|
|
|
|||
|
|
@ -131,8 +131,7 @@ successful, or false to signal an error."
|
|||
(license gpl3+)))
|
||||
|
||||
(define package-with-bootstrap-guile
|
||||
(memoize
|
||||
(lambda (p)
|
||||
(mlambda (p)
|
||||
"Return a variant of P such that all its origins are fetched with
|
||||
%BOOTSTRAP-GUILE."
|
||||
(define rewritten-input
|
||||
|
|
@ -154,7 +153,7 @@ successful, or false to signal an error."
|
|||
(propagated-inputs (map rewritten-input
|
||||
(package-propagated-inputs p)))
|
||||
(replacement (and=> (package-replacement p)
|
||||
package-with-bootstrap-guile))))))
|
||||
package-with-bootstrap-guile)))))
|
||||
|
||||
(define* (glibc-dynamic-linker
|
||||
#:optional (system (or (and=> (%current-target-system)
|
||||
|
|
|
|||
|
|
@ -84,8 +84,8 @@ builder, or the distro's final Guile when GUILE is #f."
|
|||
|
||||
(let loop ((p p))
|
||||
(define rewritten-input
|
||||
(memoize
|
||||
(match-lambda
|
||||
(mlambda (input)
|
||||
(match input
|
||||
((name (? package? p) sub-drv ...)
|
||||
;; XXX: Check whether P's build system knows #:implicit-inputs, for
|
||||
;; things like `cross-pkg-config'.
|
||||
|
|
@ -393,8 +393,7 @@ packages that must not be referenced."
|
|||
;;;
|
||||
|
||||
(define standard-cross-packages
|
||||
(memoize
|
||||
(lambda (target kind)
|
||||
(mlambda (target kind)
|
||||
"Return the list of name/package tuples to cross-build for TARGET. KIND
|
||||
is one of `host' or `target'."
|
||||
(let* ((cross (resolve-interface '(gnu packages cross-base)))
|
||||
|
|
@ -408,7 +407,7 @@ is one of `host' or `target'."
|
|||
(libc target)))
|
||||
("cross-binutils" ,(binutils target))))
|
||||
((target)
|
||||
`(("cross-libc" ,(libc target)))))))))
|
||||
`(("cross-libc" ,(libc target))))))))
|
||||
|
||||
(define* (gnu-cross-build store name
|
||||
#:key
|
||||
|
|
|
|||
|
|
@ -87,8 +87,7 @@ pre-defined variants."
|
|||
;; Memoize the transformations. Failing to do that, we would build a huge
|
||||
;; object graph with lots of duplicates, which in turns prevents us from
|
||||
;; benefiting from memoization in 'package-derivation'.
|
||||
(memoize ;FIXME: use 'eq?'
|
||||
(lambda (p)
|
||||
(mlambda (p) ;XXX: use 'eq?'
|
||||
(let* ((rewrite-if-package
|
||||
(lambda (content)
|
||||
;; CONTENT may be a file name, in which case it is returned,
|
||||
|
|
@ -129,7 +128,7 @@ pre-defined variants."
|
|||
(propagated-inputs (map rewrite (package-propagated-inputs p)))
|
||||
(native-inputs (map rewrite (package-native-inputs p)))))
|
||||
(else
|
||||
p))))))
|
||||
p)))))
|
||||
|
||||
transform)
|
||||
|
||||
|
|
|
|||
|
|
@ -557,12 +557,11 @@ that form."
|
|||
(display ")" port))))
|
||||
|
||||
(define derivation->string
|
||||
(memoize
|
||||
(lambda (drv)
|
||||
(mlambda (drv)
|
||||
"Return the external representation of DRV as a string."
|
||||
(with-fluids ((%default-port-encoding "UTF-8"))
|
||||
(call-with-output-string
|
||||
(cut write-derivation drv <>))))))
|
||||
(cut write-derivation drv <>)))))
|
||||
|
||||
(define* (derivation->output-path drv #:optional (output "out"))
|
||||
"Return the store path of its output OUTPUT. Raise a
|
||||
|
|
@ -584,12 +583,14 @@ DRV."
|
|||
|
||||
(define derivation-path->output-path
|
||||
;; This procedure is called frequently, so memoize it.
|
||||
(memoize
|
||||
(let ((memoized (mlambda (path output)
|
||||
(derivation->output-path (call-with-input-file path
|
||||
read-derivation)
|
||||
output))))
|
||||
(lambda* (path #:optional (output "out"))
|
||||
"Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
|
||||
path of its output OUTPUT."
|
||||
(derivation->output-path (call-with-input-file path read-derivation)
|
||||
output))))
|
||||
(memoized path output))))
|
||||
|
||||
(define (derivation-path->output-paths path)
|
||||
"Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the
|
||||
|
|
@ -616,18 +617,16 @@ in SIZE bytes."
|
|||
(loop (+ 1 i))))))
|
||||
|
||||
(define derivation-path->base16-hash
|
||||
(memoize
|
||||
(lambda (file)
|
||||
(mlambda (file)
|
||||
"Return a string containing the base16 representation of the hash of the
|
||||
derivation at FILE."
|
||||
(call-with-input-file file
|
||||
(compose bytevector->base16-string
|
||||
derivation-hash
|
||||
read-derivation)))))
|
||||
read-derivation))))
|
||||
|
||||
(define derivation-hash ; `hashDerivationModulo' in derivations.cc
|
||||
(memoize
|
||||
(lambda (drv)
|
||||
(mlambda (drv)
|
||||
"Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
|
||||
(match drv
|
||||
(($ <derivation> ((_ . ($ <derivation-output> path
|
||||
|
|
@ -662,7 +661,7 @@ derivation at FILE."
|
|||
;; the SHA256 port's `write' method gets called for every single
|
||||
;; character.
|
||||
(sha256
|
||||
(string->utf8 (derivation->string drv)))))))))
|
||||
(string->utf8 (derivation->string drv))))))))
|
||||
|
||||
(define (store-path type hash name) ; makeStorePath
|
||||
"Return the store path for NAME/HASH/TYPE."
|
||||
|
|
@ -916,8 +915,7 @@ recursively."
|
|||
(define rewritten-input
|
||||
;; Rewrite the given input according to MAPPING, and return an input
|
||||
;; in the format used in 'derivation' calls.
|
||||
(memoize
|
||||
(lambda (input loop)
|
||||
(mlambda (input loop)
|
||||
(match input
|
||||
(($ <derivation-input> path (sub-drvs ...))
|
||||
(match (vhash-assoc path mapping)
|
||||
|
|
@ -927,7 +925,7 @@ recursively."
|
|||
(list replacement))
|
||||
(#f
|
||||
(let* ((drv (loop (call-with-input-file path read-derivation))))
|
||||
(cons drv sub-drvs)))))))))
|
||||
(cons drv sub-drvs))))))))
|
||||
|
||||
(let loop ((drv drv))
|
||||
(let* ((inputs (map (cut rewritten-input <> loop)
|
||||
|
|
@ -1058,13 +1056,13 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
|
|||
(define search-path*
|
||||
;; A memoizing version of 'search-path' so 'imported-modules' does not end
|
||||
;; up looking for the same files over and over again.
|
||||
(memoize (lambda (path file)
|
||||
(mlambda (path file)
|
||||
"Search for FILE in PATH and memoize the result. Raise a
|
||||
'&file-search-error' condition if it could not be found."
|
||||
(or (search-path path file)
|
||||
(raise (condition
|
||||
(&file-search-error (file file)
|
||||
(path path))))))))
|
||||
(path path)))))))
|
||||
|
||||
(define (module->source-file-name module)
|
||||
"Return the file name corresponding to MODULE, a Guile module name (a list
|
||||
|
|
|
|||
|
|
@ -165,9 +165,8 @@ found."
|
|||
(official-gnu-packages)))
|
||||
|
||||
(define gnu-package?
|
||||
(memoize
|
||||
(let ((official-gnu-packages (memoize official-gnu-packages)))
|
||||
(lambda (package)
|
||||
(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)
|
||||
|
|
@ -207,7 +206,7 @@ network to check in GNU's database."
|
|||
((non-gnu) #f)
|
||||
(else
|
||||
(and (member name (map gnu-package-name (official-gnu-packages)))
|
||||
#t)))))))))
|
||||
#t))))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -71,8 +71,7 @@ CLAUSES."
|
|||
result)))))
|
||||
|
||||
(define module-file-dependencies
|
||||
(memoize
|
||||
(lambda (file)
|
||||
(mlambda (file)
|
||||
"Return the list of the names of modules that the Guile module in FILE
|
||||
depends on."
|
||||
(call-with-input-file file
|
||||
|
|
@ -82,7 +81,7 @@ depends on."
|
|||
(extract-dependencies clauses))
|
||||
;; XXX: R6RS 'library' form is ignored.
|
||||
(_
|
||||
'())))))))
|
||||
'()))))))
|
||||
|
||||
(define (module-name->file-name module)
|
||||
"Return the file name for MODULE."
|
||||
|
|
|
|||
|
|
@ -191,12 +191,11 @@ Dependencies may include packages, origin, and file names."
|
|||
%store-monad))))
|
||||
|
||||
(define standard-package-set
|
||||
(memoize
|
||||
(lambda ()
|
||||
(mlambda ()
|
||||
"Return the set of standard packages provided by GNU-BUILD-SYSTEM."
|
||||
(match (standard-packages)
|
||||
(((labels packages . output) ...)
|
||||
(list->setq packages))))))
|
||||
(list->setq packages)))))
|
||||
|
||||
(define (bag-node-edges-sans-bootstrap thing)
|
||||
"Like 'bag-node-edges', but pretend that the standard packages of
|
||||
|
|
|
|||
|
|
@ -559,12 +559,11 @@ patch could not be found."
|
|||
str)))
|
||||
|
||||
(define official-gnu-packages*
|
||||
(memoize
|
||||
(lambda ()
|
||||
(mlambda ()
|
||||
"A memoizing version of 'official-gnu-packages' that returns the empty
|
||||
list when something goes wrong, such as a networking issue."
|
||||
(let ((gnus (false-if-exception (official-gnu-packages))))
|
||||
(or gnus '())))))
|
||||
(or gnus '()))))
|
||||
|
||||
(define (check-gnu-synopsis+description package)
|
||||
"Make sure that, if PACKAGE is a GNU package, it uses the synopsis and
|
||||
|
|
|
|||
|
|
@ -1282,11 +1282,10 @@ valid inputs."
|
|||
(define store-regexp*
|
||||
;; The substituter makes repeated calls to 'store-path-hash-part', hence
|
||||
;; this optimization.
|
||||
(memoize
|
||||
(lambda (store)
|
||||
(mlambda (store)
|
||||
"Return a regexp matching a file in STORE."
|
||||
(make-regexp (string-append "^" (regexp-quote store)
|
||||
"/([0-9a-df-np-sv-z]{32})-([^/]+)$")))))
|
||||
"/([0-9a-df-np-sv-z]{32})-([^/]+)$"))))
|
||||
|
||||
(define (store-path-package-name path)
|
||||
"Return the package name part of PATH, a file name in the store."
|
||||
|
|
|
|||
|
|
@ -771,11 +771,10 @@ be determined."
|
|||
(column location-column)) ; 0-indexed column
|
||||
|
||||
(define location
|
||||
(memoize
|
||||
(lambda (file line column)
|
||||
(mlambda (file line column)
|
||||
"Return the <location> object for the given FILE, LINE, and COLUMN."
|
||||
(and line column file
|
||||
(make-location file line column)))))
|
||||
(make-location file line column))))
|
||||
|
||||
(define (source-properties->location loc)
|
||||
"Return a location object based on the info in LOC, an alist as returned
|
||||
|
|
|
|||
Loading…
Reference in New Issue