gnu-bootstrap: Allow multiple module directories.

* guix/build/gnu-bootstrap.scm (bootstrap-configure,
bootstrap-build, bootstrap-install): Treat the 'modules' argument as
a list of directories.
* gnu/packages/commencement.scm (bootar, gash-boot,
gash-utils-boot): Adjust call sites.
This commit is contained in:
Timothy Sample 2021-02-06 13:49:34 -05:00
parent 5268bd97b1
commit 0db2a6e749
No known key found for this signature in database
GPG Key ID: 2AC6A5EC1C357C59
2 changed files with 21 additions and 18 deletions

View File

@ -121,9 +121,9 @@
(invoke guile "--no-auto-compile" source) (invoke guile "--no-auto-compile" source)
(chdir "bootar")))) (chdir "bootar"))))
(replace 'configure (bootstrap-configure "Bootar" ,version (replace 'configure (bootstrap-configure "Bootar" ,version
"." "scripts")) '(".") "scripts"))
(replace 'build (bootstrap-build ".")) (replace 'build (bootstrap-build '(".")))
(replace 'install (bootstrap-install "." "scripts")))))) (replace 'install (bootstrap-install '(".") "scripts"))))))
(inputs `(("guile" ,%bootstrap-guile))) (inputs `(("guile" ,%bootstrap-guile)))
(home-page "https://git.ngyro.com/bootar") (home-page "https://git.ngyro.com/bootar")
(synopsis "Tar decompression and extraction in Guile Scheme") (synopsis "Tar decompression and extraction in Guile Scheme")
@ -158,9 +158,9 @@ pure Scheme to Tar and decompression in one easy step.")
(modify-phases %standard-phases (modify-phases %standard-phases
(replace 'configure (replace 'configure
(bootstrap-configure "Gash" ,(package-version gash) (bootstrap-configure "Gash" ,(package-version gash)
"gash" "scripts")) '("gash") "scripts"))
(replace 'build (bootstrap-build "gash")) (replace 'build (bootstrap-build '("gash")))
(replace 'install (bootstrap-install "gash" "scripts")) (replace 'install (bootstrap-install '("gash") "scripts"))
(add-after 'install 'install-symlinks (add-after 'install 'install-symlinks
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))) (let ((out (assoc-ref outputs "out")))
@ -222,9 +222,9 @@ pure Scheme to Tar and decompression in one easy step.")
(delete-file "scripts/template.in"))) (delete-file "scripts/template.in")))
(replace 'configure (replace 'configure
(bootstrap-configure "Gash-Utils" ,(package-version gash-utils) (bootstrap-configure "Gash-Utils" ,(package-version gash-utils)
"gash" "scripts")) '("gash") "scripts"))
(replace 'build (bootstrap-build "gash")) (replace 'build (bootstrap-build '("gash")))
(replace 'install (bootstrap-install "gash" "scripts")) (replace 'install (bootstrap-install '("gash") "scripts"))
;; XXX: The scripts should add Gash to their load paths and ;; XXX: The scripts should add Gash to their load paths and
;; this phase should not exist. ;; this phase should not exist.
(add-after 'install 'copy-gash (add-after 'install 'copy-gash

View File

@ -25,6 +25,7 @@
(define-module (guix build gnu-bootstrap) (define-module (guix build gnu-bootstrap)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (srfi srfi-1)
#:use-module (system base compile) #:use-module (system base compile)
#:export (bootstrap-configure #:export (bootstrap-configure
bootstrap-build bootstrap-build
@ -32,7 +33,7 @@
(define (bootstrap-configure name version modules scripts) (define (bootstrap-configure name version modules scripts)
"Create a procedure that configures an early bootstrap package. The "Create a procedure that configures an early bootstrap package. The
procedure will search the MODULES directory and configure all of the procedure will search each directory in MODULES and configure all of the
'.in' files with NAME and VERSION. It will then search the SCRIPTS '.in' files with NAME and VERSION. It will then search the SCRIPTS
directory and configure all of the '.in' files with the bootstrap directory and configure all of the '.in' files with the bootstrap
Guile and its module and object directories." Guile and its module and object directories."
@ -52,9 +53,8 @@ Guile and its module and object directories."
(substitute* target (substitute* target
(("@PACKAGE_NAME@") name) (("@PACKAGE_NAME@") name)
(("@VERSION@") version)))) (("@VERSION@") version))))
(find-files modules (append-map (lambda (dir) (find-files dir "\\.in$"))
(lambda (fn st) modules))
(string-suffix? ".in" fn))))
(for-each (lambda (template) (for-each (lambda (template)
(format #t "Configuring ~a~%" template) (format #t "Configuring ~a~%" template)
(let ((target (string-drop-right template 3))) (let ((target (string-drop-right template 3)))
@ -71,7 +71,7 @@ Guile and its module and object directories."
(define (bootstrap-build modules) (define (bootstrap-build modules)
"Create a procedure that builds an early bootstrap package. The "Create a procedure that builds an early bootstrap package. The
procedure will search the MODULES directory and compile all of the procedure will search each directory in MODULES and compile all of the
'.scm' files." '.scm' files."
(lambda _ (lambda _
(add-to-load-path (getcwd)) (add-to-load-path (getcwd))
@ -81,13 +81,15 @@ procedure will search the MODULES directory and compile all of the
(dir (dirname scm))) (dir (dirname scm)))
(format #t "Compiling ~a~%" scm) (format #t "Compiling ~a~%" scm)
(compile-file scm #:output-file go))) (compile-file scm #:output-file go)))
(find-files modules "\\.scm$")) (append-map (lambda (dir) (find-files dir "\\.scm$"))
modules))
#t)) #t))
(define (bootstrap-install modules scripts) (define (bootstrap-install modules scripts)
"Create a procedure that installs an early bootstrap package. The "Create a procedure that installs an early bootstrap package. The
procedure will install all of the '.scm' and '.go' files in the MODULES procedure will install all of the '.scm' and '.go' files in each of the
directory, and all the executable files in the SCRIPTS directory." directories in MODULES, and all the executable files in the SCRIPTS
directory."
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(guile-dir (assoc-ref inputs "guile")) (guile-dir (assoc-ref inputs "guile"))
@ -105,7 +107,8 @@ directory, and all the executable files in the SCRIPTS directory."
(install-file scm (string-append moddir "/" dir)) (install-file scm (string-append moddir "/" dir))
(format #t "Installing ~a~%" go) (format #t "Installing ~a~%" go)
(install-file go (string-append godir "/" dir)))) (install-file go (string-append godir "/" dir))))
(find-files modules "\\.scm$")) (append-map (lambda (dir) (find-files dir "\\.scm$"))
modules))
(for-each (lambda (script) (for-each (lambda (script)
(format #t "Installing ~a~%" script) (format #t "Installing ~a~%" script)
(install-file script (string-append out "/bin"))) (install-file script (string-append out "/bin")))