03/12: gnu-bootstrap: Allow multiple module directories.

[guix-commits]

samplet pushed a commit to branch core-updates
in repository guix.

commit 0db2a6e74952ee2c99d47e9580aac9d7fe657b16
Author: Timothy Sample <samplet@ngyro.com>
AuthorDate: Sat Feb 6 13:49:34 2021 -0500

    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.
---
 gnu/packages/commencement.scm | 18 +++++++++---------
 guix/build/gnu-bootstrap.scm  | 21 ++++++++++++---------
 2 files changed, 21 insertions(+), 18 deletions(-)

diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index 644db8cc58..fd3a9c37e7 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -121,9 +121,9 @@
                  (invoke guile "--no-auto-compile" source)
                  (chdir "bootar"))))
            (replace 'configure (bootstrap-configure "Bootar" ,version
-                                                    "." "scripts"))
-           (replace 'build (bootstrap-build "."))
-           (replace 'install (bootstrap-install "." "scripts"))))))
+                                                    '(".") "scripts"))
+           (replace 'build (bootstrap-build '(".")))
+           (replace 'install (bootstrap-install '(".") "scripts"))))))
     (inputs `(("guile" ,%bootstrap-guile)))
     (home-page "https://git.ngyro.com/bootar";)
     (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
            (replace 'configure
              (bootstrap-configure "Gash" ,(package-version gash)
-                                  "gash" "scripts"))
-           (replace 'build (bootstrap-build "gash"))
-           (replace 'install (bootstrap-install "gash" "scripts"))
+                                  '("gash") "scripts"))
+           (replace 'build (bootstrap-build '("gash")))
+           (replace 'install (bootstrap-install '("gash") "scripts"))
            (add-after 'install 'install-symlinks
              (lambda* (#:key outputs #:allow-other-keys)
                (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")))
            (replace 'configure
              (bootstrap-configure "Gash-Utils" ,(package-version gash-utils)
-                                  "gash" "scripts"))
-           (replace 'build (bootstrap-build "gash"))
-           (replace 'install (bootstrap-install "gash" "scripts"))
+                                  '("gash") "scripts"))
+           (replace 'build (bootstrap-build '("gash")))
+           (replace 'install (bootstrap-install '("gash") "scripts"))
            ;; XXX: The scripts should add Gash to their load paths and
            ;; this phase should not exist.
            (add-after 'install 'copy-gash
diff --git a/guix/build/gnu-bootstrap.scm b/guix/build/gnu-bootstrap.scm
index 7ca6ae8458..b4257a3717 100644
--- a/guix/build/gnu-bootstrap.scm
+++ b/guix/build/gnu-bootstrap.scm
@@ -25,6 +25,7 @@
 
 (define-module (guix build gnu-bootstrap)
   #:use-module (guix build utils)
+  #:use-module (srfi srfi-1)
   #:use-module (system base compile)
   #:export (bootstrap-configure
             bootstrap-build
@@ -32,7 +33,7 @@
 
 (define (bootstrap-configure name version modules scripts)
   "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
 directory and configure all of the '.in' files with the bootstrap
 Guile and its module and object directories."
@@ -52,9 +53,8 @@ Guile and its module and object directories."
                     (substitute* target
                       (("@PACKAGE_NAME@") name)
                       (("@VERSION@") version))))
-                (find-files modules
-                            (lambda (fn st)
-                              (string-suffix? ".in" fn))))
+                (append-map (lambda (dir) (find-files dir "\\.in$"))
+                            modules))
       (for-each (lambda (template)
                   (format #t "Configuring ~a~%" template)
                   (let ((target (string-drop-right template 3)))
@@ -71,7 +71,7 @@ Guile and its module and object directories."
 
 (define (bootstrap-build modules)
   "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."
   (lambda _
     (add-to-load-path (getcwd))
@@ -81,13 +81,15 @@ procedure will search the MODULES directory and compile all 
of the
                        (dir (dirname scm)))
                   (format #t "Compiling ~a~%" scm)
                   (compile-file scm #:output-file go)))
-              (find-files modules "\\.scm$"))
+              (append-map (lambda (dir) (find-files dir "\\.scm$"))
+                          modules))
     #t))
 
 (define (bootstrap-install modules scripts)
   "Create a procedure that installs an early bootstrap package.  The
-procedure will install all of the '.scm' and '.go' files in the MODULES
-directory, and all the executable files in the SCRIPTS directory."
+procedure will install all of the '.scm' and '.go' files in each of the
+directories in MODULES, and all the executable files in the SCRIPTS
+directory."
   (lambda* (#:key inputs outputs #:allow-other-keys)
     (let* ((out (assoc-ref outputs "out"))
            (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))
                     (format #t "Installing ~a~%" go)
                     (install-file go (string-append godir "/" dir))))
-                (find-files modules "\\.scm$"))
+                (append-map (lambda (dir) (find-files dir "\\.scm$"))
+                            modules))
       (for-each (lambda (script)
                   (format #t "Installing ~a~%" script)
                   (install-file script (string-append out "/bin")))