diff options
| -rw-r--r-- | guix/channels.scm | 24 | ||||
| -rw-r--r-- | guix/self.scm | 125 |
2 files changed, 100 insertions, 49 deletions
diff --git a/guix/channels.scm b/guix/channels.scm index 75503bb0ae..6b860f3bd8 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. @@ -335,6 +335,26 @@ modules in the old ~/.config/guix/latest style." (define packages (resolve-interface '(gnu packages guile))) + (define modules+compiled + ;; Since MODULES contains both .scm and .go files at its root, re-bundle + ;; it so that it has share/guile/site and lib/guile, which is what + ;; 'whole-package' expects. + (computed-file (derivation-name modules) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (define version + (effective-version)) + (define share + (string-append #$output "/share/guile/site")) + (define lib + (string-append #$output "/lib/guile/" version)) + + (mkdir-p share) (mkdir-p lib) + (symlink #$modules (string-append share "/" version)) + (symlink #$modules (string-append lib "/site-ccache")))))) + (letrec-syntax ((list (syntax-rules (->) ((_) '()) @@ -346,7 +366,7 @@ modules in the old ~/.config/guix/latest style." ((_ variable rest ...) (cons (module-ref packages 'variable) (list rest ...)))))) - (whole-package name modules + (whole-package name modules+compiled ;; In the "old style", %SELF-BUILD-FILE would simply return a ;; derivation that builds modules. We have to infer what the diff --git a/guix/self.scm b/guix/self.scm index 2664fd886f..1e9d5b70e5 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -133,6 +133,30 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." #:name (file-mapping-name mapping) #:system system)) +(define (node-source+compiled node) + "Return a \"bundle\" containing both the source code and object files for +NODE's modules, under their FHS directories: share/guile/site and lib/guile." + (define build + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (define source + (string-append #$output "/share/guile/site/" + (effective-version))) + + (define object + (string-append #$output "/lib/guile/" (effective-version) + "/site-ccache")) + + (mkdir-p (dirname source)) + (symlink #$(node-source node) source) + (mkdir-p (dirname object)) + (symlink #$(node-compiled node) object)))) + + (computed-file (string-append (node-name node) "-modules") + build)) + (define (node-fold proc init nodes) (let loop ((nodes nodes) (visited (setq)) @@ -364,36 +388,53 @@ DOMAIN, a gettext domain." (computed-file "guix-manual" build)) -(define* (guix-command modules #:optional compiled-modules +(define* (guile-module-union things #:key (name "guix-module-union")) + "Return the union of the subset of THINGS (packages, computed files, etc.) +that provide Guile modules." + (define build + (with-imported-modules '((guix build union)) + #~(begin + (use-modules (guix build union)) + + (define (modules directory) + (string-append directory "/share/guile/site")) + + (define (objects directory) + (string-append directory "/lib/guile")) + + (union-build #$output + (filter (lambda (directory) + (or (file-exists? (modules directory)) + (file-exists? (objects directory)))) + '#$things) + + #:log-port (%make-void-port "w"))))) + + (computed-file name build)) + +(define* (guix-command modules #:key source (dependencies '()) guile (guile-version (effective-version))) "Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its load path." - (define source-directories - (map (lambda (package) - (file-append package "/share/guile/site/" - guile-version)) - dependencies)) - - (define object-directories - (map (lambda (package) - (file-append package "/lib/guile/" - guile-version "/site-ccache")) - dependencies)) + (define module-directory + ;; To minimize the number of 'stat' calls needed to locate a module, + ;; create the union of all the module directories. + (guile-module-union (cons modules dependencies))) (program-file "guix-command" #~(begin (set! %load-path - (append (filter file-exists? '#$source-directories) - %load-path)) - - (set! %load-compiled-path - (append (filter file-exists? '#$object-directories) - %load-compiled-path)) + (cons (string-append #$module-directory + "/share/guile/site/" + (effective-version)) + %load-path)) - (set! %load-path (cons #$modules %load-path)) (set! %load-compiled-path - (cons (or #$compiled-modules #$modules) + (cons (string-append #$module-directory + "/lib/guile/" + (effective-version) + "/site-ccache") %load-compiled-path)) (let ((guix-main (module-ref (resolve-interface '(guix ui)) @@ -436,7 +477,6 @@ load path." (define* (whole-package name modules dependencies #:key (guile-version (effective-version)) - compiled-modules info daemon miscellany guile (command (guix-command modules @@ -444,10 +484,9 @@ load path." #:guile guile #:guile-version guile-version))) "Return the whole Guix package NAME that uses MODULES, a derivation of all -the modules, and DEPENDENCIES, a list of packages depended on. COMMAND is the -'guix' program to use; INFO is the Info manual. When COMPILED-MODULES is -true, it is linked as 'lib/guile/X.Y/site-ccache'; otherwise, .go files are -assumed to be part of MODULES." +the modules (under share/guile/site and lib/guile), and DEPENDENCIES, a list +of packages depended on. COMMAND is the 'guix' program to use; INFO is the +Info manual." (computed-file name (with-imported-modules '((guix build utils)) #~(begin @@ -461,28 +500,22 @@ assumed to be part of MODULES." (symlink (string-append #$daemon "/bin/guix-daemon") (string-append #$output "/bin/guix-daemon"))) - (let ((modules (string-append #$output - "/share/guile/site/" - (effective-version))) - (info #$info)) - (mkdir-p (dirname modules)) - (symlink #$modules modules) + (let ((share (string-append #$output "/share")) + (lib (string-append #$output "/lib")) + (info #$info)) + (mkdir-p share) + (symlink #$(file-append modules "/share/guile") + (string-append share "/guile")) (when info - (symlink #$info - (string-append #$output - "/share/info")))) + (symlink #$info (string-append share "/info"))) + + (mkdir-p lib) + (symlink #$(file-append modules "/lib/guile") + (string-append lib "/guile"))) (when #$miscellany (copy-recursively #$miscellany #$output - #:log (%make-void-port "w"))) - - ;; Object files. - (when #$compiled-modules - (let ((modules (string-append #$output "/lib/guile/" - (effective-version) - "/site-ccache"))) - (mkdir-p (dirname modules)) - (symlink #$compiled-modules modules))))))) + #:log (%make-void-port "w"))))))) (define* (compiled-guix source #:key (version %guix-version) (pull-version 1) @@ -681,15 +714,13 @@ assumed to be part of MODULES." ;; Version 1 is when we return the full package. (cond ((= 1 pull-version) ;; The whole package, with a standard file hierarchy. - (let* ((modules (built-modules (compose list node-source))) - (compiled (built-modules (compose list node-compiled))) - (command (guix-command modules compiled + (let* ((modules (built-modules (compose list node-source+compiled))) + (command (guix-command modules #:source source #:dependencies dependencies #:guile guile-for-build #:guile-version guile-version))) (whole-package name modules dependencies - #:compiled-modules compiled #:command command #:guile guile-for-build |