gnu/packages/scheme.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
   4 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu packages scheme)
  22   #:use-module (gnu packages)
  23   #:use-module (guix licenses)
  24   #:use-module (guix packages)
  25   #:use-module (guix download)
  26   #:use-module (guix utils)
  27   #:use-module (guix build-system gnu)
  28   #:use-module (gnu packages m4)
  29   #:use-module (gnu packages multiprecision)
  30   #:use-module (gnu packages databases)
  31   #:use-module (gnu packages emacs)
  32   #:use-module (gnu packages texinfo)
  33   #:use-module (gnu packages base)
  34   #:use-module (gnu packages pkg-config)
  35   #:use-module (gnu packages avahi)
  36   #:use-module (gnu packages libphidget)
  37   #:use-module (gnu packages glib)
  38   #:use-module (gnu packages gtk)
  39   #:use-module (gnu packages libffi)
  40   #:use-module (gnu packages fontutils)
  41   #:use-module (gnu packages image)
  42   #:use-module (gnu packages xorg)
  43   #:use-module (ice-9 match))
  44
  45 (define (mit-scheme-source-directory system version)
  46   (string-append "mit-scheme-"
  47                  (if (or (string-prefix? "x86_64" system)
  48                          (string-prefix? "i686" system))
  49                      ""
  50                      "c-")
  51                  version))
  52
  53 (define-public mit-scheme
  54   (package
  55     (name "mit-scheme")
  56     (version "9.2")
  57     (source #f)                                   ; see below
  58     (build-system gnu-build-system)
  59     (arguments
  60      `(#:tests? #f                                ; no "check" target
  61        #:phases
  62        (alist-replace
  63         'unpack
  64         (lambda* (#:key inputs #:allow-other-keys)
  65           (and (zero? (system* "tar" "xzvf"
  66                                (assoc-ref inputs "source")))
  67                (chdir ,(mit-scheme-source-directory (%current-system)
  68                                                     version))
  69                (begin
  70                  ;; Delete these dangling symlinks since they break
  71                  ;; `patch-shebangs'.
  72                  (for-each delete-file
  73                            (append '("src/lib/shim-config.scm")
  74                                    (find-files "src/lib/lib" "\\.so$")
  75                                    (find-files "src/lib" "^liarc-")
  76                                    (find-files "src/compiler" "^make\\.")))
  77                  (chdir "src")
  78                  #t)))
  79         (alist-replace
  80          'build
  81          (lambda* (#:key system outputs #:allow-other-keys)
  82            (let ((out (assoc-ref outputs "out")))
  83              (if (or (string-prefix? "x86_64" system)
  84                      (string-prefix? "i686" system))
  85                  (zero? (system* "make" "compile-microcode"))
  86                  (zero? (system* "./etc/make-liarc.sh"
  87                                  (string-append "--prefix=" out))))))
  88          %standard-phases))))
  89     (inputs
  90      `(;; TODO: Build doc when TeX Live is available.
  91        ;; ("automake" ,automake)
  92        ;; ("texlive-core" ,texlive-core)
  93        ("texinfo" ,texinfo)
  94        ("m4" ,m4)
  95        ("libx11" ,libx11)
  96
  97        ("source"
  98
  99         ;; MIT/GNU Scheme is not bootstrappable, so it's recommended to
 100         ;; compile from the architecture-specific tarballs, which contain
 101         ;; pre-built binaries.  It leads to more efficient code than when
 102         ;; building the tarball that contains generated C code instead of
 103         ;; those binaries.
 104         ,(origin
 105           (method url-fetch)
 106           (uri (string-append "mirror://gnu/mit-scheme/stable.pkg/"
 107                               version "/mit-scheme-"
 108                               (match (%current-system)
 109                                 ("x86_64-linux"
 110                                  (string-append version "-x86-64"))
 111                                 ("i686-linux"
 112                                  (string-append version "-i386"))
 113                                 (_
 114                                  (string-append "c-" version)))
 115                               ".tar.gz"))
 116           (sha256
 117            (match (%current-system)
 118              ("x86_64-linux"
 119               (base32
 120                "1skzxxhr0iq96bf0j5m7mvf3i4sppfyfa6gpqn34mwgkw1fx8274"))
 121              ("i686-linux"
 122               (base32
 123                "1fmlpnhf5a75db93phajh4ysbdgrgl72v45lk3kznriprl0a7jc6"))
 124              (_
 125               (base32
 126                "0w5ib5vsidihb4hb6fma3sp596ykr8izagm57axvgd6lqzwicsjg"))))))))
 127
 128     ;; Fails to build on MIPS, see <http://bugs.gnu.org/18221>.
 129     (supported-systems (delete "mips64el-linux" %supported-systems))
 130
 131     (home-page "http://www.gnu.org/software/mit-scheme/")
 132     (synopsis "A Scheme implementation with integrated editor and debugger")
 133     (description
 134      "GNU/MIT Scheme is an implementation of the Scheme programming
 135 language.  It provides an interpreter, a compiler and a debugger.  It also
 136 features an integrated Emacs-like editor and a large runtime library.")
 137     (license gpl2+)))
 138
 139 (define-public bigloo
 140   (package
 141     (name "bigloo")
 142     (version "4.1a")
 143     (source (origin
 144              (method url-fetch)
 145              (uri (string-append "ftp://ftp-sop.inria.fr/indes/fp/Bigloo/bigloo"
 146                                  version ".tar.gz"))
 147              (sha256
 148               (base32
 149                "170q7nh08n4v20xl81fxb0xcdxphqqacfa643hsa8i2ar6pki04c"))
 150              (patches (list (search-patch "bigloo-gc-shebangs.patch")))))
 151     (build-system gnu-build-system)
 152     (arguments
 153      `(#:test-target "test"
 154        #:phases (alist-replace
 155                  'configure
 156                  (lambda* (#:key outputs #:allow-other-keys)
 157
 158                    (substitute* "configure"
 159                      (("^shell=.*$")
 160                       (string-append "shell=" (which "bash") "\n")))
 161
 162                    ;; Since libgc's pthread redirects are used, we end up
 163                    ;; using libgc symbols, so we must link against it.
 164                    ;; Reported on 2013-06-25.
 165                    (substitute* "api/pthread/src/Makefile"
 166                      (("^EXTRALIBS[[:blank:]]*=(.*)$" _ value)
 167                       (string-append "EXTRALIBS = "
 168                                      (string-trim-right value)
 169                                      " -l$(GCLIB)_fth-$(RELEASE)"
 170                                      " -Wl,-rpath=" (assoc-ref outputs "out")
 171                                      "/lib/bigloo/" ,version)))
 172
 173                    ;; Those variables are used by libgc's `configure'.
 174                    (setenv "SHELL" (which "sh"))
 175                    (setenv "CONFIG_SHELL" (which "sh"))
 176
 177                    ;; ... but they turned out to be overridden later, so work
 178                    ;; around that.
 179                    (substitute* (find-files "gc" "^configure-gc")
 180                      (("sh=/bin/sh")
 181                       (string-append "sh=" (which "sh"))))
 182
 183                    ;; The `configure' script doesn't understand options
 184                    ;; of those of Autoconf.
 185                    (let ((out (assoc-ref outputs "out")))
 186                      (zero?
 187                       (system* "./configure"
 188                                (string-append "--prefix=" out)
 189                                ;; FIXME: Currently fails, see
 190                                ;; <http://article.gmane.org/gmane.lisp.scheme.bigloo/6126>.
 191                                ;; "--customgc=no" ; use our libgc
 192                                (string-append"--mv=" (which "mv"))
 193                                (string-append "--rm=" (which "rm"))
 194                                (string-append "--ldflags=-Wl,-rpath="
 195                                               (assoc-ref outputs "out")
 196                                               "/lib/bigloo/" ,version)))))
 197                  (alist-cons-after
 198                   'install 'install-emacs-modes
 199                   (lambda* (#:key outputs #:allow-other-keys)
 200                     (let* ((out (assoc-ref outputs "out"))
 201                            (dir (string-append out "/share/emacs/site-lisp")))
 202                       (zero? (system* "make" "-C" "bmacs" "all" "install"
 203                                       (string-append "EMACSBRAND=emacs24")
 204                                       (string-append "EMACSDIR=" dir)))))
 205                   %standard-phases))))
 206     (inputs
 207      `(("emacs" ,emacs)                      ;UDE needs the X version of Emacs
 208
 209        ;; Optional APIs for which Bigloo has bindings.
 210        ("avahi" ,avahi)
 211        ("libphidget" ,libphidget)))
 212     (native-inputs
 213      `(("pkg-config" ,pkg-config)))
 214     (propagated-inputs
 215      `(("gmp" ,gmp)))                             ; bigloo.h refers to gmp.h
 216     (home-page "http://www-sop.inria.fr/indes/fp/Bigloo/")
 217     (synopsis "Efficient Scheme compiler")
 218     (description
 219      "Bigloo is a Scheme implementation devoted to one goal: enabling
 220 Scheme based programming style where C(++) is usually
 221 required.  Bigloo attempts to make Scheme practical by offering
 222 features usually presented by traditional programming languages
 223 but not offered by Scheme and functional programming.  Bigloo
 224 compiles Scheme modules.  It delivers small and fast stand alone
 225 binary executables.  Bigloo enables full connections between
 226 Scheme and C programs and between Scheme and Java programs.")
 227     (license gpl2+)))
 228
 229 (define-public hop
 230   (package
 231     (name "hop")
 232     (version "2.4.0")
 233     (source (origin
 234              (method url-fetch)
 235              (uri (string-append "ftp://ftp-sop.inria.fr/indes/fp/Hop/hop-"
 236                                  version ".tar.gz"))
 237              (sha256
 238               (base32
 239                "1v2r4ga58kk1sx0frn8qa8ccmjpic9csqzpk499wc95y9c4b1wy3"))
 240              (patches (list (search-patch "hop-bigloo-4.0b.patch")
 241                             (search-patch "hop-linker-flags.patch")))))
 242     (build-system gnu-build-system)
 243     (arguments
 244      `(#:phases
 245        (alist-replace
 246         'configure
 247         (lambda* (#:key outputs #:allow-other-keys)
 248           (let ((out (assoc-ref outputs "out")))
 249             (zero?
 250              (system* "./configure"
 251                       (string-append "--prefix=" out)
 252                       (string-append "--blflags="
 253                                      ;; user flags completely override useful
 254                                      ;; default flags, so repeat them here.
 255                                      "-copt \\$(CPICFLAGS) -L\\$(BUILDLIBDIR) "
 256                                      "-ldopt -Wl,-rpath," out "/lib")))))
 257         %standard-phases)
 258        #:tests? #f))                                ; no test suite
 259     (inputs `(("bigloo" ,bigloo)
 260               ("which" ,which)))
 261     (home-page "http://hop.inria.fr/")
 262     (synopsis "Multi-tier programming language for the Web 2.0")
 263     (description
 264      "HOP is a multi-tier programming language for the Web 2.0 and the
 265 so-called diffuse Web.  It is designed for programming interactive web
 266 applications in many fields such as multimedia (web galleries, music players,
 267 ...), ubiquitous and house automation (SmartPhones, personal appliance),
 268 mashups, office (web agendas, mail clients, ...), etc.")
 269     (license gpl2+)))
 270
 271 (define-public chicken
 272   (package
 273     (name "chicken")
 274     (version "4.9.0.1")
 275     (source (origin
 276              (method url-fetch)
 277              (uri (string-append "http://code.call-cc.org/releases/4.9.0/chicken-"
 278                                  version ".tar.gz"))
 279              (sha256
 280               (base32
 281                "0598mar1qswfd8hva9nqs88zjn02lzkqd8fzdd21dz1nki1prpq4"))))
 282     (build-system gnu-build-system)
 283     (arguments
 284      `(#:modules ((guix build gnu-build-system)
 285                   (guix build utils)
 286                   (srfi srfi-1))
 287
 288        ;; No `configure' script; run "make check" after "make install" as
 289        ;; prescribed by README.
 290        #:phases (alist-cons-after
 291                  'install 'check
 292                  (assoc-ref %standard-phases 'check)
 293                  (fold alist-delete %standard-phases
 294                        '(configure check)))
 295
 296        #:make-flags (let ((out (assoc-ref %outputs "out")))
 297                       (list "PLATFORM=linux"
 298                             (string-append "PREFIX=" out)
 299                             (string-append "VARDIR=" out "/var/lib")))
 300
 301        ;; Parallel builds are not supported, as noted in README.
 302        #:parallel-build? #f))
 303     (home-page "http://www.call-cc.org/")
 304     (synopsis "R5RS Scheme implementation that compiles native code via C")
 305     (description
 306      "CHICKEN is a compiler for the Scheme programming language.  CHICKEN
 307 produces portable and efficient C, supports almost all of the R5RS Scheme
 308 language standard, and includes many enhancements and extensions.")
 309     (license bsd-3)))
 310
 311 (define-public scheme48
 312   (package
 313     (name "scheme48")
 314     (version "1.9")
 315     (source (origin
 316              (method url-fetch)
 317              (uri (string-append "http://s48.org/" version
 318                                  "/scheme48-" version ".tgz"))
 319              (sha256
 320               (base32
 321                "0rw2lz5xgld0klvld292ds6hvfk5l12vskzgf1hhwjdpa38r3fnw"))
 322              (patches (list (search-patch "scheme48-tests.patch")))))
 323     (build-system gnu-build-system)
 324     (home-page "http://s48.org/")
 325     (synopsis "Scheme implementation using a bytecode interpreter")
 326     (description
 327      "Scheme 48 is an implementation of Scheme based on a byte-code
 328 interpreter and is designed to be used as a testbed for experiments in
 329 implementation techniques and as an expository tool.")
 330
 331     ;; Most files are BSD-3; see COPYING for the few exceptions.
 332     (license bsd-3)))
 333
 334 (define-public racket
 335   (package
 336     (name "racket")
 337     (version "6.2.1")
 338     (source (origin
 339              (method url-fetch)
 340              (uri (list (string-append "http://mirror.racket-lang.org/installers/"
 341                                        version "/racket-" version "-src.tgz")
 342                         (string-append
 343                          "http://mirror.informatik.uni-tuebingen.de/mirror/racket/"
 344                          version "/racket/racket-" version "-src-unix.tgz")))
 345              (sha256
 346               (base32
 347                "0555j63k7fs10iv0icmivlxpzgp6s7gwcbfddmbwxlf2rk80qhq0"))))
 348     (build-system gnu-build-system)
 349     (arguments
 350      '(#:phases
 351        (let* ((gui-libs
 352                (lambda (inputs)
 353                  (define (lib input)
 354                    (string-append (assoc-ref inputs input) "/lib"))
 355
 356                  (list (lib "glib")
 357                        (lib "cairo")
 358                        (lib "pango")
 359                        (lib "libjpeg")
 360                        (lib "gtk")
 361                        (lib "gdk-pixbuf")
 362                        (lib "fontconfig")
 363                        (lib "sqlite")))))         ;to build the doc
 364          (alist-cons-before
 365           'configure 'pre-configure
 366           (lambda* (#:key inputs #:allow-other-keys)
 367             (chdir "src")
 368
 369             ;; The GUI libs are dynamically opened through the FFI, so they
 370             ;; must be in the loader's search path.
 371             (setenv "LD_LIBRARY_PATH" (string-join (gui-libs inputs) ":")))
 372           (alist-cons-after
 373            'unpack 'patch-/bin/sh
 374            (lambda _
 375              (substitute* "collects/racket/system.rkt"
 376                (("/bin/sh") (which "sh"))))
 377            (alist-cons-after
 378             'install 'wrap-programs
 379             (lambda* (#:key inputs outputs #:allow-other-keys)
 380               (let ((out (assoc-ref outputs "out")))
 381                 (define (wrap prog)
 382                   (wrap-program prog
 383                                 `("LD_LIBRARY_PATH" ":" prefix
 384                                   ,(gui-libs inputs))))
 385
 386                 (with-directory-excursion (string-append out "/bin")
 387                   (for-each wrap
 388                             (list "gracket" "drracket" "slideshow" "mred"))
 389                   #t)))
 390             %standard-phases))))
 391        #:tests? #f                                ; XXX: how to run them?
 392        ))
 393     (inputs `(("libffi" ,libffi)
 394               ("glib" ,glib)                      ; for DrRacket
 395               ("cairo" ,cairo)
 396               ("pango" ,pango)
 397               ("libjpeg" ,libjpeg-8)
 398               ("fontconfig" ,fontconfig)
 399               ("gdk-pixbuf" ,gdk-pixbuf)
 400               ("gtk" ,gtk+-2)
 401               ("sqlite" ,sqlite)))                ;needed to build the doc
 402     (home-page "http://racket-lang.org")
 403     (synopsis "Implementation of Scheme and related languages")
 404     (description
 405      "Racket is an implementation of the Scheme programming language (R5RS and
 406 R6RS) and related languages, such as Typed Racket.  It features a compiler and
 407 a virtual machine with just-in-time native compilation, as well as a large set
 408 of libraries.")
 409     (license lgpl2.0+)))
 410
 411 (define-public gambit-c
 412   (package
 413     (name "gambit-c")
 414     (version "4.7.4")
 415     (source
 416      (origin
 417        (method url-fetch)
 418        (uri (string-append
 419              "http://www.iro.umontreal.ca/~gambit/download/gambit/v"
 420              (version-major+minor version) "/source/gambc-v"
 421              (string-map (lambda (c) (if (char=? c #\.) #\_ c)) version)
 422              ".tgz"))
 423        (sha256
 424         (base32 "0y2pklh4k65yrmxv63ass76xckrk9wqimbdad2gha35v2mi7blhs"))))
 425     (build-system gnu-build-system)
 426     (arguments
 427      '(#:configure-flags
 428        ;; According to the ./configure script, this makes the build slower and
 429        ;; use >= 1 GB memory, but makes Gambit much faster.
 430        '("--enable-single-host")
 431        #:phases
 432        (alist-cons-before
 433         'check 'fix-tests
 434         (lambda _
 435           (substitute* '("tests/makefile")
 436             ;; '-:' is how run-time options are set.  'tl' sets some terminal
 437             ;; option, which makes it fail in our build environment.  It
 438             ;; recommends using 'd-' as a solution, which sets the REPL
 439             ;; interaction channel to stdin/stdout.
 440             (("gsi -:tl") "gsi -:d-,tl")))
 441         %standard-phases)))
 442     (home-page "http://www.iro.umontreal.ca/~gambit/")
 443     (synopsis "Efficient Scheme interpreter and compiler")
 444     (description
 445      "Gambit consists of two main programs: gsi, the Gambit Scheme
 446 interpreter, and gsc, the Gambit Scheme compiler.  The interpreter contains
 447 the complete execution and debugging environment.  The compiler is the
 448 interpreter extended with the capability of generating executable files.  The
 449 compiler can produce standalone executables or compiled modules which can be
 450 loaded at run time.  Interpreted code and compiled code can be freely
 451 mixed.")
 452     ;; Dual license.
 453     (license (list lgpl2.1+ asl2.0))))
 454
 455 (define-public chibi-scheme
 456   (package
 457     (name "chibi-scheme")
 458     (version "0.7.3")
 459     (source
 460      (origin
 461        (method url-fetch)
 462        (uri (string-append "https://github.com/ashinn/chibi-scheme/archive/"
 463                            version ".tar.gz"))
 464        (sha256
 465         (base32 "16wppf4qzr0748iyp0m89gidsfgq9s6x3gw4xggym91waw4fh742"))
 466        (file-name (string-append "chibi-scheme-" version ".tar.gz"))))
 467     (build-system gnu-build-system)
 468     (arguments
 469      `(#:phases
 470        (alist-delete
 471         'configure
 472         (alist-cons-before
 473          'build 'set-cc
 474          (lambda _
 475            (setenv "CC" "gcc"))
 476          %standard-phases))
 477        #:make-flags (let ((out (assoc-ref %outputs "out")))
 478                       (list (string-append "PREFIX=" out)
 479                             (string-append "LDFLAGS=-Wl,-rpath=" out "/lib")))
 480        #:test-target "test"))
 481     (home-page "https://code.google.com/p/chibi-scheme/")
 482     (synopsis "Small embeddable Scheme implementation")
 483     (description
 484      "Chibi-Scheme is a very small library with no external dependencies
 485 intended for use as an extension and scripting language in C programs.  In
 486 addition to support for lightweight VM-based threads, each VM itself runs in
 487 an isolated heap allowing multiple VMs to run simultaneously in different OS
 488 threads.")
 489     (license bsd-3)))
 490
 491 ;; FIXME: This function is temporarily in the engineering module and not
 492 ;; exported.  It will be moved to an utility module for general use.  Once
 493 ;; this is done, we should remove this definition.
 494 (define broken-tarball-fetch
 495   (@@ (gnu packages engineering) broken-tarball-fetch))
 496
 497 (define-public scmutils
 498   (let ()
 499     (define (system-suffix)
 500       (cond
 501        ((string-prefix? "x86_64" (or (%current-target-system)
 502                                      (%current-system)))
 503         "x86-64")
 504        (else "i386")))
 505
 506     (package
 507       (name "scmutils")
 508       (version "20140302")
 509       (source
 510        (origin
 511          (method broken-tarball-fetch)
 512          (modules '((guix build utils)))
 513          (snippet
 514           ;; Remove binary code
 515           '(delete-file-recursively "scmutils/mit-scheme"))
 516          (file-name (string-append name "-" version ".tar.gz"))
 517          (uri (string-append "http://groups.csail.mit.edu/mac/users/gjs/6946"
 518                              "/scmutils-tarballs/" name "-" version
 519                              "-x86-64-gnu-linux.tar.gz"))
 520          (sha256
 521           (base32 "10cnbm7nh78m5mrl1di85s29gny81jb1am9zd9f9yx725xb6dnfg"))))
 522       (build-system gnu-build-system)
 523       (inputs
 524        `(("mit-scheme" ,mit-scheme)
 525          ("emacs" ,emacs-no-x)))
 526       (arguments
 527        `(#:tests? #f ;; no tests-suite
 528          #:modules ((guix build gnu-build-system)
 529                     (guix build utils)
 530                     (guix build emacs-utils))
 531          #:imported-modules (,@%gnu-build-system-modules
 532                              (guix build emacs-utils))
 533          #:phases
 534          (modify-phases %standard-phases
 535            (replace 'configure
 536                     ;; No standard build procedure is used. We set the correct
 537                     ;; runtime path in the custom build system.
 538                     (lambda* (#:key outputs #:allow-other-keys)
 539                       (let ((out (assoc-ref outputs "out")))
 540                         ;; Required to find .bci files at runtime.
 541                         (with-directory-excursion "scmutils"
 542                           (rename-file "src" "scmutils"))
 543                         (substitute* "scmutils/scmutils/load.scm"
 544                           (("/usr/local/scmutils/")
 545                            (string-append out "/lib/mit-scheme-"
 546                                           ,(system-suffix) "/")))
 547                         #t)))
 548            (replace 'build
 549                     ;; Compile the code and build a band.
 550                     (lambda* (#:key outputs #:allow-other-keys)
 551                       (let* ((out (assoc-ref outputs "out"))
 552                              (make-img (string-append
 553                                         "echo '(load \"load\") "
 554                                         "(disk-save \"edwin-mechanics.com\")'"
 555                                         "| mit-scheme")))
 556                         (with-directory-excursion "scmutils/scmutils"
 557                           (and (zero? (system "mit-scheme < compile.scm"))
 558                                (zero? (system make-img)))))))
 559            (add-before 'install 'fix-directory-names
 560                        ;; Correct directory names in the startup script.
 561                        (lambda* (#:key inputs outputs #:allow-other-keys)
 562                          (let* ((out (assoc-ref outputs "out"))
 563                                 (scm-root (assoc-ref inputs "mit-scheme")))
 564                            (substitute* "bin/mechanics"
 565                              (("ROOT=\"\\$\\{SCMUTILS_ROOT:-/.*\\}\"")
 566                               (string-append
 567                                "ROOT=\"${SCMUTILS_ROOT:-" scm-root "}\"\n"
 568                                "LIB=\"${ROOT}/lib/mit-scheme-"
 569                                ,(system-suffix) ":"
 570                                out "/lib/mit-scheme-" ,(system-suffix) "\""))
 571                              (("EDWIN_INFO_DIRECTORY=.*\n") "")
 572                              (("SCHEME=.*\n")
 573                               (string-append "SCHEME=\"${ROOT}/bin/scheme "
 574                                              "--library ${LIB}\"\n"))
 575                              (("export EDWIN_INFO_DIRECTORY") ""))
 576                            #t)))
 577            (add-before 'install 'emacs-tags
 578                        ;; Generate Emacs's tags for easy reference to source
 579                        ;; code.
 580                        (lambda* (#:key inputs outputs #:allow-other-keys)
 581                          (with-directory-excursion "scmutils/scmutils"
 582                            (zero? (apply system* "etags"
 583                                          (find-files "." "\\.scm"))))))
 584            (replace 'install
 585                     ;; Copy files to the store.
 586                     (lambda* (#:key outputs #:allow-other-keys)
 587                       (define* (copy-files-to-directory files dir
 588                                                         #:optional (delete? #f))
 589                         (for-each (lambda (f)
 590                                     (copy-file f (string-append dir "/" f))
 591                                     (when delete? (delete-file f)))
 592                                   files))
 593
 594                       (let* ((out (assoc-ref outputs "out"))
 595                              (bin (string-append out "/bin"))
 596                              (doc (string-append out "/share/doc/"
 597                                                  ,name "-" ,version))
 598                              (lib (string-append out "/lib/mit-scheme-"
 599                                                  ,(system-suffix)
 600                                                  "/scmutils")))
 601                         (for-each mkdir-p (list lib doc bin))
 602                         (with-directory-excursion "scmutils/scmutils"
 603                           (copy-files-to-directory '("COPYING" "LICENSE")
 604                                                    doc #t)
 605                           (for-each delete-file (find-files "." "\\.bin"))
 606                           (copy-files-to-directory '("edwin-mechanics.com")
 607                                                    (string-append lib "/..") #t)
 608                           (copy-recursively "." lib))
 609                         (with-directory-excursion "bin"
 610                           (copy-files-to-directory (find-files ".") bin))
 611                         (with-directory-excursion "scmutils/manual"
 612                           (copy-files-to-directory (find-files ".") doc))
 613                         #t)))
 614            (add-after 'install 'emacs-helpers
 615                       ;; Add convenience Emacs commands to easily load the
 616                       ;; Scmutils band in an MIT-Scheme buffer inside of Emacs
 617                       ;; and to easily load code tags.
 618                       (lambda* (#:key inputs outputs #:allow-other-keys)
 619                         (let* ((out (assoc-ref outputs "out"))
 620                                (mit-root (assoc-ref inputs "mit-scheme"))
 621                                (emacs-lisp-dir
 622                                 (string-append out "/share/emacs/site-lisp"
 623                                                "/guix.d/" ,name "-" ,version))
 624                                (el-file (string-append emacs-lisp-dir
 625                                                        "/scmutils.el"))
 626                                (lib-relative-path
 627                                 (string-append "/lib/mit-scheme-"
 628                                                ,(system-suffix))))
 629                           (mkdir-p emacs-lisp-dir)
 630                           (call-with-output-file el-file
 631                             (lambda (p)
 632                               (format p
 633                                       ";;;###autoload
 634 (defun scmutils-load ()
 635   (interactive)
 636   (require 'xscheme)
 637   (let ((mit-root \"~a\")
 638     (scmutils \"~a\"))
 639     (run-scheme
 640      (concat mit-root \"/bin/scheme --library \"
 641           mit-root \"~a:\" scmutils \"~a\"
 642           \" --band edwin-mechanics.com\"
 643           \" --emacs\"))))
 644
 645 ;;;###autoload
 646 (defun scmutils-load-tags ()
 647   (interactive)
 648   (let ((scmutils \"~a\"))
 649     (visit-tags-table (concat scmutils \"/TAGS\"))))
 650 "
 651                                       mit-root out
 652                                       lib-relative-path
 653                                       lib-relative-path
 654                                       (string-append out lib-relative-path
 655                                                      "/scmutils"))))
 656                           (emacs-byte-compile-directory (dirname el-file))
 657                           #t))))))
 658       (home-page
 659        "http://groups.csail.mit.edu/mac/users/gjs/6946/linux-install.htm")
 660       (synopsis "Scmutils library for MIT Scheme")
 661       (description "The Scmutils system is an integrated library of
 662 procedures, embedded in the programming language Scheme, and intended to
 663 support teaching and research in mathematical physics and electrical
 664 engineering.")
 665       (license gpl2+))))