summaryrefslogtreecommitdiff
path: root/gnu/packages.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-11 17:23:39 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-15 20:24:09 +0100
commit5fbdc9a5aa63fd51c65d30fe3d30608d01fe1bc8 (patch)
treeab2940f0c7250e8267609e3db9f6e4b517bd0546 /gnu/packages.scm
parent1d90e9d7c906b1e9e94d1642bfd60c51609fd0df (diff)
downloadpatches-5fbdc9a5aa63fd51c65d30fe3d30608d01fe1bc8.tar
patches-5fbdc9a5aa63fd51c65d30fe3d30608d01fe1bc8.tar.gz
channels: Compute a package cache and use it.
* gnu/packages.scm (cache-is-authoritative?, load-package-cache) (cache-lookup, generate-package-cache): New procedures. (%package-cache-file): New variable. (find-packages-by-name): Rename to... (find-packages-by-name/direct): ... this. (find-packages-by-name): Rewrite to use the package cache when 'cache-is-authoritative?' returns true. * tests/packages.scm ("find-packages-by-name + version, with cache") ("find-packages-by-name with cache"): New tests. * guix/channels.scm (package-cache-file): New procedure. (%channel-profile-hooks): New variable. (channel-instances->derivation): Use it in #:hooks. * guix/scripts/package.scm (build-and-use-profile): Add #:hooks and honor it. * guix/scripts/pull.scm (build-and-install): Pass #:hooks to UPDATE-PROFILE.
Diffstat (limited to 'gnu/packages.scm')
-rw-r--r--gnu/packages.scm127
1 files changed, 124 insertions, 3 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 4a85cf4b87..6796db80a4 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -28,11 +28,14 @@
#:use-module (guix memoization)
#:use-module ((guix build utils)
#:select ((package-name->name+version
- . hyphen-separated-name->name+version)))
+ . hyphen-separated-name->name+version)
+ mkdir-p))
#:autoload (guix profiles) (packages->manifest)
#:use-module (guix describe)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
+ #:autoload (ice-9 binary-ports) (put-bytevector)
+ #:autoload (system base compile) (compile)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
@@ -56,7 +59,9 @@
specification->package
specification->package+output
- specifications->manifest))
+ specifications->manifest
+
+ generate-package-cache))
;;; Commentary:
;;;
@@ -135,6 +140,14 @@ for system '~a'")
;; Default search path for package modules.
`((,%distro-root-directory . "gnu/packages")))
+(define (cache-is-authoritative?)
+ "Return true if the pre-computed package cache is authoritative. It is not
+authoritative when entries have been added via GUIX_PACKAGE_PATH or '-L'
+flags."
+ (equal? (%package-module-path)
+ (append %default-package-module-path
+ (package-path-entries))))
+
(define %package-module-path
;; Search path for package modules. Each item must be either a directory
;; name or a pair whose car is a directory and whose cdr is a sub-directory
@@ -183,7 +196,35 @@ is guaranteed to never traverse the same package twice."
init
modules))
-(define find-packages-by-name
+(define %package-cache-file
+ ;; Location of the package cache.
+ "/lib/guix/package.cache")
+
+(define load-package-cache
+ (mlambda (profile)
+ "Attempt to load the package cache. On success return a vhash keyed by
+package names. Return #f on failure."
+ (match profile
+ (#f #f)
+ (profile
+ (catch 'system-error
+ (lambda ()
+ (define lst
+ (load-compiled (string-append profile %package-cache-file)))
+ (fold (lambda (item vhash)
+ (match item
+ (#(name version module symbol outputs
+ supported? deprecated?
+ file line column)
+ (vhash-cons name item vhash))))
+ vlist-null
+ lst))
+ (lambda args
+ (if (= ENOENT (system-error-errno args))
+ #f
+ (apply throw args))))))))
+
+(define find-packages-by-name/direct ;bypass the cache
(let ((packages (delay
(fold-packages (lambda (p r)
(vhash-cons (package-name p) p r))
@@ -202,6 +243,37 @@ decreasing version order."
matching)
matching)))))
+(define (cache-lookup cache name)
+ "Lookup package NAME in CACHE. Return a list sorted in increasing version
+order."
+ (define (package-version<? v1 v2)
+ (version>? (vector-ref v2 1) (vector-ref v1 1)))
+
+ (sort (vhash-fold* cons '() name cache)
+ package-version<?))
+
+(define* (find-packages-by-name name #:optional version)
+ "Return the list of packages with the given NAME. If VERSION is not #f,
+then only return packages whose version is prefixed by VERSION, sorted in
+decreasing version order."
+ (define cache
+ (load-package-cache (current-profile)))
+
+ (if (and (cache-is-authoritative?) cache)
+ (match (cache-lookup cache name)
+ (#f #f)
+ ((#(_ versions modules symbols _ _ _ _ _ _) ...)
+ (fold (lambda (version* module symbol result)
+ (if (or (not version)
+ (version-prefix? version version*))
+ (cons (module-ref (resolve-interface module)
+ symbol)
+ result)
+ result))
+ '()
+ versions modules symbols)))
+ (find-packages-by-name/direct name version)))
+
(define (find-best-packages-by-name name version)
"If version is #f, return the list of packages named NAME with the highest
version numbers; otherwise, return the list of packages named NAME and at
@@ -218,6 +290,55 @@ VERSION."
(string=? (package-version p) highest))
matches))))))
+(define (generate-package-cache directory)
+ "Generate under DIRECTORY a cache of all the available packages.
+
+The primary purpose of the cache is to speed up package lookup by name such
+that we don't have to traverse and load all the package modules, thereby also
+reducing the memory footprint."
+ (define cache-file
+ (string-append directory %package-cache-file))
+
+ (define (expand-cache module symbol variable result)
+ (match (false-if-exception (variable-ref variable))
+ ((? package? package)
+ (if (hidden-package? package)
+ result
+ (cons `#(,(package-name package)
+ ,(package-version package)
+ ,(module-name module)
+ ,symbol
+ ,(package-outputs package)
+ ,(->bool (member (%current-system)
+ (package-supported-systems 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)))
+ (_
+ result)))
+
+ (define exp
+ (fold-module-public-variables* expand-cache '()
+ (all-modules (%package-module-path)
+ #:warn
+ warn-about-load-error)))
+
+ (mkdir-p (dirname cache-file))
+ (call-with-output-file cache-file
+ (lambda (port)
+ ;; Store the cache as a '.go' file. This makes loading fast and reduces
+ ;; heap usage since some of the static data is directly mmapped.
+ (put-bytevector port
+ (compile `'(,@exp)
+ #:to 'bytecode
+ #:opts '(#:to-file? #t)))))
+ cache-file)
+
(define %sigint-prompt
;; The prompt to jump to upon SIGINT.