nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

packages: Have `package-derivation' return a <derivation> as a second value. 

* guix/packages.scm (cache): Change the `drv' argument to `thunk'.
  Memoize all the return values of THUNK.
  (cached-derivation): Remove.
  (cached): New macro.
  (package-derivation): Use `cached' instead of `(or (cached-derivation) …)'.
* doc/guix.texi (Defining Packages): Update accordingly.
This commit is contained in:
Ludovic Courtès 2013-01-20 22:17:58 +01:00
parent 079fca3be8
commit e509d1527d
3 changed files with 56 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
doc/guix.texi
View File

@ -765,9 +765,8 @@ The build actions it prescribes may then be realized by using the
@code{build-derivations} procedure (@pxref{The Store}).
@deffn {Scheme Procedure} package-derivation @var{store} @var{package} [@var{system}]
Return the derivation of @var{package} for @var{system}. The result is
the file name of the derivation---i.e., a @code{.drv} file under
@code{/nix/store}.
Return the derivation path and corresponding @code{<derivation>} object
of @var{package} for @var{system} (@pxref{Derivations}).
@var{package} must be a valid @code{<package>} object, and @var{system}
must be a string denoting the target system type---e.g.,

85
guix/packages.scm
View File

@ -217,25 +217,34 @@ recursively."
;; Package to derivation-path mapping.
(make-weak-key-hash-table 100))
(define (cache package system drv)
"Memoize DRV as the derivation of PACKAGE on SYSTEM."
(define (cache package system thunk)
"Memoize the return values of THUNK as the derivation of PACKAGE on
SYSTEM."
(let ((vals (call-with-values thunk list)))
;; Use `hashq-set!' instead of `hash-set!' because `hash' returns the
;; same value for all structs (as of Guile 2.0.6), and because pointer
;; equality is sufficient in practice.
(hashq-set! %derivation-cache package `((,system ,@vals)))
(apply values vals)))
;; Use `hashq-set!' instead of `hash-set!' because `hash' returns the
;; same value for all structs (as of Guile 2.0.6), and because pointer
;; equality is sufficient in practice.
(hashq-set! %derivation-cache package `((,system . ,drv)))
drv)
(define (cached-derivation package system)
"Return the cached derivation path of PACKAGE for SYSTEM, or #f."
(match (hashq-ref %derivation-cache package)
((alist ...)
(assoc-ref alist system))
(#f #f)))
(define-syntax-rule (cached package system body ...)
"Memoize the result of BODY for the arguments PACKAGE and SYSTEM.
Return the cached result when available."
(let ((thunk (lambda () body ...)))
(match (hashq-ref %derivation-cache package)
((alist (... ...))
(match (assoc-ref alist system)
((vals (... ...))
(apply values vals))
(#f
(cache package system thunk))))
(#f
(cache package system thunk)))))
(define* (package-derivation store package
#:optional (system (%current-system)))
"Return the derivation of PACKAGE for SYSTEM."
"Return the derivation path and corresponding <derivation> object of
PACKAGE for SYSTEM."
(define (intern file)
;; Add FILE to the store. Set the `recursive?' bit to #t, so that
;; file permissions are preserved.
@ -281,32 +290,28 @@ recursively."
(package package)
(input x)))))))
(or (cached-derivation package system)
;; 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.
(cached package system
(match package
(($ <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 expand-input
(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
(match package
(($ <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 expand-input
(package-transitive-inputs package))))
(apply builder
store (package-full-name package)
(and source
(package-source-derivation store source system))
inputs
#:outputs outputs #:system system
(if (procedure? args)
(args system)
args))))))))
(apply builder
store (package-full-name package)
(and source
(package-source-derivation store source system))
inputs
#:outputs outputs #:system system
(if (procedure? args)
(args system)
args)))))))
(define* (package-cross-derivation store package)
;; TODO

11
tests/packages.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -27,6 +27,7 @@
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (rnrs io ports)
@ -70,7 +71,13 @@
("d" ,d) ("d/x" "something.drv"))
(pk 'x (package-transitive-inputs e))))))
(test-skip (if (not %store) 2 0))
(test-skip (if (not %store) 3 0))
(test-assert "return values"
(let-values (((drv-path drv)
(package-derivation %store (dummy-package "p"))))
(and (derivation-path? drv-path)
(derivation? drv))))
(test-assert "trivial"
(let* ((p (package (inherit (dummy-package "trivial"))