summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/packages.scm82
1 files changed, 51 insertions, 31 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 4e4282645a..ccfc83dd11 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -381,39 +381,59 @@ reducing the memory footprint."
(define cache-file
(string-append directory %package-cache-file))
- (define (expand-cache module symbol variable result+seen)
- (match (false-if-exception (variable-ref variable))
- ((? package? package)
- (match result+seen
- ((result . seen)
- (if (or (vhash-assq package seen)
- (hidden-package? package))
- (cons result seen)
- (cons (cons `#(,(package-name package)
- ,(package-version package)
- ,(module-name module)
- ,symbol
- ,(package-outputs package)
- ,(->bool (supported-package? package))
- ,(->bool (package-superseded package))
- ,@(let ((loc (package-location package)))
- (if loc
- `(,(location-file loc)
- ,(location-line loc)
- ,(location-column loc))
- '(#f #f #f))))
- result)
- (vhash-consq package #t seen))))))
- (_
- result+seen)))
-
- (define exp
- (first
- (fold-module-public-variables* expand-cache
- (cons '() vlist-null)
+ (define expand-cache
+ (match-lambda*
+ (((module symbol variable) (result . seen))
+ (let ((package (variable-ref variable)))
+ (if (or (vhash-assq package seen)
+ (hidden-package? package))
+ (cons result seen)
+ (cons (cons `#(,(package-name package)
+ ,(package-version package)
+ ,(module-name module)
+ ,symbol
+ ,(package-outputs package)
+ ,(->bool (supported-package? package))
+ ,(->bool (package-superseded package))
+ ,@(let ((loc (package-location package)))
+ (if loc
+ `(,(location-file loc)
+ ,(location-line loc)
+ ,(location-column loc))
+ '(#f #f #f))))
+ result)
+ (vhash-consq package #t seen)))))))
+
+ (define entry-key
+ (match-lambda
+ ((module symbol variable)
+ (let ((value (variable-ref variable)))
+ (string-append (package-name value) (package-version value)
+ (object->string module)
+ (symbol->string symbol))))))
+
+ (define (entry<? a b)
+ (string<? (entry-key a) (entry-key b)))
+
+ (define variables
+ ;; First sort variables so that 'expand-cache' later dismisses
+ ;; already-seen package objects in a deterministic fashion.
+ (sort
+ (fold-module-public-variables* (lambda (module symbol variable lst)
+ (let ((value (false-if-exception
+ (variable-ref variable))))
+ (if (package? value)
+ (cons (list module symbol variable)
+ lst)
+ lst)))
+ '()
(all-modules (%package-module-path)
#:warn
- warn-about-load-error))))
+ warn-about-load-error))
+ entry<?))
+
+ (define exp
+ (first (fold expand-cache (cons '() vlist-null) variables)))
(mkdir-p (dirname cache-file))
(call-with-output-file cache-file