summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorTimothy Sample <samplet@ngyro.com>2020-02-08 09:57:21 -0500
committerJan Nieuwenhuizen <janneke@gnu.org>2020-02-17 23:21:04 +0100
commit9c9407f746aa6ad365c0604ef9668009f4dbe8fd (patch)
tree9ffbf9d2ff9978712b16d92a2ee98cfc6db7ba5d /guix
parent1681d3f1e040cbf0fb8297fc1f557fb787ec7668 (diff)
Add (guix build gnu-bootstrap).
* guix/build/gnu-bootstrap.scm: New file. * Makefile.am (MODULES): Add it.
Diffstat (limited to 'guix')
-rw-r--r--guix/build/gnu-bootstrap.scm114
1 files changed, 114 insertions, 0 deletions
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)))