mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-23 21:17:11 -05:00
gnu: bootstrap: Memoize 'bootstrap-origin'.
* gnu/packages/bootstrap.scm (bootstrap-origin): Memoize with 'mlambdaq'. This improves memoization of origins in (gnu packages commencement).
This commit is contained in:
parent
bf7b08c4fe
commit
7e1a74da93
1 changed files with 32 additions and 31 deletions
|
@ -149,41 +149,42 @@ (define bootstrap-executable
|
|||
;;; Helper procedures.
|
||||
;;;
|
||||
|
||||
(define (bootstrap-origin source)
|
||||
"Return a variant of SOURCE, an <origin> instance, whose method uses
|
||||
(define bootstrap-origin
|
||||
(mlambdaq (source)
|
||||
"Return a variant of SOURCE, an <origin> instance, whose method uses
|
||||
%BOOTSTRAP-GUILE to do its job."
|
||||
(define (boot fetch)
|
||||
(lambda* (url hash-algo hash
|
||||
#:optional name #:key system)
|
||||
(fetch url hash-algo hash name
|
||||
#:guile %bootstrap-guile
|
||||
#:system system)))
|
||||
(define (boot fetch)
|
||||
(lambda* (url hash-algo hash
|
||||
#:optional name #:key system)
|
||||
(fetch url hash-algo hash name
|
||||
#:guile %bootstrap-guile
|
||||
#:system system)))
|
||||
|
||||
(define %bootstrap-patch-inputs
|
||||
;; Packages used when an <origin> has a non-empty 'patches' field.
|
||||
`(("tar" ,%bootstrap-coreutils&co)
|
||||
("xz" ,%bootstrap-coreutils&co)
|
||||
("bzip2" ,%bootstrap-coreutils&co)
|
||||
("gzip" ,%bootstrap-coreutils&co)
|
||||
("patch" ,%bootstrap-coreutils&co)))
|
||||
(define %bootstrap-patch-inputs
|
||||
;; Packages used when an <origin> has a non-empty 'patches' field.
|
||||
`(("tar" ,%bootstrap-coreutils&co)
|
||||
("xz" ,%bootstrap-coreutils&co)
|
||||
("bzip2" ,%bootstrap-coreutils&co)
|
||||
("gzip" ,%bootstrap-coreutils&co)
|
||||
("patch" ,%bootstrap-coreutils&co)))
|
||||
|
||||
(let ((orig-method (origin-method source)))
|
||||
(if (or (not (null? (origin-patches source)))
|
||||
(origin-snippet source))
|
||||
(origin (inherit source)
|
||||
(method (if (eq? orig-method url-fetch)
|
||||
(boot url-fetch)
|
||||
orig-method))
|
||||
(patch-guile %bootstrap-guile)
|
||||
(patch-inputs %bootstrap-patch-inputs)
|
||||
(let ((orig-method (origin-method source)))
|
||||
(if (or (not (null? (origin-patches source)))
|
||||
(origin-snippet source))
|
||||
(origin (inherit source)
|
||||
(method (if (eq? orig-method url-fetch)
|
||||
(boot url-fetch)
|
||||
orig-method))
|
||||
(patch-guile %bootstrap-guile)
|
||||
(patch-inputs %bootstrap-patch-inputs)
|
||||
|
||||
;; Patches can be origins as well, so process them.
|
||||
(patches (map (match-lambda
|
||||
((? origin? patch)
|
||||
(bootstrap-origin patch))
|
||||
(patch patch))
|
||||
(origin-patches source))))
|
||||
source)))
|
||||
;; Patches can be origins as well, so process them.
|
||||
(patches (map (match-lambda
|
||||
((? origin? patch)
|
||||
(bootstrap-origin patch))
|
||||
(patch patch))
|
||||
(origin-patches source))))
|
||||
source))))
|
||||
|
||||
(define* (package-from-tarball name source program-to-test description
|
||||
#:key snippet)
|
||||
|
|
Loading…
Reference in a new issue