diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | guix/build/gnu-bootstrap.scm | 114 |
2 files changed, 115 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am index c6a2e6cf6c..0371d92d7c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -172,6 +172,7 @@ MODULES = \ guix/build/git.scm \ guix/build/hg.scm \ guix/build/glib-or-gtk-build-system.scm \ + guix/build/gnu-bootstrap.scm \ guix/build/gnu-build-system.scm \ guix/build/gnu-dist.scm \ guix/build/guile-build-system.scm \ diff --git a/guix/build/gnu-bootstrap.scm b/guix/build/gnu-bootstrap.scm new file mode 100644 index 0000000000..1cb9dc5512 --- /dev/null +++ b/guix/build/gnu-bootstrap.scm @@ -0,0 +1,114 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +;; Commentary: +;; +;; These procedures can be used to adapt the GNU Build System to build +;; pure Scheme packages targeting the bootstrap Guile. +;; +;; Code: + +(define-module (guix build gnu-bootstrap) + #:use-module (guix build utils) + #:use-module (system base compile) + #:export (bootstrap-configure + bootstrap-build + bootstrap-install)) + +(define (bootstrap-configure version modules scripts) + "Create a procedure that configures an early bootstrap package. The +procedure will search the MODULES directory and configure all of the +'.in' files with 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." + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (guile-dir (assoc-ref inputs "guile")) + (guile (string-append guile-dir "/bin/guile")) + (moddir (string-append out "/share/guile/site/" + (effective-version))) + (godir (string-append out "/lib/guile/" + (effective-version) + "/site-ccache"))) + (for-each (lambda (template) + (format #t "Configuring ~a~%" template) + (let ((target (string-drop-right template 3))) + (copy-file template target) + (substitute* target + (("@VERSION@") version)))) + (find-files modules + (lambda (fn st) + (string-suffix? ".in" fn)))) + (for-each (lambda (template) + (format #t "Configuring ~a~%" template) + (let ((target (string-drop-right template 3))) + (copy-file template target) + (substitute* target + (("@GUILE@") guile) + (("@MODDIR@") moddir) + (("@GODIR@") godir)) + (chmod target #o755))) + (find-files scripts + (lambda (fn st) + (string-suffix? ".in" fn)))) + #t))) + +(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 +'.scm' files." + (lambda _ + (add-to-load-path (getcwd)) + (for-each (lambda (scm) + (let* ((base (string-drop-right scm 4)) + (go (string-append base ".go")) + (dir (dirname scm))) + (format #t "Compiling ~a~%" scm) + (compile-file scm #:output-file go))) + (find-files modules "\\.scm$")) + #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." + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (guile-dir (assoc-ref inputs "guile")) + (guile (string-append guile-dir "/bin/guile")) + (moddir (string-append out "/share/guile/site/" + (effective-version))) + (godir (string-append out "/lib/guile/" + (effective-version) + "/site-ccache"))) + (for-each (lambda (scm) + (let* ((base (string-drop-right scm 4)) + (go (string-append base ".go")) + (dir (dirname scm))) + (format #t "Installing ~a~%" scm) + (install-file scm (string-append moddir "/" dir)) + (format #t "Installing ~a~%" go) + (install-file go (string-append godir "/" dir)))) + (find-files modules "\\.scm$")) + (for-each (lambda (script) + (format #t "Installing ~a~%" script) + (install-file script (string-append out "/bin"))) + (find-files scripts + (lambda (fn st) + (executable-file? fn)))) + #t))) |