ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-26 06:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

packages: Cache the result of `package-derivation'.

Browse source 
* guix/packages.scm (%derivation-cache): New variable.
  (cache, cached-derivation): New procedures.
  (package-derivation): Use them.
This commit is contained in:
Ludovic Courtès 2012-09-01 19:21:06 +02:00
parent 8bb9f66fc6
commit a2ebaddda7
1 changed files with 62 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

99
guix/packages.scm
View file

@ -217,46 +217,71 @@ (define (package-transitive-inputs package)
((input rest ...) ((input rest ...)
(loop rest (cons input result)))))) (loop rest (cons input result))))))
;;;
;;; Package derivations.
;;;
(define %derivation-cache
;; Package to derivation-path mapping.
(make-weak-key-hash-table))
(define (cache package system drv)
"Memoize DRV as the derivation of PACKAGE on SYSTEM."
(hash-set! %derivation-cache (cons package system) drv)
drv)
(define (cached-derivation package system)
"Return the cached derivation path of PACKAGE for SYSTEM, or #f."
(hash-ref %derivation-cache (cons package system)))
(define* (package-derivation store package (define* (package-derivation store package
#:optional (system (%current-system))) #:optional (system (%current-system)))
"Return the derivation of PACKAGE for SYSTEM." "Return the derivation of PACKAGE for SYSTEM."
(match package (or (cached-derivation package system)
(($ <package> name version source (= build-system-builder builder) (match package
args inputs propagated-inputs native-inputs self-native-input? (($ <package> name version source (= build-system-builder builder)
outputs) args inputs propagated-inputs native-inputs self-native-input?
;; TODO: For `search-paths', add a builder prologue that calls outputs)
;; `set-path-environment-variable'. ;; TODO: For `search-paths', add a builder prologue that calls
(let ((inputs (map (match-lambda ;; `set-path-environment-variable'.
(((? string? name) (and package ($ <package>))) (let ((inputs (map (match-lambda
(list name (package-derivation store package))) (((? string? name) (? package? package))
(((? string? name) (and package ($ <package>)) (list name (package-derivation store package)))
(? string? sub-drv)) (((? string? name) (? package? package)
(list name (package-derivation store package) (? string? sub-drv))
sub-drv)) (list name (package-derivation store package)
(((? string? name) sub-drv))
(and (? string?) (? derivation-path?) drv)) (((? string? name)
(list name drv)) (and (? string?) (? derivation-path?) drv))
(((? string? name) (list name drv))
(and (? string?) (? file-exists? file))) (((? string? name)
;; Add FILE to the store. When FILE is in the (and (? string?) (? file-exists? file)))
;; sub-directory of a store path, it needs to be ;; Add FILE to the store. When FILE is in the
;; added anyway, so it can be used as a source. ;; sub-directory of a store path, it needs to be
(list name ;; added anyway, so it can be used as a source.
(add-to-store store (basename file) (list name
#t #f "sha256" file))) (add-to-store store (basename file)
(x #t #f "sha256" file)))
(raise (condition (&package-input-error (x
(package package) (raise (condition (&package-input-error
(input x)))))) (package package)
(package-transitive-inputs package)))) (input x))))))
(apply builder (package-transitive-inputs package))))
store (string-append name "-" version)
(package-source-derivation store source) ;; Compute the derivation and cache the result. Caching is
inputs ;; important because some derivations, such as the implicit inputs
#:outputs outputs #:system system ;; of the GNU build system, will be queried many, many times in a
(if (procedure? args) ;; row.
(args system) (cache package system
args)))))) (apply builder
store (string-append name "-" version)
(package-source-derivation store source)
inputs
#:outputs outputs #:system system
(if (procedure? args)
(args system)
args))))))))
(define* (package-cross-derivation store package) (define* (package-cross-derivation store package)
;; TODO ;; TODO