diff --git a/guix/packages.scm b/guix/packages.scm index 0ecd4ca6d4..2ab45f9fb4 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -217,46 +217,71 @@ with their propagated inputs, recursively." ((input rest ...) (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 #:optional (system (%current-system))) "Return the derivation of PACKAGE for SYSTEM." - (match package - (($ name version source (= build-system-builder builder) - args inputs propagated-inputs native-inputs self-native-input? - outputs) - ;; TODO: For `search-paths', add a builder prologue that calls - ;; `set-path-environment-variable'. - (let ((inputs (map (match-lambda - (((? string? name) (and package ($ ))) - (list name (package-derivation store package))) - (((? string? name) (and package ($ )) - (? string? sub-drv)) - (list name (package-derivation store package) - sub-drv)) - (((? string? name) - (and (? string?) (? derivation-path?) drv)) - (list name drv)) - (((? string? name) - (and (? string?) (? file-exists? file))) - ;; Add FILE to the store. When FILE is in the - ;; sub-directory of a store path, it needs to be - ;; added anyway, so it can be used as a source. - (list name - (add-to-store store (basename file) - #t #f "sha256" file))) - (x - (raise (condition (&package-input-error - (package package) - (input x)))))) - (package-transitive-inputs package)))) - (apply builder - store (string-append name "-" version) - (package-source-derivation store source) - inputs - #:outputs outputs #:system system - (if (procedure? args) - (args system) - args)))))) + (or (cached-derivation package system) + (match package + (($ name version source (= build-system-builder builder) + args inputs propagated-inputs native-inputs self-native-input? + outputs) + ;; TODO: For `search-paths', add a builder prologue that calls + ;; `set-path-environment-variable'. + (let ((inputs (map (match-lambda + (((? string? name) (? package? package)) + (list name (package-derivation store package))) + (((? string? name) (? package? package) + (? string? sub-drv)) + (list name (package-derivation store package) + sub-drv)) + (((? string? name) + (and (? string?) (? derivation-path?) drv)) + (list name drv)) + (((? string? name) + (and (? string?) (? file-exists? file))) + ;; Add FILE to the store. When FILE is in the + ;; sub-directory of a store path, it needs to be + ;; added anyway, so it can be used as a source. + (list name + (add-to-store store (basename file) + #t #f "sha256" file))) + (x + (raise (condition (&package-input-error + (package package) + (input x)))))) + (package-transitive-inputs package)))) + + ;; Compute the derivation and cache the result. Caching is + ;; important because some derivations, such as the implicit inputs + ;; of the GNU build system, will be queried many, many times in a + ;; row. + (cache package system + (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) ;; TODO