;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Federico Beffa ;;; Copyright © 2016 Efraim Flashner ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice ;;; Copyright © 2019 Brett Gilio ;;; Copyright © 2020 Brendan Tildesley ;;; Copyright © 2021, 2022 Philip McGrath ;;; ;;; 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 . (define-module (gnu packages chez-and-racket-bootstrap) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix git-download) #:use-module (guix utils) #:use-module (guix gexp) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (guix build-system gnu) #:use-module (gnu packages) #:use-module (gnu packages compression) #:use-module (gnu packages ghostscript) #:use-module (gnu packages linux) #:use-module (gnu packages ncurses) #:use-module (gnu packages netpbm) #:use-module (gnu packages tex) #:use-module (gnu packages xorg) #:use-module ((guix licenses) #:prefix license:)) ;; Commentary: ;; ;; Alphabetically and chronologically, Chez comes before Racket. ;; ;; The bootstrapping paths for Chez Scheme and Racket are closely ;; entwined. Racket CS (the default Racket implementation) is based on (a fork ;; of) Chez Scheme. Racket's variant of Chez Scheme shares sources for ;; nanopass and stex with upstream Chez Scheme. ;; ;; Racket's variant of Chez Scheme can be bootstrapped by an older Racket ;; implementation, Racket BC, which can be bootstrapped from C. Porting that ;; code to work with upstream Chez Scheme (or finding an old version that ;; does) is our best hope for some day bootstrapping upstream Chez Scheme from ;; source. ;; ;; Putting the relevant definitions together in this module avoids having to ;; work around dependency cycles. ;; ;; Code: (define nanopass (let ((version "1.9.2")) (origin (method git-fetch) (uri (git-reference (url "https://github.com/nanopass/nanopass-framework-scheme") (commit (string-append "v" version)))) (sha256 (base32 "16vjsik9rrzbabbhbxbaha51ppi3f9n8rk59pc6zdyffs0vziy4i")) (file-name (git-file-name "nanopass" version))))) (define stex ;; This commit includes a fix, which we would otherwise want to use as ;; patch. Let's revert to tagged releases as soon as one becomes available. (let* ((commit "54051494434a197772bf6ca5b4e6cf6be55f39a5") (version "1.2.2") (version (git-version version "1" commit))) (origin (method git-fetch) (uri (git-reference (url "https://github.com/dybvig/stex") (commit commit))) (sha256 (base32 "01jnvw8qw33gnpzwrakwhsr05h6b609lm180jnspcrb7lds2p23d")) (file-name (git-file-name "stex" version))))) (define-public chez-scheme (package (name "chez-scheme") (version "9.5.6") (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/cisco/ChezScheme") (commit (string-append "v" version)))) (sha256 (base32 "07s433hn1z2slfc026sidrpzxv3a8narcd40qqr1xrpb9012xdky")) (file-name (git-file-name name version)) (snippet ;; Remove bundled libraries. (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils)) (for-each (lambda (dir) (when (directory-exists? dir) (delete-file-recursively dir))) '("stex" "nanopass" "lz4" "zlib"))))))) (build-system gnu-build-system) (inputs `(("libuuid" ,util-linux "lib") ("zlib" ,zlib) ("zlib:static" ,zlib "static") ("lz4" ,lz4) ("lz4:static" ,lz4 "static") ;; for expeditor: ("ncurses" ,ncurses) ;; for X11 clipboard support in expeditor: ;; https://github.com/cisco/ChezScheme/issues/9#issuecomment-222057232 ("libx11" ,libx11))) (native-inputs `(("nanopass" ,nanopass) ; source only ;; for docs ("stex" ,stex) ("xorg-rgb" ,xorg-rgb) ("texlive" ,(texlive-updmap.cfg (list texlive-dvips-l3backend texlive-epsf texlive-fonts-ec texlive-oberdiek))) ("ghostscript" ,ghostscript) ("netpbm" ,netpbm))) (native-search-paths (list (search-path-specification (variable "CHEZSCHEMELIBDIRS") (files (list (string-append "lib/csv" version "-site")))))) (outputs '("out" "doc")) (arguments `(#:modules ((guix build gnu-build-system) (guix build utils) (ice-9 ftw) (ice-9 match)) #:test-target "test" #:configure-flags '("--threads") ;; TODO when we fix armhf, it doesn't support --threads #:phases (modify-phases %standard-phases ;; put these where configure expects them to be (add-after 'unpack 'unpack-nanopass+stex (lambda* (#:key native-inputs inputs #:allow-other-keys) (for-each (lambda (dep) (define src (assoc-ref (or native-inputs inputs) dep)) (copy-recursively src dep #:keep-mtime? #t)) '("nanopass" "stex")))) ;; NOTE: the custom Chez 'configure' script doesn't allow ;; unrecognized flags, such as those automatically added ;; by `gnu-build-system`. (replace 'configure (lambda* (#:key inputs outputs (configure-flags '()) #:allow-other-keys) (let* ((zlib-static (assoc-ref inputs "zlib:static")) (lz4-static (assoc-ref inputs "lz4:static")) (out (assoc-ref outputs "out")) ;; add flags which are always required: (flags (cons* (string-append "--installprefix=" out) (string-append "ZLIB=" zlib-static "/lib/libz.a") (string-append "LZ4=" lz4-static "/lib/liblz4.a") ;; Guix will do compress man pages, ;; and letting Chez try causes an error "--nogzip-man-pages" configure-flags))) (format #t "configure flags: ~s~%" flags) ;; Some makefiles (for tests) don't seem to propagate CC ;; properly, so we take it out of their hands: (setenv "CC" ,(cc-for-target)) (setenv "HOME" "/tmp") (apply invoke "./configure" flags)))) ;; The binary file name is called "scheme" as is the one from MIT/GNU ;; Scheme. We add a symlink to use in case both are installed. (add-after 'install 'install-symlink (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (bin (string-append out "/bin")) (lib (string-append out "/lib")) (name "chez-scheme")) (symlink (string-append bin "/scheme") (string-append bin "/" name)) (map (lambda (file) (symlink file (string-append (dirname file) "/" name ".boot"))) (find-files lib "scheme.boot"))))) ;; Building explicitly lets us avoid using substitute* ;; to re-write makefiles. (add-after 'install-symlink 'prepare-stex (lambda* (#:key native-inputs inputs outputs #:allow-other-keys) (let* ((stex+version (strip-store-file-name (assoc-ref (or native-inputs inputs) "stex"))) ;; Eventually we want to install stex as a real ;; package so it's reusable. For now: (stex-output "/tmp") (doc-dir (string-append stex-output "/share/doc/" stex+version))) (with-directory-excursion "stex" (invoke "make" "install" (string-append "LIB=" stex-output "/lib/" stex+version) (string-append "Scheme=" (assoc-ref outputs "out") "/bin/scheme")) (for-each (lambda (pth) (install-file pth doc-dir)) '("ReadMe" ; includes the license "doc/stex.html" "doc/stex.css" "doc/stex.pdf")))))) ;; Building the documentation requires stex and a running scheme. ;; FIXME: this is probably wrong for cross-compilation (add-after 'prepare-stex 'install-doc (lambda* (#:key native-inputs inputs outputs #:allow-other-keys) (let* ((chez+version (strip-store-file-name (assoc-ref outputs "out"))) (stex+version (strip-store-file-name (assoc-ref (or native-inputs inputs) "stex"))) (scheme (string-append (assoc-ref outputs "out") "/bin/scheme")) ;; see note on stex-output in phase build-stex, above: (stexlib (string-append "/tmp" "/lib/" stex+version)) (doc-dir (string-append (assoc-ref outputs "doc") "/share/doc/" chez+version))) (define* (stex-make #:optional (suffix "")) (invoke "make" "install" (string-append "Scheme=" scheme) (string-append "STEXLIB=" stexlib) (string-append "installdir=" doc-dir suffix))) (with-directory-excursion "csug" (stex-make "/csug")) (with-directory-excursion "release_notes" (stex-make "/release_notes")) (with-directory-excursion doc-dir (symlink "release_notes/release_notes.pdf" "release_notes.pdf") (symlink "csug/csug9_5.pdf" "csug.pdf")))))))) ;; Chez Scheme does not have a MIPS backend. ;; FIXME: Debian backports patches to get armhf working. ;; We should too. It is the Chez machine type arm32le ;; (no threaded version upstream yet, though there is in ;; Racket's fork), more specifically (per the release notes) ARMv6. (supported-systems (fold delete %supported-systems '("mips64el-linux" "armhf-linux"))) (home-page "https://cisco.github.io/ChezScheme/") (synopsis "R6RS Scheme compiler and run-time") (description "Chez Scheme is a compiler and run-time system for the language of the Revised^6 Report on Scheme (R6RS), with numerous extensions. The compiler generates native code for each target processor, with support for x86, x86_64, and 32-bit PowerPC architectures.") (license license:asl2.0)))