me
/
guix
Archived
1
0
Fork 0
Code

gnu: bootstrap: Memoize 'bootstrap-origin'. 

* gnu/packages/bootstrap.scm (bootstrap-origin): Memoize with
'mlambdaq'.  This improves memoization of origins in (gnu packages
commencement).
master
Ludovic Courtès 2019-11-03 17:59:28 +01:00
parent bf7b08c4fe
commit 7e1a74da93
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 32 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
gnu/packages/bootstrap.scm
View File

@ -149,41 +149,42 @@ for system '~a'")
;;; 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)