summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-07 22:57:34 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-07 23:50:56 +0100
commit49c35bbb71f80bdd7c01b4d74e08335c3ec5331c (patch)
treefb35f824e710ac3b401b69c02ea5d3b342fa89bb
parent3c85058c0e29fdff5269cff58f43dfbad92259b6 (diff)
downloadguix-49c35bbb71f80bdd7c01b4d74e08335c3ec5331c.tar.gz
self: Move all modules into a single directory.
This halves the number of elements in %LOAD-PATH and %LOAD-COMPILED-PATH
and halves the number of 'stat' calls as reported by:

  env -i $(type -P guix) build -e '(@ (gnu packages base) coreutils)' -nd

* guix/self.scm (node-source+compiled, guile-module-union): New
procedures.
(guix-command): Remove 'compiled-modules' parameter.  Remove
'source-directories' and 'object-directories' variables and add
'module-directory'.  Change command so that it adds nothing but
MODULE-DIRECTORY to %LOAD-PATH and %LOAD-COMPILED-PATH.
(whole-package): Remove #:compiled-modules.  Assume MODULES contains
'share/guile/site' and 'lib/guile' and adjust code accordingly.
(compiled-guix): When PULL-VERSION is 1, use 'node-source+compiled'
only.  Remove #:compiled-modules argument to 'whole-package'.
* guix/channels.scm (whole-package-for-legacy): Add 'module+compiled'
and pass it to 'whole-package'.
-rw-r--r--guix/channels.scm24
-rw-r--r--guix/self.scm125
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