me
/
guix
Archived
1
0
Fork 0

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'.
master
Ludovic Courtès 2019-01-07 22:57:34 +01:00
parent 3c85058c0e
commit 49c35bbb71
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 100 additions and 49 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -335,6 +335,26 @@ modules in the old ~/.config/guix/latest style."
(define packages (define packages
(resolve-interface '(gnu packages guile))) (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 (->) (letrec-syntax ((list (syntax-rules (->)
((_) ((_)
'()) '())
@ -346,7 +366,7 @@ modules in the old ~/.config/guix/latest style."
((_ variable rest ...) ((_ variable rest ...)
(cons (module-ref packages 'variable) (cons (module-ref packages 'variable)
(list rest ...)))))) (list rest ...))))))
(whole-package name modules (whole-package name modules+compiled
;; In the "old style", %SELF-BUILD-FILE would simply return a ;; In the "old style", %SELF-BUILD-FILE would simply return a
;; derivation that builds modules. We have to infer what the ;; derivation that builds modules. We have to infer what the

View File

@ -133,6 +133,30 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches."
#:name (file-mapping-name mapping) #:name (file-mapping-name mapping)
#:system system)) #: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) (define (node-fold proc init nodes)
(let loop ((nodes nodes) (let loop ((nodes nodes)
(visited (setq)) (visited (setq))
@ -364,36 +388,53 @@ DOMAIN, a gettext domain."
(computed-file "guix-manual" build)) (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 '()) #:key source (dependencies '())
guile (guile-version (effective-version))) guile (guile-version (effective-version)))
"Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its "Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its
load path." load path."
(define source-directories (define module-directory
(map (lambda (package) ;; To minimize the number of 'stat' calls needed to locate a module,
(file-append package "/share/guile/site/" ;; create the union of all the module directories.
guile-version)) (guile-module-union (cons modules dependencies)))
dependencies))
(define object-directories
(map (lambda (package)
(file-append package "/lib/guile/"
guile-version "/site-ccache"))
dependencies))
(program-file "guix-command" (program-file "guix-command"
#~(begin #~(begin
(set! %load-path (set! %load-path
(append (filter file-exists? '#$source-directories) (cons (string-append #$module-directory
"/share/guile/site/"
(effective-version))
%load-path)) %load-path))
(set! %load-compiled-path (set! %load-compiled-path
(append (filter file-exists? '#$object-directories) (cons (string-append #$module-directory
%load-compiled-path)) "/lib/guile/"
(effective-version)
(set! %load-path (cons #$modules %load-path)) "/site-ccache")
(set! %load-compiled-path
(cons (or #$compiled-modules #$modules)
%load-compiled-path)) %load-compiled-path))
(let ((guix-main (module-ref (resolve-interface '(guix ui)) (let ((guix-main (module-ref (resolve-interface '(guix ui))
@ -436,7 +477,6 @@ load path."
(define* (whole-package name modules dependencies (define* (whole-package name modules dependencies
#:key #:key
(guile-version (effective-version)) (guile-version (effective-version))
compiled-modules
info daemon miscellany info daemon miscellany
guile guile
(command (guix-command modules (command (guix-command modules
@ -444,10 +484,9 @@ load path."
#:guile guile #:guile guile
#:guile-version guile-version))) #:guile-version guile-version)))
"Return the whole Guix package NAME that uses MODULES, a derivation of all "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 the modules (under share/guile/site and lib/guile), and DEPENDENCIES, a list
'guix' program to use; INFO is the Info manual. When COMPILED-MODULES is of packages depended on. COMMAND is the 'guix' program to use; INFO is the
true, it is linked as 'lib/guile/X.Y/site-ccache'; otherwise, .go files are Info manual."
assumed to be part of MODULES."
(computed-file name (computed-file name
(with-imported-modules '((guix build utils)) (with-imported-modules '((guix build utils))
#~(begin #~(begin
@ -461,28 +500,22 @@ assumed to be part of MODULES."
(symlink (string-append #$daemon "/bin/guix-daemon") (symlink (string-append #$daemon "/bin/guix-daemon")
(string-append #$output "/bin/guix-daemon"))) (string-append #$output "/bin/guix-daemon")))
(let ((modules (string-append #$output (let ((share (string-append #$output "/share"))
"/share/guile/site/" (lib (string-append #$output "/lib"))
(effective-version)))
(info #$info)) (info #$info))
(mkdir-p (dirname modules)) (mkdir-p share)
(symlink #$modules modules) (symlink #$(file-append modules "/share/guile")
(string-append share "/guile"))
(when info (when info
(symlink #$info (symlink #$info (string-append share "/info")))
(string-append #$output
"/share/info")))) (mkdir-p lib)
(symlink #$(file-append modules "/lib/guile")
(string-append lib "/guile")))
(when #$miscellany (when #$miscellany
(copy-recursively #$miscellany #$output (copy-recursively #$miscellany #$output
#:log (%make-void-port "w"))) #: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)))))))
(define* (compiled-guix source #:key (version %guix-version) (define* (compiled-guix source #:key (version %guix-version)
(pull-version 1) (pull-version 1)
@ -681,15 +714,13 @@ assumed to be part of MODULES."
;; Version 1 is when we return the full package. ;; Version 1 is when we return the full package.
(cond ((= 1 pull-version) (cond ((= 1 pull-version)
;; The whole package, with a standard file hierarchy. ;; The whole package, with a standard file hierarchy.
(let* ((modules (built-modules (compose list node-source))) (let* ((modules (built-modules (compose list node-source+compiled)))
(compiled (built-modules (compose list node-compiled))) (command (guix-command modules
(command (guix-command modules compiled
#:source source #:source source
#:dependencies dependencies #:dependencies dependencies
#:guile guile-for-build #:guile guile-for-build
#:guile-version guile-version))) #:guile-version guile-version)))
(whole-package name modules dependencies (whole-package name modules dependencies
#:compiled-modules compiled
#:command command #:command command
#:guile guile-for-build #:guile guile-for-build