mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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
11 changed files with 204 additions and 216 deletions
|
|
@ -235,28 +235,27 @@ (define find-packages-by-name
|
|||
matching)))))
|
||||
|
||||
(define find-newest-available-packages
|
||||
(memoize
|
||||
(lambda ()
|
||||
"Return a vhash keyed by package names, and with
|
||||
(mlambda ()
|
||||
"Return a vhash keyed by package names, and with
|
||||
associated values of the form
|
||||
|
||||
(newest-version newest-package ...)
|
||||
|
||||
where the preferred package is listed first."
|
||||
|
||||
;; FIXME: Currently, the preferred package is whichever one
|
||||
;; was found last by 'fold-packages'. Find a better solution.
|
||||
(fold-packages (lambda (p r)
|
||||
(let ((name (package-name p))
|
||||
(version (package-version p)))
|
||||
(match (vhash-assoc name r)
|
||||
((_ newest-so-far . pkgs)
|
||||
(case (version-compare version newest-so-far)
|
||||
((>) (vhash-cons name `(,version ,p) r))
|
||||
((=) (vhash-cons name `(,version ,p ,@pkgs) r))
|
||||
((<) r)))
|
||||
(#f (vhash-cons name `(,version ,p) r)))))
|
||||
vlist-null))))
|
||||
;; FIXME: Currently, the preferred package is whichever one
|
||||
;; was found last by 'fold-packages'. Find a better solution.
|
||||
(fold-packages (lambda (p r)
|
||||
(let ((name (package-name p))
|
||||
(version (package-version p)))
|
||||
(match (vhash-assoc name r)
|
||||
((_ newest-so-far . pkgs)
|
||||
(case (version-compare version newest-so-far)
|
||||
((>) (vhash-cons name `(,version ,p) r))
|
||||
((=) (vhash-cons name `(,version ,p ,@pkgs) r))
|
||||
((<) r)))
|
||||
(#f (vhash-cons name `(,version ,p) r)))))
|
||||
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,30 +131,29 @@ (define* (package-from-tarball name source program-to-test description
|
|||
(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
|
||||
(match-lambda
|
||||
((name (? origin? o))
|
||||
`(,name ,(bootstrap-origin o)))
|
||||
((name (? package? p) sub-drvs ...)
|
||||
`(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
|
||||
(x x)))
|
||||
((name (? origin? o))
|
||||
`(,name ,(bootstrap-origin o)))
|
||||
((name (? package? p) sub-drvs ...)
|
||||
`(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
|
||||
(x x)))
|
||||
|
||||
(package (inherit p)
|
||||
(source (match (package-source p)
|
||||
((? origin? o) (bootstrap-origin o))
|
||||
(s s)))
|
||||
(inputs (map rewritten-input
|
||||
(package-inputs p)))
|
||||
(native-inputs (map rewritten-input
|
||||
(package-native-inputs p)))
|
||||
(propagated-inputs (map rewritten-input
|
||||
(package-propagated-inputs p)))
|
||||
(replacement (and=> (package-replacement p)
|
||||
package-with-bootstrap-guile))))))
|
||||
(source (match (package-source p)
|
||||
((? origin? o) (bootstrap-origin o))
|
||||
(s s)))
|
||||
(inputs (map rewritten-input
|
||||
(package-inputs p)))
|
||||
(native-inputs (map rewritten-input
|
||||
(package-native-inputs p)))
|
||||
(propagated-inputs (map rewritten-input
|
||||
(package-propagated-inputs p)))
|
||||
(replacement (and=> (package-replacement p)
|
||||
package-with-bootstrap-guile)))))
|
||||
|
||||
(define* (glibc-dynamic-linker
|
||||
#:optional (system (or (and=> (%current-target-system)
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ (define (duplicate-filter inputs)
|
|||
|
||||
(let loop ((p p))
|
||||
(define rewritten-input
|
||||
(memoize
|
||||
(match-lambda
|
||||
((name (? package? p) sub-drv ...)
|
||||
;; XXX: Check whether P's build system knows #:implicit-inputs, for
|
||||
;; things like `cross-pkg-config'.
|
||||
(if (eq? (package-build-system p) gnu-build-system)
|
||||
(cons* name (loop p) sub-drv)
|
||||
(cons* name p sub-drv)))
|
||||
(x x))))
|
||||
(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'.
|
||||
(if (eq? (package-build-system p) gnu-build-system)
|
||||
(cons* name (loop p) sub-drv)
|
||||
(cons* name p sub-drv)))
|
||||
(x x))))
|
||||
|
||||
(package (inherit p)
|
||||
(location (if (pair? loc) (source-properties->location loc) loc))
|
||||
|
|
@ -393,22 +393,21 @@ (define guile-for-build
|
|||
;;;
|
||||
|
||||
(define standard-cross-packages
|
||||
(memoize
|
||||
(lambda (target kind)
|
||||
"Return the list of name/package tuples to cross-build for 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)))
|
||||
(gcc (module-ref cross 'cross-gcc))
|
||||
(binutils (module-ref cross 'cross-binutils))
|
||||
(libc (module-ref cross 'cross-libc)))
|
||||
(case kind
|
||||
((host)
|
||||
`(("cross-gcc" ,(gcc target
|
||||
(binutils target)
|
||||
(libc target)))
|
||||
("cross-binutils" ,(binutils target))))
|
||||
((target)
|
||||
`(("cross-libc" ,(libc target)))))))))
|
||||
(let* ((cross (resolve-interface '(gnu packages cross-base)))
|
||||
(gcc (module-ref cross 'cross-gcc))
|
||||
(binutils (module-ref cross 'cross-binutils))
|
||||
(libc (module-ref cross 'cross-libc)))
|
||||
(case kind
|
||||
((host)
|
||||
`(("cross-gcc" ,(gcc target
|
||||
(binutils target)
|
||||
(libc target)))
|
||||
("cross-binutils" ,(binutils target))))
|
||||
((target)
|
||||
`(("cross-libc" ,(libc target))))))))
|
||||
|
||||
(define* (gnu-cross-build store name
|
||||
#:key
|
||||
|
|
|
|||
|
|
@ -87,49 +87,48 @@ (define transform
|
|||
;; 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)
|
||||
(let* ((rewrite-if-package
|
||||
(lambda (content)
|
||||
;; CONTENT may be a file name, in which case it is returned,
|
||||
;; or a package, which is rewritten with the new PYTHON and
|
||||
;; NEW-PREFIX.
|
||||
(if (package? content)
|
||||
(transform content)
|
||||
content)))
|
||||
(rewrite
|
||||
(match-lambda
|
||||
((name content . rest)
|
||||
(append (list name (rewrite-if-package content)) rest)))))
|
||||
(mlambda (p) ;XXX: use 'eq?'
|
||||
(let* ((rewrite-if-package
|
||||
(lambda (content)
|
||||
;; CONTENT may be a file name, in which case it is returned,
|
||||
;; or a package, which is rewritten with the new PYTHON and
|
||||
;; NEW-PREFIX.
|
||||
(if (package? content)
|
||||
(transform content)
|
||||
content)))
|
||||
(rewrite
|
||||
(match-lambda
|
||||
((name content . rest)
|
||||
(append (list name (rewrite-if-package content)) rest)))))
|
||||
|
||||
(cond
|
||||
;; If VARIANT-PROPERTY is present, use that.
|
||||
((and variant-property
|
||||
(assoc-ref (package-properties p) variant-property))
|
||||
=> force)
|
||||
(cond
|
||||
;; If VARIANT-PROPERTY is present, use that.
|
||||
((and variant-property
|
||||
(assoc-ref (package-properties p) variant-property))
|
||||
=> force)
|
||||
|
||||
;; Otherwise build the new package object graph.
|
||||
((eq? (package-build-system p) python-build-system)
|
||||
(package
|
||||
(inherit p)
|
||||
(location (package-location p))
|
||||
(name (let ((name (package-name p)))
|
||||
(string-append new-prefix
|
||||
(if (string-prefix? old-prefix name)
|
||||
(substring name
|
||||
(string-length old-prefix))
|
||||
name))))
|
||||
(arguments
|
||||
(let ((python (if (promise? python)
|
||||
(force python)
|
||||
python)))
|
||||
(ensure-keyword-arguments (package-arguments p)
|
||||
`(#:python ,python))))
|
||||
(inputs (map rewrite (package-inputs p)))
|
||||
(propagated-inputs (map rewrite (package-propagated-inputs p)))
|
||||
(native-inputs (map rewrite (package-native-inputs p)))))
|
||||
(else
|
||||
p))))))
|
||||
;; Otherwise build the new package object graph.
|
||||
((eq? (package-build-system p) python-build-system)
|
||||
(package
|
||||
(inherit p)
|
||||
(location (package-location p))
|
||||
(name (let ((name (package-name p)))
|
||||
(string-append new-prefix
|
||||
(if (string-prefix? old-prefix name)
|
||||
(substring name
|
||||
(string-length old-prefix))
|
||||
name))))
|
||||
(arguments
|
||||
(let ((python (if (promise? python)
|
||||
(force python)
|
||||
python)))
|
||||
(ensure-keyword-arguments (package-arguments p)
|
||||
`(#:python ,python))))
|
||||
(inputs (map rewrite (package-inputs p)))
|
||||
(propagated-inputs (map rewrite (package-propagated-inputs p)))
|
||||
(native-inputs (map rewrite (package-native-inputs p)))))
|
||||
(else
|
||||
p)))))
|
||||
|
||||
transform)
|
||||
|
||||
|
|
|
|||
|
|
@ -557,12 +557,11 @@ (define (write-env-var env-var port)
|
|||
(display ")" port))))
|
||||
|
||||
(define derivation->string
|
||||
(memoize
|
||||
(lambda (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 <>))))))
|
||||
(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 <>)))))
|
||||
|
||||
(define* (derivation->output-path drv #:optional (output "out"))
|
||||
"Return the store path of its output OUTPUT. Raise a
|
||||
|
|
@ -584,12 +583,14 @@ (define (derivation->output-paths drv)
|
|||
|
||||
(define derivation-path->output-path
|
||||
;; This procedure is called frequently, so memoize it.
|
||||
(memoize
|
||||
(lambda* (path #:optional (output "out"))
|
||||
"Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
|
||||
(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,23 +617,21 @@ (define old-size (bytevector-length bv))
|
|||
(loop (+ 1 i))))))
|
||||
|
||||
(define derivation-path->base16-hash
|
||||
(memoize
|
||||
(lambda (file)
|
||||
"Return a string containing the base16 representation of the hash of the
|
||||
(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)))))
|
||||
(call-with-input-file file
|
||||
(compose bytevector->base16-string
|
||||
derivation-hash
|
||||
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
|
||||
(? symbol? hash-algo) (? bytevector? hash)
|
||||
(? boolean? recursive?)))))
|
||||
(? symbol? hash-algo) (? bytevector? hash)
|
||||
(? boolean? recursive?)))))
|
||||
;; A fixed-output derivation.
|
||||
(sha256
|
||||
(string->utf8
|
||||
|
|
@ -642,14 +641,14 @@ (define derivation-hash ; `hashDerivationModulo' in derivations.cc
|
|||
":" (bytevector->base16-string hash)
|
||||
":" path))))
|
||||
(($ <derivation> outputs inputs sources
|
||||
system builder args env-vars)
|
||||
system builder args env-vars)
|
||||
;; A regular derivation: replace the path of each input with that
|
||||
;; input's hash; return the hash of serialization of the resulting
|
||||
;; derivation.
|
||||
(let* ((inputs (map (match-lambda
|
||||
(($ <derivation-input> path sub-drvs)
|
||||
(let ((hash (derivation-path->base16-hash path)))
|
||||
(make-derivation-input hash sub-drvs))))
|
||||
(($ <derivation-input> path sub-drvs)
|
||||
(let ((hash (derivation-path->base16-hash path)))
|
||||
(make-derivation-input hash sub-drvs))))
|
||||
inputs))
|
||||
(drv (make-derivation outputs
|
||||
(sort (coalesce-duplicate-inputs inputs)
|
||||
|
|
@ -662,7 +661,7 @@ (define derivation-hash ; `hashDerivationModulo' in derivations.cc
|
|||
;; 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,18 +915,17 @@ (define input->output-paths
|
|||
(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)
|
||||
(match input
|
||||
(($ <derivation-input> path (sub-drvs ...))
|
||||
(match (vhash-assoc path mapping)
|
||||
((_ . (? derivation? replacement))
|
||||
(cons replacement sub-drvs))
|
||||
((_ . replacement)
|
||||
(list replacement))
|
||||
(#f
|
||||
(let* ((drv (loop (call-with-input-file path read-derivation))))
|
||||
(cons drv sub-drvs)))))))))
|
||||
(mlambda (input loop)
|
||||
(match input
|
||||
(($ <derivation-input> path (sub-drvs ...))
|
||||
(match (vhash-assoc path mapping)
|
||||
((_ . (? derivation? replacement))
|
||||
(cons replacement sub-drvs))
|
||||
((_ . replacement)
|
||||
(list replacement))
|
||||
(#f
|
||||
(let* ((drv (loop (call-with-input-file path read-derivation))))
|
||||
(cons drv sub-drvs))))))))
|
||||
|
||||
(let loop ((drv drv))
|
||||
(let* ((inputs (map (cut rewritten-input <> loop)
|
||||
|
|
@ -1058,13 +1056,13 @@ (define-condition-type &file-search-error &error
|
|||
(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)
|
||||
"Search for FILE in PATH and memoize the result. Raise a
|
||||
(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))))))))
|
||||
(or (search-path path file)
|
||||
(raise (condition
|
||||
(&file-search-error (file file)
|
||||
(path path)))))))
|
||||
|
||||
(define (module->source-file-name module)
|
||||
"Return the file name corresponding to MODULE, a Guile module name (a list
|
||||
|
|
|
|||
|
|
@ -165,49 +165,48 @@ (define (find-package name)
|
|||
(official-gnu-packages)))
|
||||
|
||||
(define gnu-package?
|
||||
(memoize
|
||||
(let ((official-gnu-packages (memoize official-gnu-packages)))
|
||||
(lambda (package)
|
||||
"Return true if PACKAGE is a GNU package. This procedure may access the
|
||||
(let ((official-gnu-packages (memoize official-gnu-packages)))
|
||||
(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)
|
||||
(let ((uri (string->uri url)))
|
||||
(and (eq? (uri-scheme uri) 'mirror)
|
||||
(cond
|
||||
((member (uri-host uri)
|
||||
'("gnu" "gnupg" "gcc" "gnome"))
|
||||
;; Definitely GNU.
|
||||
'gnu)
|
||||
((equal? (uri-host uri) "cran")
|
||||
;; Possibly GNU: mirror://cran could be either GNU R itself
|
||||
;; or a non-GNU package.
|
||||
#f)
|
||||
(else
|
||||
;; Definitely non-GNU.
|
||||
'non-gnu)))))
|
||||
(define (mirror-type url)
|
||||
(let ((uri (string->uri url)))
|
||||
(and (eq? (uri-scheme uri) 'mirror)
|
||||
(cond
|
||||
((member (uri-host uri)
|
||||
'("gnu" "gnupg" "gcc" "gnome"))
|
||||
;; Definitely GNU.
|
||||
'gnu)
|
||||
((equal? (uri-host uri) "cran")
|
||||
;; Possibly GNU: mirror://cran could be either GNU R itself
|
||||
;; or a non-GNU package.
|
||||
#f)
|
||||
(else
|
||||
;; Definitely non-GNU.
|
||||
'non-gnu)))))
|
||||
|
||||
(define (gnu-home-page? package)
|
||||
(letrec-syntax ((>> (syntax-rules ()
|
||||
((_ value proc)
|
||||
(and=> value proc))
|
||||
((_ value proc rest ...)
|
||||
(and=> value
|
||||
(lambda (next)
|
||||
(>> (proc next) rest ...)))))))
|
||||
(>> package package-home-page
|
||||
string->uri uri-host
|
||||
(lambda (host)
|
||||
(member host '("www.gnu.org" "gnu.org"))))))
|
||||
(define (gnu-home-page? package)
|
||||
(letrec-syntax ((>> (syntax-rules ()
|
||||
((_ value proc)
|
||||
(and=> value proc))
|
||||
((_ value proc rest ...)
|
||||
(and=> value
|
||||
(lambda (next)
|
||||
(>> (proc next) rest ...)))))))
|
||||
(>> package package-home-page
|
||||
string->uri uri-host
|
||||
(lambda (host)
|
||||
(member host '("www.gnu.org" "gnu.org"))))))
|
||||
|
||||
(or (gnu-home-page? package)
|
||||
(let ((url (and=> (package-source package) origin-uri))
|
||||
(name (package-upstream-name package)))
|
||||
(case (and (string? url) (mirror-type url))
|
||||
((gnu) #t)
|
||||
((non-gnu) #f)
|
||||
(else
|
||||
(and (member name (map gnu-package-name (official-gnu-packages)))
|
||||
#t)))))))))
|
||||
(or (gnu-home-page? package)
|
||||
(let ((url (and=> (package-source package) origin-uri))
|
||||
(name (package-upstream-name package)))
|
||||
(case (and (string? url) (mirror-type url))
|
||||
((gnu) #t)
|
||||
((non-gnu) #f)
|
||||
(else
|
||||
(and (member name (map gnu-package-name (official-gnu-packages)))
|
||||
#t))))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -71,18 +71,17 @@ (define (extract-dependencies clauses)
|
|||
result)))))
|
||||
|
||||
(define module-file-dependencies
|
||||
(memoize
|
||||
(lambda (file)
|
||||
"Return the list of the names of modules that the Guile module in FILE
|
||||
(mlambda (file)
|
||||
"Return the list of the names of modules that the Guile module in FILE
|
||||
depends on."
|
||||
(call-with-input-file file
|
||||
(lambda (port)
|
||||
(match (read port)
|
||||
(('define-module name clauses ...)
|
||||
(extract-dependencies clauses))
|
||||
;; XXX: R6RS 'library' form is ignored.
|
||||
(_
|
||||
'())))))))
|
||||
(call-with-input-file file
|
||||
(lambda (port)
|
||||
(match (read port)
|
||||
(('define-module name clauses ...)
|
||||
(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 @@ (define %bag-with-origins-node-type
|
|||
%store-monad))))
|
||||
|
||||
(define standard-package-set
|
||||
(memoize
|
||||
(lambda ()
|
||||
"Return the set of standard packages provided by GNU-BUILD-SYSTEM."
|
||||
(match (standard-packages)
|
||||
(((labels packages . output) ...)
|
||||
(list->setq packages))))))
|
||||
(mlambda ()
|
||||
"Return the set of standard packages provided by GNU-BUILD-SYSTEM."
|
||||
(match (standard-packages)
|
||||
(((labels packages . output) ...)
|
||||
(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 @@ (define (escape-quotes str)
|
|||
str)))
|
||||
|
||||
(define official-gnu-packages*
|
||||
(memoize
|
||||
(lambda ()
|
||||
"A memoizing version of 'official-gnu-packages' that returns the empty
|
||||
(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 '())))))
|
||||
(let ((gnus (false-if-exception (official-gnu-packages))))
|
||||
(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 @@ (define (derivation-path? path)
|
|||
(define store-regexp*
|
||||
;; The substituter makes repeated calls to 'store-path-hash-part', hence
|
||||
;; this optimization.
|
||||
(memoize
|
||||
(lambda (store)
|
||||
"Return a regexp matching a file in STORE."
|
||||
(make-regexp (string-append "^" (regexp-quote store)
|
||||
"/([0-9a-df-np-sv-z]{32})-([^/]+)$")))))
|
||||
(mlambda (store)
|
||||
"Return a regexp matching a file in STORE."
|
||||
(make-regexp (string-append "^" (regexp-quote store)
|
||||
"/([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 @@ (define-record-type <location>
|
|||
(column location-column)) ; 0-indexed column
|
||||
|
||||
(define location
|
||||
(memoize
|
||||
(lambda (file line column)
|
||||
"Return the <location> object for the given FILE, LINE, and COLUMN."
|
||||
(and line column file
|
||||
(make-location 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))))
|
||||
|
||||
(define (source-properties->location loc)
|
||||
"Return a location object based on the info in LOC, an alist as returned
|
||||
|
|
|
|||
Loading…
Reference in a new issue