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'.
This commit is contained in:
Ludovic Courtès
parent
3c85058c0e
commit
49c35bbb71
@ -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
|
||||
|
||||
125
guix/self.scm
125
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))
|
||||
(cons (string-append #$module-directory
|
||||
"/share/guile/site/"
|
||||
(effective-version))
|
||||
%load-path))
|
||||
|
||||
(set! %load-compiled-path
|
||||
(append (filter file-exists? '#$object-directories)
|
||||
%load-compiled-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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user