diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/packages.scm | 82 |
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 |