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.

doc/guix.texi

@@ -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
+Return the derivation path and corresponding @code{<derivation>} object
-the file name of the derivation---i.e., a @code{.drv} file under
+of @var{package} for @var{system} (@pxref{Derivations}).
-@code{/nix/store}.
 
 @var{package} must be a valid @code{<package>} object, and @var{system}
 must be a string denoting the target system type---e.g.,

guix/packages.scm

@@ -217,25 +217,34 @@ recursively."
   ;; Package to derivation-path mapping.
   (make-weak-key-hash-table 100))
 
-(define (cache package system drv)
+(define (cache package system thunk)
-  "Memoize DRV as the derivation of PACKAGE on SYSTEM."
+  "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
+(define-syntax-rule (cached package system body ...)
-  ;; same value for all structs (as of Guile 2.0.6), and because pointer
+  "Memoize the result of BODY for the arguments PACKAGE and SYSTEM.
-  ;; equality is sufficient in practice.
+Return the cached result when available."
-  (hashq-set! %derivation-cache package `((,system . ,drv)))
+  (let ((thunk (lambda () body ...)))
-  drv)
+    (match (hashq-ref %derivation-cache package)
-
+      ((alist (... ...))
-(define (cached-derivation package system)
+       (match (assoc-ref alist system)
-  "Return the cached derivation path of PACKAGE for SYSTEM, or #f."
+         ((vals (... ...))
-  (match (hashq-ref %derivation-cache package)
+          (apply values vals))
-    ((alist ...)
+         (#f
-     (assoc-ref alist system))
+          (cache package system thunk))))
-    (#f #f)))
+      (#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
+               (apply builder
-      ;; important because some derivations, such as the implicit inputs
+                      store (package-full-name package)
-      ;; of the GNU build system, will be queried many, many times in a
+                      (and source
-      ;; row.
+                           (package-source-derivation store source system))
-      (cache
+                      inputs
-       package system
+                      #:outputs outputs #:system system
-       (match package
+                      (if (procedure? args)
-         (($ <package> name version source (= build-system-builder builder)
+                          (args system)
-             args inputs propagated-inputs native-inputs self-native-input?
+                          args)))))))
-             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))))))))
 
 (define* (package-cross-derivation store package)
   ;; TODO

tests/packages.scm

@@ -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"))