me/guix
Archived
1
0
Fork 0
Code Activity

gnu: chez-scheme: Use new package style.

Browse source 
* gnu/packages/chez.scm (chez-scheme)[inputs]: Remove labels.
[native-inputs]: Likewise.
[arguments]: Use G-expressions.
<#:phases>: Use 'search-input-file' instead of 'assoc-ref'.
(nanopass): Make public as a temporary workaround for Racket.
* gnu/packages/racket.scm (make-unpack-nanopass+stex): Update
accordingly.

Signed-off-by: Liliana Marie Prikler <liliana.prikler@gmail.com>
This commit is contained in:
Philip McGrath 2022-02-27 16:29:13 -05:00 • committed by Liliana Marie Prikler
parent 37a75d23a9
commit 75f9f9441f
No known key found for this signature in database
GPG key ID: 442A84B8C70E2F87
2 changed files with 135 additions and 156 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

286
gnu/packages/chez.scm
View file

@ -158,7 +158,7 @@ If native threads are supported, the returned list will include
;; Chez Scheme: ;; Chez Scheme:
;; ;;
(define nanopass (define-public nanopass
(let ((version "1.9.2")) (let ((version "1.9.2"))
(origin (origin
(method git-fetch) (method git-fetch)
@ -185,86 +185,80 @@ If native threads are supported, the returned list will include
(define-public chez-scheme (define-public chez-scheme
(package (package
(name "chez-scheme") (name "chez-scheme")
;; The version should match `(scheme-version-number)`.
;; See s/cmacros.ss c. line 360.
(version "9.5.6") (version "9.5.6")
(source (source (origin
(origin (method git-fetch)
(method git-fetch) (uri (git-reference
(uri (git-reference (url "https://github.com/cisco/ChezScheme")
(url "https://github.com/cisco/ChezScheme") (commit (string-append "v" version))))
(commit (string-append "v" version)))) (sha256
(sha256 (base32
(base32 "07s433hn1z2slfc026sidrpzxv3a8narcd40qqr1xrpb9012xdky")) "07s433hn1z2slfc026sidrpzxv3a8narcd40qqr1xrpb9012xdky"))
(file-name (git-file-name name version)) (file-name (git-file-name name version))
(snippet (snippet #~(begin
;; Remove bundled libraries. (use-modules (guix build utils))
(with-imported-modules '((guix build utils)) (for-each (lambda (dir)
#~(begin (when (directory-exists? dir)
(use-modules (guix build utils)) (delete-file-recursively dir)))
(for-each (lambda (dir) '("stex"
(when (directory-exists? dir) "nanopass"
(delete-file-recursively dir))) "lz4"
'("stex" "zlib"))))))
"nanopass"
"lz4"
"zlib")))))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("libuuid" ,util-linux "lib") (list
("zlib" ,zlib) `(,util-linux "lib") ;<-- libuuid
("lz4" ,lz4) zlib
;; for expeditor: lz4
("ncurses" ,ncurses) ncurses ;<-- for expeditor
;; for X11 clipboard support in expeditor: ;; for X11 clipboard support in expeditor:
;; https://github.com/cisco/ChezScheme/issues/9#issuecomment-222057232 ;; https://github.com/cisco/ChezScheme/issues/9#issuecomment-222057232
("libx11" ,libx11))) libx11))
(native-inputs (native-inputs
`(("nanopass" ,nanopass) ; source only (list nanopass ; source only
;; for docs ;; for docs
("stex" ,stex) stex
("xorg-rgb" ,xorg-rgb) xorg-rgb
("texlive" ,(texlive-updmap.cfg (list texlive-dvips-l3backend (texlive-updmap.cfg (list texlive-dvips-l3backend
texlive-epsf texlive-epsf
texlive-fonts-ec texlive-fonts-ec
texlive-oberdiek))) texlive-oberdiek))
("ghostscript" ,ghostscript) ghostscript
("netpbm" ,netpbm))) netpbm))
(native-search-paths (native-search-paths
(list (search-path-specification (list (search-path-specification
(variable "CHEZSCHEMELIBDIRS") (variable "CHEZSCHEMELIBDIRS")
(files '("lib/chez-scheme"))))) (files '("lib/chez-scheme")))))
(outputs '("out" "doc")) (outputs '("out" "doc"))
(arguments (arguments
`(#:modules (list
((guix build gnu-build-system) #:modules
'((guix build gnu-build-system)
(guix build utils) (guix build utils)
(ice-9 ftw) (ice-9 ftw)
(ice-9 match)) (ice-9 match))
#:test-target "test" #:test-target "test"
#:configure-flags ;; TODO when we fix armhf, it may not support --threads
'("--threads") ;; TODO when we fix armhf, it doesn't support --threads #:configure-flags #~'("--threads")
#:phases #:phases
(modify-phases %standard-phases #~(modify-phases %standard-phases
;; put these where configure expects them to be (add-after 'unpack 'unpack-nanopass+stex
(add-after 'unpack 'unpack-nanopass+stex (lambda args
(lambda* (#:key native-inputs inputs #:allow-other-keys) (copy-recursively #$nanopass
(for-each (lambda (dep) "nanopass"
(define src #:keep-mtime? #t)
(assoc-ref (or native-inputs inputs) dep)) (copy-recursively #$stex
(copy-recursively src dep "stex"
#:keep-mtime? #t)) #:keep-mtime? #t)))
'("nanopass" "stex")))) ;; NOTE: the custom Chez 'configure' script doesn't allow
;; NOTE: the custom Chez 'configure' script doesn't allow ;; unrecognized flags, such as those automatically added
;; unrecognized flags, such as those automatically added ;; by `gnu-build-system`.
;; by `gnu-build-system`. (replace 'configure
(replace 'configure (lambda* (#:key inputs (configure-flags '()) #:allow-other-keys)
(lambda* (#:key inputs outputs ;; add flags which are always required:
(configure-flags '()) (let ((flags (cons* (string-append "--installprefix=" #$output)
#: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)
"ZLIB=-lz" "ZLIB=-lz"
"LZ4=-llz4" "LZ4=-llz4"
"--libkernel" "--libkernel"
@ -272,90 +266,78 @@ If native threads are supported, the returned list will include
;; and letting Chez try causes an error ;; and letting Chez try causes an error
"--nogzip-man-pages" "--nogzip-man-pages"
configure-flags))) configure-flags)))
(format #t "configure flags: ~s~%" flags) (format #t "configure flags: ~s~%" flags)
;; Some makefiles (for tests) don't seem to propagate CC ;; Some makefiles (for tests) don't seem to propagate CC
;; properly, so we take it out of their hands: ;; properly, so we take it out of their hands:
(setenv "CC" ,(cc-for-target)) (setenv "CC" #$(cc-for-target))
(setenv "HOME" "/tmp") (setenv "HOME" "/tmp")
(apply invoke (apply invoke "./configure" flags))))
"./configure" ;; The binary file name is called "scheme" as is the one from
flags)))) ;; MIT/GNU Scheme. We add a symlink to use in case both are
;; The binary file name is called "scheme" as is the one from MIT/GNU ;; installed.
;; Scheme. We add a symlink to use in case both are installed. (add-after 'install 'install-symlink
(add-after 'install 'install-symlink (lambda* (#:key outputs #:allow-other-keys)
(lambda* (#:key outputs #:allow-other-keys) (let* ((scheme (search-input-file outputs "/bin/scheme"))
(let* ((out (assoc-ref outputs "out")) (bin-dir (dirname scheme)))
(bin (string-append out "/bin")) (symlink scheme
(lib (string-append out "/lib")) (string-append bin-dir "/chez-scheme"))
(name "chez-scheme")) (match (find-files (string-append bin-dir "/../lib")
(symlink (string-append bin "/scheme") "scheme.boot")
(string-append bin "/" name)) ((scheme.boot)
(map (lambda (file) (symlink scheme.boot
(symlink file (string-append (dirname file) (string-append (dirname scheme.boot)
"/" name ".boot"))) "/chez-scheme.boot")))))))
(find-files lib "scheme.boot"))))) ;; Building explicitly lets us avoid using substitute*
;; Building explicitly lets us avoid using substitute* ;; to re-write makefiles.
;; to re-write makefiles. (add-after 'install-symlink 'prepare-stex
(add-after 'install-symlink 'prepare-stex (lambda* (#:key native-inputs inputs outputs #:allow-other-keys)
(lambda* (#:key native-inputs inputs outputs #:allow-other-keys) ;; Eventually we want to install stex as a real
(let* ((stex+version ;; package so it's reusable. For now:
(strip-store-file-name (let* ((stex-output "/tmp")
(assoc-ref (or native-inputs inputs) "stex"))) (doc-dir (string-append stex-output "/share/doc/stex")))
;; Eventually we want to install stex as a real (with-directory-excursion "stex"
;; package so it's reusable. For now: (invoke "make"
(stex-output "/tmp") "install"
(doc-dir (string-append stex-output (string-append "LIB="
"/share/doc/" stex-output
stex+version))) "/lib/stex")
(with-directory-excursion "stex" (string-append "Scheme="
(invoke "make" (search-input-file outputs
"install" "/bin/scheme")))
(string-append "LIB=" (for-each (lambda (pth)
stex-output (install-file pth doc-dir))
"/lib/" '("ReadMe" ; includes the license
stex+version) "doc/stex.html"
(string-append "Scheme=" "doc/stex.css"
(assoc-ref outputs "out") "doc/stex.pdf"))))))
"/bin/scheme")) ;; Building the documentation requires stex and a running scheme.
(for-each (lambda (pth) ;; FIXME: this is probably wrong for cross-compilation
(install-file pth doc-dir)) (add-after 'prepare-stex 'install-doc
'("ReadMe" ; includes the license (lambda* (#:key native-inputs inputs outputs #:allow-other-keys)
"doc/stex.html" (match (assoc-ref outputs "doc")
"doc/stex.css" (#f
"doc/stex.pdf")))))) (format #t "not installing docs~%"))
;; Building the documentation requires stex and a running scheme. (doc-prefix
;; FIXME: this is probably wrong for cross-compilation (let* ((chez+version (strip-store-file-name #$output))
(add-after 'prepare-stex 'install-doc (scheme (search-input-file outputs "/bin/scheme"))
(lambda* (#:key native-inputs inputs outputs #:allow-other-keys) (stexlib "/tmp/lib/stex")
(let* ((chez+version (strip-store-file-name (doc-dir (string-append doc-prefix
(assoc-ref outputs "out"))) "/share/doc/"
(stex+version chez+version)))
(strip-store-file-name (define* (stex-make #:optional (suffix ""))
(assoc-ref (or native-inputs inputs) "stex"))) (invoke "make" "install"
(scheme (string-append (assoc-ref outputs "out") (string-append "Scheme=" scheme)
"/bin/scheme")) (string-append "STEXLIB=" stexlib)
;; see note on stex-output in phase build-stex, above: (string-append "installdir=" doc-dir suffix)))
(stexlib (string-append "/tmp" (with-directory-excursion "csug"
"/lib/" (stex-make "/csug"))
stex+version)) (with-directory-excursion "release_notes"
(doc-dir (string-append (assoc-ref outputs "doc") (stex-make "/release_notes"))
"/share/doc/" (with-directory-excursion doc-dir
chez+version))) (symlink "release_notes/release_notes.pdf"
(define* (stex-make #:optional (suffix "")) "release_notes.pdf")
(invoke "make" (symlink "csug/csug9_5.pdf"
"install" "csug.pdf"))))))))))
(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. ;; Chez Scheme does not have a MIPS backend.
;; FIXME: Debian backports patches to get armhf working. ;; FIXME: Debian backports patches to get armhf working.
;; We should too. It is the Chez machine type arm32le ;; We should too. It is the Chez machine type arm32le

5
gnu/packages/racket.scm
View file

@ -260,10 +260,7 @@
;; TODO: Refactor enough to share this directly. ;; TODO: Refactor enough to share this directly.
#~(begin #~(begin
(copy-recursively (copy-recursively
#$(match (assoc-ref (package-native-inputs chez-scheme) #$nanopass
"nanopass")
((src)
src))
"nanopass" "nanopass"
#:keep-mtime? #t) #:keep-mtime? #t)
(mkdir-p "stex") (mkdir-p "stex")