From c093f9f63a57ae8fa9d230249f0b724f80763dc5 Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Thu, 13 Aug 2015 18:58:01 +0200 Subject: [PATCH] gnu: Add scmutils. * gnu/packages/scheme.scm (scmutils): New variable. --- gnu/packages/scheme.scm | 177 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index 803b8d5a20..7465b1b58c 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer +;;; Copyright © 2015 Federico Beffa ;;; ;;; This file is part of GNU Guix. ;;; @@ -486,3 +487,179 @@ (define-public chibi-scheme an isolated heap allowing multiple VMs to run simultaneously in different OS threads.") (license bsd-3))) + +;; FIXME: This function is temporarily in the engineering module and not +;; exported. It will be moved to an utility module for general use. Once +;; this is done, we should remove this definition. +(define broken-tarball-fetch + (@@ (gnu packages engineering) broken-tarball-fetch)) + +(define-public scmutils + (let () + (define (system-suffix) + (cond + ((string-prefix? "x86_64" (or (%current-target-system) + (%current-system))) + "x86-64") + (else "i386"))) + + (package + (name "scmutils") + (version "20140302") + (source + (origin + (method broken-tarball-fetch) + (modules '((guix build utils))) + (snippet + ;; Remove binary code + '(delete-file-recursively "scmutils/mit-scheme")) + (file-name (string-append name "-" version ".tar.gz")) + (uri (string-append "http://groups.csail.mit.edu/mac/users/gjs/6946" + "/scmutils-tarballs/" name "-" version + "-x86-64-gnu-linux.tar.gz")) + (sha256 + (base32 "10cnbm7nh78m5mrl1di85s29gny81jb1am9zd9f9yx725xb6dnfg")))) + (build-system gnu-build-system) + (inputs + `(("mit-scheme" ,mit-scheme) + ("emacs" ,emacs-no-x))) + (arguments + `(#:tests? #f ;; no tests-suite + #:modules ((guix build gnu-build-system) + (guix build utils) + (guix build emacs-utils)) + #:imported-modules (,@%gnu-build-system-modules + (guix build emacs-utils)) + #:phases + (modify-phases %standard-phases + (replace 'configure + ;; No standard build procedure is used. We set the correct + ;; runtime path in the custom build system. + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + ;; Required to find .bci files at runtime. + (with-directory-excursion "scmutils" + (rename-file "src" "scmutils")) + (substitute* "scmutils/scmutils/load.scm" + (("/usr/local/scmutils/") + (string-append out "/lib/mit-scheme-" + ,(system-suffix) "/"))) + #t))) + (replace 'build + ;; Compile the code and build a band. + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (make-img (string-append + "echo '(load \"load\") " + "(disk-save \"edwin-mechanics.com\")'" + "| mit-scheme"))) + (with-directory-excursion "scmutils/scmutils" + (and (zero? (system "mit-scheme < compile.scm")) + (zero? (system make-img))))))) + (add-before 'install 'fix-directory-names + ;; Correct directory names in the startup script. + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (scm-root (assoc-ref inputs "mit-scheme"))) + (substitute* "bin/mechanics" + (("ROOT=\"\\$\\{SCMUTILS_ROOT:-/.*\\}\"") + (string-append + "ROOT=\"${SCMUTILS_ROOT:-" scm-root "}\"\n" + "LIB=\"${ROOT}/lib/mit-scheme-" + ,(system-suffix) ":" + out "/lib/mit-scheme-" ,(system-suffix) "\"")) + (("EDWIN_INFO_DIRECTORY=.*\n") "") + (("SCHEME=.*\n") + (string-append "SCHEME=\"${ROOT}/bin/scheme " + "--library ${LIB}\"\n")) + (("export EDWIN_INFO_DIRECTORY") "")) + #t))) + (add-before 'install 'emacs-tags + ;; Generate Emacs's tags for easy reference to source + ;; code. + (lambda* (#:key inputs outputs #:allow-other-keys) + (with-directory-excursion "scmutils/scmutils" + (zero? (apply system* "etags" + (find-files "." "\\.scm")))))) + (replace 'install + ;; Copy files to the store. + (lambda* (#:key outputs #:allow-other-keys) + (define* (copy-files-to-directory files dir + #:optional (delete? #f)) + (for-each (lambda (f) + (copy-file f (string-append dir "/" f)) + (when delete? (delete-file f))) + files)) + + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin")) + (doc (string-append out "/share/doc/" + ,name "-" ,version)) + (lib (string-append out "/lib/mit-scheme-" + ,(system-suffix) + "/scmutils"))) + (for-each mkdir-p (list lib doc bin)) + (with-directory-excursion "scmutils/scmutils" + (copy-files-to-directory '("COPYING" "LICENSE") + doc #t) + (for-each delete-file (find-files "." "\\.bin")) + (copy-files-to-directory '("edwin-mechanics.com") + (string-append lib "/..") #t) + (copy-recursively "." lib)) + (with-directory-excursion "bin" + (copy-files-to-directory (find-files ".") bin)) + (with-directory-excursion "scmutils/manual" + (copy-files-to-directory (find-files ".") doc)) + #t))) + (add-after 'install 'emacs-helpers + ;; Add convenience Emacs commands to easily load the + ;; Scmutils band in an MIT-Scheme buffer inside of Emacs + ;; and to easily load code tags. + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (mit-root (assoc-ref inputs "mit-scheme")) + (emacs-lisp-dir + (string-append out "/share/emacs/site-lisp" + "/guix.d/" ,name "-" ,version)) + (el-file (string-append emacs-lisp-dir + "/scmutils.el")) + (lib-relative-path + (string-append "/lib/mit-scheme-" + ,(system-suffix)))) + (mkdir-p emacs-lisp-dir) + (call-with-output-file el-file + (lambda (p) + (format p + ";;;###autoload +(defun scmutils-load () + (interactive) + (require 'xscheme) + (let ((mit-root \"~a\") + (scmutils \"~a\")) + (run-scheme + (concat mit-root \"/bin/scheme --library \" + mit-root \"~a:\" scmutils \"~a\" + \" --band edwin-mechanics.com\" + \" --emacs\")))) + +;;;###autoload +(defun scmutils-load-tags () + (interactive) + (let ((scmutils \"~a\")) + (visit-tags-table (concat scmutils \"/TAGS\")))) +" + mit-root out + lib-relative-path + lib-relative-path + (string-append out lib-relative-path + "/scmutils")))) + (emacs-byte-compile-directory (dirname el-file)) + #t)))))) + (home-page + "http://groups.csail.mit.edu/mac/users/gjs/6946/linux-install.htm") + (synopsis "Scmutils library for MIT Scheme") + (description "The Scmutils system is an integrated library of +procedures, embedded in the programming language Scheme, and intended to +support teaching and research in mathematical physics and electrical +engineering.") + (license gpl2+))))