Merge branch 'master' into core-updates

1 files changed, 20 insertions, 13 deletions

diff --git a/guix/packages.scm b/guix/packages.scm
index fc5264673d..ec0e79d08b 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -22,6 +22,7 @@
   #:use-module (guix records)
   #:use-module (guix store)
   #:use-module (guix monads)
+  #:use-module (guix gexp)
   #:use-module (guix base32)
   #:use-module (guix derivations)
   #:use-module (guix build-system)
@@ -103,7 +104,6 @@
             &package-cross-build-system-error
             package-cross-build-system-error?
 
-            %graft?
             package->bag
             bag->derivation
             bag-transitive-inputs
@@ -112,9 +112,8 @@
             bag-transitive-target-inputs
 
             default-guile
-
+            default-guile-derivation
             set-guile-for-build
-            set-grafting
             package-file
             package->derivation
             package->cross-derivation
@@ -344,6 +343,12 @@ derivations."
   (let ((distro (resolve-interface '(gnu packages commencement))))
     (module-ref distro 'guile-final)))
 
+(define* (default-guile-derivation #:optional (system (%current-system)))
+  "Return the derivation for SYSTEM of the default Guile package used to run
+the build code of derivation."
+  (package->derivation (default-guile) system
+                       #:graft? #f))
+
 ;; TODO: Rewrite using %STORE-MONAD and gexps.
 (define* (patch-and-repack store source patches
                            #:key
@@ -678,10 +683,6 @@ information in exceptions."
                         (package package)
                         (input   x)))))))
 
-(define %graft?
-  ;; Whether to honor package grafts by default.
-  (make-parameter #t))
-
 (define* (package->bag package #:optional
                        (system (%current-system))
                        (target (%current-target-system))
@@ -918,12 +919,6 @@ code of derivations to GUILE, a package object."
     (let ((guile (package-derivation store guile)))
       (values (%guile-for-build guile) store))))
 
-(define (set-grafting enable?)
-  "This monadic procedure enables grafting when ENABLE? is true, and disables
-it otherwise.  It returns the previous setting."
-  (lambda (store)
-    (values (%graft? enable?) store)))
-
 (define* (package-file package
                        #:optional file
                        #:key
@@ -952,6 +947,13 @@ cross-compilation target triplet."
 (define package->cross-derivation
   (store-lift package-cross-derivation))
 
+(define-gexp-compiler (package-compiler (package package?) system target)
+  ;; Compile PACKAGE to a derivation for SYSTEM, optionally cross-compiled for
+  ;; TARGET.  This is used when referring to a package from within a gexp.
+  (if target
+      (package->cross-derivation package target system)
+      (package->derivation package system)))
+
 (define patch-and-repack*
   (store-lift patch-and-repack))
 
@@ -989,5 +991,10 @@ outside of the store) or SOURCE itself (if SOURCE is already a store item.)"
      (interned-file file (basename file)
                     #:recursive? #t))))
 
+(define-gexp-compiler (origin-compiler (origin origin?) system target)
+  ;; Compile ORIGIN to a derivation for SYSTEM.  This is used when referring
+  ;; to an origin from within a gexp.
+  (origin->derivation origin system))
+
 (define package-source-derivation
   (store-lower origin->derivation))