aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-11-03 17:59:28 +0100
committerLudovic Courtès <ludo@gnu.org>2019-11-04 23:35:31 +0100
commit7e1a74da93319a3b413854a052af1e9ccca02bdc (patch)
treef8dd692a43b5951c1c02452eef4d3bb30ccd8b98
parentbf7b08c4fe7d14c25a83bde99f19eca1119d88ff (diff)
downloadpatches-7e1a74da93319a3b413854a052af1e9ccca02bdc.tar
patches-7e1a74da93319a3b413854a052af1e9ccca02bdc.tar.gz
gnu: bootstrap: Memoize 'bootstrap-origin'.
* gnu/packages/bootstrap.scm (bootstrap-origin): Memoize with 'mlambdaq'. This improves memoization of origins in (gnu packages commencement).
-rw-r--r--gnu/packages/bootstrap.scm69
1 files changed, 35 insertions, 34 deletions
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index c6e3c697e6..d6995f104c 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -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 %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)
-
- ;; 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 (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)))
+
+ (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))))
(define* (package-from-tarball name source program-to-test description
#:key snippet)