From 9d8100f4c7d9f44a3623419039ac985be7ba9bb3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 17 Mar 2015 21:46:00 +0100 Subject: packages: Move grafting parameter to (guix derivations). * guix/packages.scm (%graft?, set-grafting): Move to... * guix/derivations.scm: ... here. --- guix/packages.scm | 13 ------------- 1 file changed, 13 deletions(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index fc5264673d..df56286c5b 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -103,7 +103,6 @@ &package-cross-build-system-error package-cross-build-system-error? - %graft? package->bag bag->derivation bag-transitive-inputs @@ -112,9 +111,7 @@ bag-transitive-target-inputs default-guile - set-guile-for-build - set-grafting package-file package->derivation package->cross-derivation @@ -678,10 +675,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 +911,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 -- cgit v1.2.3 From ff40e9b7e55846c86f48c861816ac01bd0d7af7a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 17 Mar 2015 22:09:32 +0100 Subject: gexp: Move the package and origin compilers to (guix packages). From now own, (guix packages) depends on (guix gexps); it was the other way around now. This means that (guix packages) code can use gexps. * guix/gexp.scm (origin-compiler, package-compiler): Remove. (default-guile-derivation): New procedure. (gexp->derivation): Use it instead of 'default-guile' + 'package->derivation'. * guix/packages.scm (default-guile-derivation): New procedure. (package-compiler, origin-compiler): New variables. * doc/guix.texi (G-Expressions): Mention extensibility. --- doc/guix.texi | 5 +++++ guix/gexp.scm | 28 ++++++++++++++-------------- guix/packages.scm | 20 ++++++++++++++++++++ 3 files changed, 39 insertions(+), 14 deletions(-) (limited to 'guix/packages.scm') diff --git a/doc/guix.texi b/doc/guix.texi index fa8d3ab49e..ae2f786111 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2464,6 +2464,11 @@ processes. When a package or derivation is unquoted inside a gexp, the result is as if its output file name had been introduced. +Actually this mechanism is not limited to package and derivation +objects; @dfn{compilers} able to ``lower'' other high-level objects to +derivations can be defined, such that these objects can also be inserted +into gexps. + @item Gexps carry information about the packages or derivations they refer to, and these dependencies are automatically added as inputs to the build diff --git a/guix/gexp.scm b/guix/gexp.scm index 119fe42d52..f8646a081c 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -20,7 +20,6 @@ #:use-module (guix store) #:use-module (guix monads) #:use-module (guix derivations) - #:use-module (guix packages) #:use-module (guix utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -39,7 +38,10 @@ text-file* imported-files imported-modules - compiled-modules)) + compiled-modules + + define-gexp-compiler + gexp-compiler?)) ;;; Commentary: ;;; @@ -125,16 +127,6 @@ cross-compiling.)" body ...))) (register-compiler! name))) -(define-gexp-compiler (origin-compiler (origin origin?) system target) - ;; Compiler for origins. - (origin->derivation origin system)) - -(define-gexp-compiler (package-compiler (package package?) system target) - ;; Compiler for packages. - (if target - (package->cross-derivation package target system) - (package->derivation package system))) - ;;; ;;; Inputs & outputs. @@ -212,6 +204,15 @@ names and file names suitable for the #:allowed-references argument to (sequence %store-monad (map lower lst)))) +(define default-guile-derivation + ;; Here we break the abstraction by talking to the higher-level layer. + ;; Thus, do the resolution lazily to hide the circular dependency. + (let ((proc (delay + (let ((iface (resolve-interface '(guix packages)))) + (module-ref iface 'default-guile-derivation))))) + (lambda (system) + ((force proc) system)))) + (define* (gexp->derivation name exp #:key system (target 'current) @@ -314,8 +315,7 @@ The other arguments are as for 'derivation'." (return #f))) (guile (if guile-for-build (return guile-for-build) - (package->derivation (default-guile) - system)))) + (default-guile-derivation system)))) (mbegin %store-monad (set-grafting graft?) ;restore the initial setting (raw-derivation name diff --git a/guix/packages.scm b/guix/packages.scm index df56286c5b..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) @@ -111,6 +112,7 @@ bag-transitive-target-inputs default-guile + default-guile-derivation set-guile-for-build package-file package->derivation @@ -341,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 @@ -939,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)) @@ -976,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)) -- cgit v1.2.3