[bug#53878] [RFC PATCH 5/9] gnu: Add stex.

[Philip McGrath]

* gnu/packages/chez-and-racket-bootstrap.scm (stex-bootstrap): New
variable.
(stex): Change from origin to package inheriting from 'stex-bootstrap'.
(chez-scheme)[native-inputs]: Add 'stex-bootstrap'. Remove
labels. Remove dependencies of stex-bootstrap.
[inputs]: Remove labels.
[arguments]: Adapt to use 'stex-bootstrap', 'search-input-file', and
G-expressions.
(nanopass): Make it public as a temporary workaround for Racket.
* gnu/packages/racket.scm
(racket-bootstrap-chez-bootfiles)[native-inputs]: Update accordingly.
---
 gnu/packages/chez-and-racket-bootstrap.scm | 435 ++++++++++++---------
 gnu/packages/racket.scm                    |   5 +-
 2 files changed, 263 insertions(+), 177 deletions(-)

diff --git a/gnu/packages/chez-and-racket-bootstrap.scm 
b/gnu/packages/chez-and-racket-bootstrap.scm
index fc1da53178..c0d5e2897d 100644
--- a/gnu/packages/chez-and-racket-bootstrap.scm
+++ b/gnu/packages/chez-and-racket-bootstrap.scm
@@ -31,6 +31,7 @@ (define-module (gnu packages chez-and-racket-bootstrap)
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (guix build-system copy)
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages)
   #:use-module (gnu packages compression)
@@ -191,113 +192,83 @@ (define* (nix-system->chez-machine #:optional (system 
(%current-system))
 ;; Chez Scheme:
 ;;
 
-(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 unbundle-chez-submodules
+  #~(begin
+      (use-modules (guix build utils))
+      (for-each (lambda (dir)
+                (when (directory-exists? dir)
+                  (delete-file-recursively dir)))
+              '("stex"
+                "nanopass"
+                "lz4"
+                "zlib"))))
 
-(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 (unpack-nanopass+stex)
+  ;; delayed resolution of `nanopass`
+  #~(begin
+      (copy-recursively #$nanopass
+                        "nanopass"
+                        #:keep-mtime? #t)
+      (mkdir-p "stex")
+      (with-output-to-file "stex/Mf-stex"
+        (lambda ()
+          ;; otherwise, it will try to download submodules
+          (display "# to placate ../configure")))))
 
 (define-public chez-scheme
   (package
     (name "chez-scheme")
+    ;; The version should match `(scheme-version-number)`.
+    ;; See s/cmacros.ss c. line 360.
     (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")))))))
+    (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 unbundle-chez-submodules)))
     (build-system gnu-build-system)
     (inputs
-     `(("libuuid" ,util-linux "lib")
-       ("zlib" ,zlib)
-       ("lz4" ,lz4)
-       ;; 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)))
+     (list
+      `(,util-linux "lib") ;<-- libuuid
+      zlib
+      lz4
+      ncurses ;<-- for expeditor
+      ;; for X11 clipboard support in expeditor:
+      ;; https://github.com/cisco/ChezScheme/issues/9#issuecomment-222057232
+      libx11))
+    (native-inputs (list stex-bootstrap))
     (native-search-paths
      (list (search-path-specification
             (variable "CHEZSCHEMELIBDIRS")
             (files (list (string-append "lib/chez-scheme"))))))
     (outputs '("out" "doc"))
     (arguments
-     `(#:modules
-       ((guix build gnu-build-system)
+     (list
+      #: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)
+      #:test-target "test"
+      ;; TODO when we fix armhf, it may not support --threads
+      #:configure-flags #~'("--threads")
+      #:phases
+      #~(modify-phases %standard-phases
+          (add-after 'unpack 'unpack-nanopass+stex
+            (lambda args
+              #$(unpack-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 (configure-flags '()) #:allow-other-keys)
+              ;; add flags which are always required:
+              (let ((flags (cons* (string-append "--installprefix=" #$output)
                                   "ZLIB=-lz"
                                   "LZ4=-llz4"
                                   "--libkernel"
@@ -305,90 +276,59 @@ (define src
                                   ;; 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"))))))))
+                (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* ((scheme (search-input-file outputs "/bin/scheme"))
+                     (bin-dir (dirname scheme)))
+                (symlink scheme
+                         (string-append bin-dir "/chez-scheme"))
+                (match (find-files (string-append bin-dir "/../lib")
+                                   "scheme.boot")
+                  ((scheme.boot)
+                   (symlink scheme.boot
+                            (string-append (dirname scheme.boot)
+                                           "/chez-scheme.boot")))))))
+          ;; Building the documentation requires stex and a running scheme.
+          ;; FIXME: this is probably wrong for cross-compilation
+          (add-after 'install-symlink 'install-doc
+            (lambda* (#:key native-inputs inputs outputs
+                            #:allow-other-keys)
+              (match (assoc-ref outputs "doc")
+                (#f
+                 (format #t "not installing docs~%"))
+                (doc-prefix
+                 (let* ((chez+version (strip-store-file-name #$output))
+                        (scheme (search-input-file outputs "/bin/scheme"))
+                        (stexlib (search-input-directory
+                                  (or native-inputs inputs)
+                                  "/lib/stex"))
+                        (doc-dir (string-append doc-prefix
+                                                "/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
@@ -412,3 +352,150 @@ (define* (stex-make #:optional (suffix ""))
 generates native code for each target processor, with support for x86, x86_64,
 and 32-bit PowerPC architectures.")
     (license license:asl2.0)))
+
+;;
+;; Chez's bootstrap dependencies:
+;;
+
+(define-public stex-bootstrap
+  ;; 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")
+        (revision "1"))
+    (hidden-package
+     (package
+       (name "stex")
+       ;; ^ Debian calls this "stex", not "chez-stex". It is a set of
+       ;; command-line tools, and there isn't a Scheme API, let alone a
+       ;; Chez-specific one, except perhaps that the Scheme examples are
+       ;; assumed to be Chez-compatible.
+       (version (git-version "1.2.2" revision commit))
+       (source
+        (origin
+          (method git-fetch)
+          (uri (git-reference
+                (url "https://github.com/dybvig/stex";)
+                (commit commit)))
+          (sha256
+           (base32 "01jnvw8qw33gnpzwrakwhsr05h6b609lm180jnspcrb7lds2p23d"))
+          (file-name (git-file-name name version))
+          (snippet
+           #~(for-each delete-file
+                       '("sbin/install" "doc/stex.pdf" "doc/stex.html")))))
+       (outputs '("out"))
+       (build-system copy-build-system)
+       ;; N.B. Upstream does not seem to support cross-compilation,
+       ;; though it would probably be easy to add.
+       (propagated-inputs
+        (list xorg-rgb
+              (texlive-updmap.cfg
+               (list texlive-dvips-l3backend
+                     texlive-hyperref
+                     texlive-bibtex
+                     texlive-epsf
+                     texlive-fonts-ec
+                     texlive-oberdiek))
+              ghostscript
+              netpbm))
+       ;; Debian uses a versionless path for STEXLIB,
+       ;; which is much more convienient.
+       (arguments
+        (list
+         #:install-plan #~`(("inputs" "lib/stex/")
+                            ("gifs" "lib/stex/")
+                            ("math" "lib/stex/")
+                            ("src" "lib/stex/") ;; can run without compiling
+                            ("Mf-stex" "lib/stex/")
+                            ("Makefile.template" "lib/stex/"))
+         #:phases
+         #~(modify-phases %standard-phases
+             (add-before 'install 'patch-sources
+               (lambda* (#:key native-inputs inputs outputs #:allow-other-keys)
+                 (define scheme
+                   (false-if-exception
+                    (search-input-file inputs "/bin/scheme")))
+                 (when scheme
+                   (setenv "Scheme" scheme))
+                 (substitute* '("Makefile.template"
+                                "doc/Makefile")
+                   (("STEXLIB=[^\n]*")
+                    (string-append "STEXLIB=" #$output "/lib/stex"))
+                   (("Scheme=[^\n]*")
+                    (string-append "Scheme=" (or scheme "scheme"))))
+                 (substitute* '("Mf-stex"
+                                "math/Makefile")
+                   (("/bin/rm")
+                    "rm"))
+                 (substitute* "Mf-stex"
+                   (("SHELL=bash")
+                    ;; avoid Solaris workaround
+                    "#SHELL=bash"))))
+             (add-after 'install 'maybe-compile
+               (lambda* (#:key native-inputs inputs outputs #:allow-other-keys)
+                 (cond
+                  ((getenv "Scheme")
+                   => (lambda (scheme)
+                        (define makefile
+                          (string-append (getcwd) "/Makefile"))
+                        (define machine
+                          (let ((machine #$(nix-system->chez-machine
+                                            (or (%current-target-system)
+                                                (%current-system)))))
+                            (if (and (not (eqv? #\t (string-ref machine 0)))
+                                     (string-contains scheme "racket"))
+                                (string-append "t" machine)
+                                machine)))
+                        (with-directory-excursion
+                            (search-input-directory outputs "/lib/stex")
+                          (invoke "make"
+                                  "-f" makefile
+                                  (string-append "Scheme=" scheme))
+                          (for-each delete-file
+                                    (find-files machine
+                                                "\\.")))))
+                  (else
+                   (format #t "not compiling~%")))))
+             (add-after 'maybe-compile 'maybe-make-docs
+               (lambda* (#:key native-inputs inputs outputs #:allow-other-keys)
+                 (cond
+                  ((assoc-ref outputs "doc")
+                   => (lambda (doc-prefix)
+                        (define doc-dir
+                          (string-append doc-prefix "/share/doc/stex"))
+                        ;; the Makefile is considered part of the documentation
+                        (copy-recursively "doc" doc-dir)
+                        (install-file "ReadMe" doc-dir)
+                        (with-directory-excursion "doc"
+                          (invoke "make")
+                          (install-file "stex.html" doc-dir)
+                          (install-file "stex.pdf" doc-dir))))
+                  (else
+                   (format #t "not making docs~%"))))))))
+       (home-page "https://github.com/dybvig/stex";)
+       (synopsis "LaTeX with embeded Scheme code and HTML generation")
+       (description "The @code{stex} package extends LaTeX with a handful of
+commands for including Scheme code (or pretty much any other kind of code, as
+long as you don't plan to use the Scheme-specific transcript support) in a
+document.  It provides the programs @code{scheme-prep} and @code{html-prep} to
+convert @code{stex} documents to LaTeX and HTML, respectively, plus makefile
+templates, style files, and other resources.  The @code{stex} system is used
+to typeset @cite{The Scheme Programming Language} and the @cite{Chez Scheme
+User's Guix}, among other documents.")
+       (license license:expat)))))
+
+(define-public stex
+  (package/inherit stex-bootstrap
+    (inputs (modify-inputs (package-inputs stex-bootstrap)
+              (prepend chez-scheme)))
+    (outputs '("out" "doc"))
+    (properties '())))
+
+(define-public 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)))))
diff --git a/gnu/packages/racket.scm b/gnu/packages/racket.scm
index 865fdff70f..d8338bcd6f 100644
--- a/gnu/packages/racket.scm
+++ b/gnu/packages/racket.scm
@@ -333,9 +333,8 @@ (define-public racket-bootstrap-chez-bootfiles
       `(("racket" ,(if (%current-target-system)
                        racket-minimal
                        racket-minimal-bc-3m))
-        ("stex" ,@(assoc-ref (package-native-inputs chez-scheme) "stex"))
-        ("nanopass" ,@(assoc-ref (package-native-inputs chez-scheme)
-                                 "nanopass"))))
+        ("stex" ,(package-source stex))
+        ("nanopass" ,nanopass)))
      (arguments
       `(#:phases
         (modify-phases %standard-phases
-- 
2.32.0