>From 2cec50928a4ff67df363322d2adfb6aaa5aedc83 Mon Sep 17 00:00:00 2001
From: Timothy Sample <address@hidden>
Date: Mon, 3 Feb 2020 10:51:07 -0500
Subject: [PATCH 2/3] Simplify bootstrap Gash and Gash-Utils.

This change does three things.  First Gash-Utils is updated to
0.1.0-preview.  Then, the bootstrap Gash and Gash-Utils packages are
arranged to be built without using 'guild'.  Finally, instead of
using a binary 'tar' via 'bootstrap-executable' to extract Gash and
Gash-Utils, a self-extracting Scheme implementation of 'tar' and
'gzip' is used instead.

These three changes need to happen in concert to avoid breaking the
bootstrap process.

* gnu/packages/shells.scm (gash-utils): Update to 0.1.0-preview.
* gnu/packages/commencement.scm (make-bootstrap-phases): New procedure.
(bootar): New variable.
(gash-boot): Replace 'tar', and 'xz' with 'bootar'; remove 'bash' and
'guile-source'; do not use 'guile-build-system' but rather
'gnu-build-system' with its phases processed by 'make-bootstrap-phases';
disable tests.
(gash-utils-boot): Likewise.
(%boot-gash-inputs): Add 'bootar'; replace '%bootstrap-guile+guild' with
'%bootstrap-guile'.
(mes-boot): In the configure phase, do not reference 'GUILE_LOAD_PATH'
as it is no longer set.
---
 gnu/packages/commencement.scm | 431 ++++++++++++++++------------------
 gnu/packages/shells.scm       |   8 +-
 2 files changed, 206 insertions(+), 233 deletions(-)

diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index 43533b4525..914b3f2a8d 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2018 Tobias Geerinckx-Rice <address@hidden>
 ;;; Copyright © 2018, 2019 Jan (janneke) Nieuwenhuizen <address@hidden>
 ;;; Copyright © 2019 Marius Bakke <address@hidden>
+;;; Copyright © 2020 Timothy Sample <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -53,7 +54,6 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
-  #:use-module (guix build-system guile)
   #:use-module (guix build-system trivial)
   #:use-module (guix memoization)
   #:use-module (guix utils)
@@ -144,252 +144,226 @@
             (variable "GUILE_LOAD_COMPILED_PATH")
             (files '("lib/guile/2.0/site-ccache")))))))
 
+(define (make-bootstrap-phases version scripts modules)
+  "Create a form that modifies the standard GNU build phases so that
+they build simple Guile programs using only the bootstrap Guile.  The
+'.in' files in the directory MODULES are configured with VERSION, the
+'.in' files in the directory SCRIPTS are configured with the bootstrap
+Guile and its module and object directories, and the Scheme files in the
+directory MODULES are compiled and installed."
+  `(modify-phases %standard-phases
+     (replace 'configure
+       (lambda* (#:key inputs outputs #:allow-other-keys)
+         (let* ((out (assoc-ref outputs "out"))
+                (guile-dir (assoc-ref inputs "guile"))
+                (guile (string-append guile-dir "/bin/guile"))
+                (moddir (string-append out "/share/guile/site/"
+                                       (effective-version)))
+                (godir (string-append out "/lib/guile/"
+                                      (effective-version)
+                                      "/site-ccache")))
+           (for-each (lambda (template)
+                       (format #t "Configuring ~a~%" template)
+                       (let ((target (string-drop-right template 3)))
+                         (copy-file template target)
+                         (substitute* target
+                           (("@VERSION@") ,version))))
+                     (find-files ,modules
+                                 (lambda (fn st)
+                                   (string-suffix? ".in" fn))))
+           (for-each (lambda (template)
+                       (format #t "Configuring ~a~%" template)
+                       (let ((target (string-drop-right template 3)))
+                         (copy-file template target)
+                         (substitute* target
+                           (("@GUILE@") guile)
+                           (("@MODDIR@") moddir)
+                           (("@GODIR@") godir))
+                         (chmod target #o755)))
+                     (find-files ,scripts
+                                 (lambda (fn st)
+                                   (string-suffix? ".in" fn))))
+           #t)))
+     (replace 'build
+       (lambda _
+         (add-to-load-path (getcwd))
+         (for-each (lambda (scm)
+                     (let* ((base (string-drop-right scm 4))
+                            (go (string-append base ".go"))
+                            (dir (dirname scm)))
+                       (format #t "Compiling ~a~%" scm)
+                       (compile-file scm #:output-file go)))
+                   (find-files ,modules "\\.scm$"))
+         #t))
+     (replace 'install
+       (lambda* (#:key inputs outputs #:allow-other-keys)
+         (let* ((out (assoc-ref outputs "out"))
+                (guile-dir (assoc-ref inputs "guile"))
+                (guile (string-append guile-dir "/bin/guile"))
+                (moddir (string-append out "/share/guile/site/"
+                                       (effective-version)))
+                (godir (string-append out "/lib/guile/"
+                                      (effective-version)
+                                      "/site-ccache")))
+           (for-each (lambda (scm)
+                       (let* ((base (string-drop-right scm 4))
+                              (go (string-append base ".go"))
+                              (dir (dirname scm)))
+                         (format #t "Installing ~a~%" scm)
+                         (install-file scm (string-append moddir "/" dir))
+                         (format #t "Installing ~a~%" go)
+                         (install-file go (string-append godir "/" dir))))
+                     (find-files ,modules "\\.scm$"))
+           (for-each (lambda (script)
+                       (format #t "Installing ~a~%" script)
+                       (install-file script (string-append out "/bin")))
+                     (find-files ,scripts
+                                 (lambda (fn st)
+                                   (executable-file? fn))))
+           #t)))))
+
+(define bootar
+  (package
+    (name "bootar")
+    (version "1")
+    (source (origin
+              (method url-fetch)
+              (uri "https://files.ngyro.com/tmp/bootar-1.ses")
+              (sha256
+               (base32
+                "0f37f1lav7y9nf2c6s783z7w4jfrpqrgcksqb028al82f0dn1glv"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:implicit-inputs? #f
+       #:tests? #f
+       #:guile ,%bootstrap-guile
+       #:phases
+       (modify-phases ,(make-bootstrap-phases version "scripts" ".")
+         (replace 'unpack
+           (lambda* (#:key inputs #:allow-other-keys)
+             (let* ((source (assoc-ref inputs "source"))
+                    (guile-dir (assoc-ref inputs "guile"))
+                    (guile (string-append guile-dir "/bin/guile")))
+               (invoke guile "--no-auto-compile" source)
+               (chdir "bootar")
+               #t))))))
+    (inputs `(("guile" ,%bootstrap-guile)))
+    (home-page "https://git.ngyro.com/bootar")
+    (synopsis "Tar decompression and extraction in Guile Scheme")
+    (description "Bootar is a simple Tar extractor written in Guile
+Scheme.  It supports running 'tar xvf' on uncompressed tarballs or
+tarballs that are compressed with BZip2, GZip, or XZ.  It also provides
+standalone scripts for 'bzip2', 'gzip', and 'xz' that each support
+decompression to standard output.
+
+What makes this special is that Bootar is distributed as a
+self-extracting Scheme (SES) program.  That is, a little script that
+outputs the source code of Bootar.  This makes it possible to go from
+pure Scheme to Tar and decompression in one easy step.")
+    (license gpl3+)))
+
 (define gash-boot
   (package
     (inherit gash)
     (name "gash-boot")
-    (version "0.2.0")
-    (source (bootstrap-origin
-             (origin (inherit (package-source gash))
-                     (modules '((guix build utils)
-                                (srfi srfi-26)))
-                     (snippet
-                      '(begin
-                         ;; Remove Guix'y files that we cannot compile.
-                         (delete-file "guix.scm")
-                         (delete-file-recursively "tests")
-                         #t)))))
-    (build-system guile-build-system)
-    (native-inputs `(("bash" ,(bootstrap-executable "bash" (%current-system)))
-                     ("tar" ,(bootstrap-executable "tar" (%current-system)))
-                     ("xz" ,(bootstrap-executable "xz" (%current-system)))
-                     ("guile-source" ,(bootstrap-origin
-                                       (package-source guile-2.0)))))
-    (inputs `(("guile" ,%bootstrap-guile+guild)))
+    (source (origin
+              (inherit (package-source gash))
+              (modules '())))
     (arguments
      `(#:implicit-inputs? #f
-       #:guile ,%bootstrap-guile+guild
+       #:tests? #f
+       #:guile ,%bootstrap-guile
        #:phases
-       (modify-phases %standard-phases
-         (add-after 'unpack 'unpack-guile-source
-           (lambda _
-             (let ((guile-source (assoc-ref %build-inputs "guile-source"))
-                   (bin (string-append (getcwd) "/zee-bin")))
-               (mkdir-p bin)
-               (with-directory-excursion bin
-                 (invoke "tar" "--strip-components=2"
-
-                         "-xvf" guile-source
-                         (string-append "guile-"
-                                        ,(package-version guile-2.0)
-                                        "/meta/guild.in"))
-                 (copy-file "guild.in" "guild")
-                 (chmod "guild" #o555))
-               #t)))
-         (add-before 'unpack 'set-path
-           (lambda _
-             (let ((bash (assoc-ref %build-inputs "bash"))
-                   (tar (assoc-ref %build-inputs "tar"))
-                   (xz (assoc-ref %build-inputs "xz"))
-                   (bin (string-append (getcwd) "/zee-bin")))
-               (mkdir-p bin)
-               (setenv "PATH" (string-append bin ":" (getenv "PATH")))
-               (copy-file bash (string-append bin "/bash"))
-               (copy-file bash (string-append bin "/sh"))
-               (copy-file tar (string-append bin "/tar"))
-               (copy-file xz (string-append bin "/xz"))
-               #t)))
-         (add-after 'build 'build-scripts
-           (lambda _
-             (let* ((guile (assoc-ref %build-inputs "guile"))
-                    (guile (string-append guile "/bin/guile"))
-                    (out (assoc-ref %outputs "out"))
-                    (effective "2.0")
-                    (moddir (string-append out "/share/guile/site/" effective "/"))
-                    (godir (string-append out "/lib/guile/" effective "/site-ccache/")))
-               (copy-file "scripts/gash.in" "scripts/gash")
-               (chmod "scripts/gash" #o555)
-               (substitute* "scripts/gash"
-                 (("@GUILE@") guile)
-                 (("@MODDIR@") moddir)
-                 (("@GODIR") godir))
-               #t)))
-         (add-after 'install 'install-scripts
-           (lambda _
-             (let* ((out (assoc-ref %outputs "out"))
-                    (bin (string-append out "/bin")))
-               (install-file "scripts/gash" bin)
-               (copy-file "scripts/gash" "scripts/sh")
-               (install-file "scripts/sh" bin)
-               (copy-file "scripts/gash" "scripts/bash")
-               (install-file "scripts/bash" bin)
-               #t))))))))
+       (modify-phases ,(make-bootstrap-phases (version) "scripts" "gash")
+         (add-after 'install 'install-symlinks
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (symlink (string-append out "/bin/gash")
+                        (string-append out "/bin/sh"))
+               (symlink (string-append out "/bin/gash")
+                        (string-append out "/bin/bash"))
+               #t))))))
+    (inputs `(("guile" ,%bootstrap-guile)))
+    (native-inputs `(("bootar" ,bootar)))))
 
 (define gash-utils-boot
   (package
     (inherit gash-utils)
     (name "gash-utils-boot")
-    (version "0.0.214-fc1b")
-    (source (bootstrap-origin
-             (origin
-               (method url-fetch)
-               (uri (string-append "http://lilypond.org/janneke/"
-                                   "/gash-core-utils-" version ".tar.gz"))
-               (modules '((guix build utils)))
-               (snippet
-                '(begin
-                   ;; The Guile build system compiles *.scm; avoid
-                   ;; compiling included lalr.
-                   (delete-file "guix.scm")
-                   (delete-file-recursively "tests")
-                   (substitute* "system/base/lalr.scm"
-                     (("system/base/lalr.upstream.scm") "lalr.upstream.scm"))
-                   #t))
-               (sha256
-                (base32
-                 "090d8m0b165jf9381nhqpljc5zk22jd6bw03xnyf0na5snk9xp6v")))))
-    (build-system guile-build-system)
-    (native-inputs `(("bash" ,(bootstrap-executable "bash" (%current-system)))
-                     ("tar" ,(bootstrap-executable "tar" (%current-system)))
-                     ("xz" ,(bootstrap-executable "xz" (%current-system)))
-                     ("guile-source" ,(bootstrap-origin
-                                       (package-source guile-2.0)))
-                     ;; We need the 2.0.9 lalr for %bootstrap-guile
-                     ("lalr.upstream"
-                      ,(origin
-                         (method url-fetch)
-                         (uri (string-append "http://git.savannah.gnu.org/cgit/guile.git/plain/module/system/base/lalr.upstream.scm?h=v2.0.9"))
-                         (file-name "lalr.upstream.scm")
-                         (sha256
-                          (base32
-                           "0h7gyjj8nr2qrgzwma146s7l22scp8bbcqzdy9wqf12bgyhbw7d5"))))))
-    (inputs `(("guile" ,%bootstrap-guile+guild)
-              ("gash" ,gash-boot)))
     (arguments
      `(#:implicit-inputs? #f
-       #:guile ,%bootstrap-guile+guild
-       #:not-compiled-file-regexp "upstream\\.scm$"
+       #:tests? #f
+       #:guile ,%bootstrap-guile
        #:phases
-       (modify-phases %standard-phases
-         (add-after 'unpack 'unpack-guile-source
-           (lambda _
-             (let ((guile-source (assoc-ref %build-inputs "guile-source"))
-                   (bin (string-append (getcwd) "/zee-bin")))
-               (mkdir-p bin)
-               (with-directory-excursion bin
-                 (invoke "tar" "--strip-components=2"
-
-                         "-xvf" guile-source
-                         (string-append "guile-"
-                                        ,(package-version guile-2.0)
-                                        "/meta/guild.in"))
-                 (copy-file "guild.in" "guild")
-                 (chmod "guild" #o555))
-               #t)))
-         (add-before 'unpack 'set-path
-           (lambda _
-             (let ((bash (assoc-ref %build-inputs "bash"))
-                   (tar (assoc-ref %build-inputs "tar"))
-                   (xz (assoc-ref %build-inputs "xz"))
-                   (bin (string-append (getcwd) "/zee-bin")))
-               (mkdir-p bin)
-               (setenv "PATH" (string-append bin ":" (getenv "PATH")))
-               (copy-file bash (string-append bin "/bash"))
-               (copy-file bash (string-append bin "/sh"))
-               (copy-file tar (string-append bin "/tar"))
-               (copy-file xz (string-append bin "/xz"))
-               #t)))
-         (add-before 'build 'set-env
-           (lambda _
-             (let ((gash (assoc-ref %build-inputs "gash")))
-               (setenv "LANG" "C")
-               (setenv "LC_ALL" "C")
-               (setenv "GUILE_LOAD_PATH"
-                       (string-append (getcwd)
-                                      ":" (getcwd) "/system/base"
-                                      ":" gash "/share/guile/2.0"))
-               (setenv "GUILE_LOAD_COMPILED_PATH"
-                       (string-append ".:" gash "/lib/guile/2.0/site-ccache/"))
-               (format (current-error-port)
-                       "GUILE_LOAD_PATH=~s\n" (getenv "GUILE_LOAD_PATH"))
-               #t)))
-         (add-before 'build 'replace-lalr.upstream
-           (lambda _
-             (let ((lalr.upstream (assoc-ref %build-inputs "lalr.upstream")))
-               (copy-file lalr.upstream "system/base/lalr.upstream.scm")
-               #t)))
-         (add-after 'build 'build-scripts
+       (modify-phases ,(make-bootstrap-phases (version) "scripts" "gash")
+         (add-after 'unpack 'set-load-path
+           (lambda* (#:key inputs #:allow-other-keys)
+             (let ((gash (assoc-ref inputs "gash")))
+               (add-to-load-path (string-append gash "/share/guile/site/"
+                                                (effective-version))))
+             #t))
+         (add-before 'configure 'pre-configure
            (lambda _
-             (let* ((guile (assoc-ref %build-inputs "guile"))
-                    (guile (string-append guile "/bin/guile"))
-                    (gash (string-append guile "gash"))
-                    (out (assoc-ref %outputs "out"))
-                    (effective "2.0")
-                    (guilemoduledir (string-append gash "/share/guile/site/" effective "/"))
-                    (guileobjectdir (string-append gash "/lib/guile/" effective "/site-ccache/"))
-                    (gashmoduledir (string-append out "/share/guile/site/" effective "/"))
-                    (gashobjectdir (string-append out "/lib/guile/" effective "/site-ccache/"))
-                    (bin (string-append out "/bin")))
-               (define (wrap name)
-                 (copy-file "command.in" name)
-                 (chmod name #o555)
-                 (substitute* name
-                   (("@GUILE@") guile)
-                   (("@guilemoduledir@") guilemoduledir)
-                   (("@guileobjectdir") guileobjectdir)
-                   (("@gashmoduledir@") gashmoduledir)
-                   (("@gashobjectdir") gashobjectdir)
-                   (("@command@") name))
-                 (install-file name bin))
-               (mkdir-p bin)
-               (with-directory-excursion "bin"
-                 (for-each wrap '("awk"
-                                  "basename"
-                                  "cat"
-                                  "chmod"
-                                  "cmp"
-                                  "compress"
-                                  "cp"
-                                  "cut"
-                                  "diff"
-                                  "dirname"
-                                  "expr"
-                                  "false"
-                                  "find"
-                                  "grep"
-                                  "gzip"
-                                  "head"
-                                  "ln"
-                                  "ls"
-                                  "mkdir"
-                                  "mv"
-                                  "pwd"
-                                  "reboot"
-                                  "rm"
-                                  "rmdir"
-                                  "sed"
-                                  "sleep"
-                                  "sort"
-                                  "tar"
-                                  "test"
-                                  "touch"
-                                  "tr"
-                                  "true"
-                                  "uname"
-                                  "uniq"
-                                  "wc"
-                                  "which")))
-               (with-directory-excursion bin
-                 (copy-file "grep" "fgrep")
-                 (copy-file "grep" "egrep")
-                 (copy-file "test" "["))
-               #t))))))))
+             (format #t "Creating gash/commands/testb.scm~%")
+             (copy-file "gash/commands/test.scm"
+                        "gash/commands/testb.scm")
+             (substitute* "gash/commands/testb.scm"
+               (("gash commands test") "gash commands testb")
+               (("apply test [(]cdr") "apply test/bracket (cdr"))
+             (for-each (lambda (script)
+                         (let ((target (string-append "scripts/"
+                                                      script ".in")))
+                           (format #t "Creating scripts/~a~%" target)
+                           (copy-file "scripts/template.in" target)
+                           (substitute* target
+                             (("@UTILITY@") script))))
+                       '("awk" "basename" "cat" "chmod" "cmp" "command"
+                         "compress" "cp" "cut" "diff" "dirname" "expr"
+                         "false" "find" "grep" "head" "ln" "ls" "mkdir"
+                         "mv" "printf" "pwd" "reboot" "rm" "rmdir"
+                         "sed" "sleep" "sort" "tar" "test" "touch" "tr"
+                         "true" "uname" "uniq" "wc" "which"))
+             (format #t "Creating scripts/[.in~%")
+             (copy-file "scripts/template.in" "scripts/[.in")
+             (substitute* "scripts/[.in"
+               (("@UTILITY@") "testb"))
+             #t))
+         ;; XXX: The scripts should add Gash to their load paths and
+         ;; this phase should not exist.  Although ultimately, Gash
+         ;; should depend on Gash-Utils, so that it can treat its
+         ;; commands as built-ins.
+         (add-after 'install 'copy-gash
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (moddir (string-append out "/share/guile/site/"
+                                           (effective-version)))
+                    (godir (string-append out "/lib/guile/"
+                                          (effective-version)
+                                          "/site-ccache"))
+                    (gash (assoc-ref inputs "gash"))
+                    (gash-moddir (string-append gash "/share/guile/site/"
+                                                (effective-version)))
+                    (gash-godir (string-append gash "/lib/guile/"
+                                               (effective-version)
+                                               "/site-ccache")))
+               (copy-file (string-append gash-moddir "/gash/compat.scm")
+                          (string-append moddir "/gash/compat.scm"))
+               (copy-recursively (string-append gash-moddir "/gash/compat")
+                                 (string-append moddir "/gash/compat"))
+               (copy-file (string-append gash-godir "/gash/compat.go")
+                          (string-append godir "/gash/compat.go"))
+               (copy-recursively (string-append gash-godir "/gash/compat")
+                                 (string-append godir "/gash/compat"))
+               #t))))))
+    (inputs `(("gash" ,gash-boot)
+              ("guile" ,%bootstrap-guile)))
+    (native-inputs `(("bootar" ,bootar)))))
 
 (define (%boot-gash-inputs)
   `(("bash" , gash-boot)                ; gnu-build-system wants "bash"
     ("coreutils" , gash-utils-boot)
-    ("guile" ,%bootstrap-guile)
-    ("guile+guild" ,%bootstrap-guile+guild)))
+    ("bootar" ,bootar)
+    ("guile" ,%bootstrap-guile)))
 
 (define %bootstrap-mes-rewired
   (package
@@ -542,8 +516,7 @@ $MES -e '(mescc)' module/mescc.scm -- \"$@\"
                (setenv "GUILE_LOAD_PATH"
                        (string-append
                         mes "/share/mes/module"
-                        ":" dir "/nyacc-0.99.0/module"
-                        ":" (getenv "GUILE_LOAD_PATH")))
+                        ":" dir "/nyacc-0.99.0/module"))
                (invoke "gash" "configure.sh"
                        (string-append "--prefix=" out)
                        (string-append "--host=i686-linux-gnu")))))
diff --git a/gnu/packages/shells.scm b/gnu/packages/shells.scm
index ea61e7b2f8..718908e5ce 100644
--- a/gnu/packages/shells.scm
+++ b/gnu/packages/shells.scm
@@ -830,14 +830,14 @@ as part of the Guix bootstrap process.")
 (define-public gash-utils
   (package
     (name "gash-utils")
-    (version "0.0.211-789c3")
+    (version "0.1.0-preview")
     (source (origin
               (method url-fetch)
-              (uri (string-append "http://lilypond.org/janneke/guix/20191123/"
-                                  "/gash-core-utils-" version ".tar.gz"))
+              (uri (string-append "https://files.ngyro.com/tmp/gash-utils-"
+                                  version ".tar.gz"))
               (sha256
                (base32
-                "1ycf0ivyn9q3lc9hwq8vxg6wkwpsykvh48a5lrzsmganh0ma8wrr"))))
+                "1d6rmhhsgqbwjbi0fp383ac6gnxqd8yaq43mbc63xalni13g3mbc"))))
     (build-system gnu-build-system)
     (native-inputs
      `(("autoconf" ,autoconf)
-- 
2.24.1