[bug#70280] [PATCH 5/5] linux-initrd: Further strip the static Guile.

[Ludovic Courtès]

‘guile-static-initrd’ weighs in at 46 MiB, compared to 54 MiB for
‘guile-static-stripped’ (15% reduction).

* gnu/packages/make-bootstrap.scm (make-guile-static-stripped): Add
‘directories-to-remove’ parameter and honor it.
(%guile-static-initrd): New variable.
* gnu/system/linux-initrd.scm (expression->initrd): Default to
‘%guile-static-initrd’.
* doc/guix.texi (Initial RAM Disk): Adjust accordingly.

Change-Id: I2baf06fed7a3698433e7c83b1d7726054a8c746e
---
 doc/guix.texi                   |  2 +-
 gnu/packages/make-bootstrap.scm | 37 ++++++++++++++++++++++++++++-----
 gnu/system/linux-initrd.scm     |  4 ++--
 3 files changed, 35 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 7ca06046ba..705f7d7de2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41339,7 +41339,7 @@ Initial RAM Disk
 program to run in that initrd.
 
 @deffn {Procedure} expression->initrd exp @
-       [#:guile %guile-static-stripped] [#:name "guile-initrd"]
+       [#:guile %guile-static-initrd] [#:name "guile-initrd"]
 Return as a file-like object a Linux initrd (a gzipped cpio archive)
 containing @var{guile} and that evaluates @var{exp}, a G-expression,
 upon booting.  All the derivations referenced by @var{exp} are
diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index 7b40f395f3..4dd45a4a27 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2021, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017, 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2018, 2019 Mark H Weaver <mhw@netris.org>
@@ -55,7 +55,8 @@ (define-module (gnu packages make-bootstrap)
             %guile-bootstrap-tarball
             %bootstrap-tarballs
 
-            %guile-static-stripped))
+            %guile-static-stripped
+            %guile-static-initrd))
 
 ;;; Commentary:
 ;;;
@@ -674,7 +675,8 @@ (define %guile-static-3.0
                        "guile-3.0-linux-syscalls.patch"
                        "guile-3.0-relocatable.patch")))
 
-(define* (make-guile-static-stripped static-guile)
+(define* (make-guile-static-stripped static-guile
+                                     #:optional (directories-to-remove '()))
   (package
     (inherit static-guile)
     (name (string-append (package-name static-guile) "-stripped"))
@@ -702,6 +704,12 @@ (define* (make-guile-static-stripped static-guile)
                  (mkdir (string-append out "/bin"))
                  (copy-file guile1 guile2)
 
+                 ;; Optionally remove additional directories.
+                 (for-each (lambda (directory)
+                             (delete-file-recursively
+                              (string-append out "/" directory)))
+                           '#$directories-to-remove)
+
                  ;; Verify that the relocated Guile works.
                  #$@(if (%current-target-system)
                         '()
@@ -720,10 +728,29 @@ (define* (make-guile-static-stripped static-guile)
     (synopsis "Minimal statically-linked and relocatable Guile")))
 
 (define %guile-static-stripped
-  ;; A stripped static Guile 3.0 binary, for use in initrds
-  ;; and during bootstrap.
+  ;; A stripped static Guile 3.0 binary for use during bootstrap.
   (make-guile-static-stripped %guile-static-3.0))
 
+(define %guile-static-initrd
+  ;; A stripped static Guile 3.0 binary for use in initrds.  Remove various
+  ;; modules that are useless in an initrd.  Note: Keep most of language/
+  ;; because it is needed for Bournish.
+  (package
+    (inherit
+     (make-guile-static-stripped
+      %guile-static-3.0
+      (append-map (lambda (directory)
+                    (list (string-append "lib/guile/3.0/ccache/" directory)
+                          (string-append "share/guile/3.0/" directory)))
+                  '("language/brainfuck"
+                    "language/ecmascript"
+                    "language/elisp"
+                    "oop"
+                    "scripts"
+                    "texinfo"
+                    "web"))))
+    (name "guile-static-initrd")))
+
 (define (tarball-package pkg)
   "Return a package containing a tarball of PKG."
   (package
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 561cfe2fd0..00221333da 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -36,7 +36,7 @@ (define-module (gnu system linux-initrd)
   #:use-module ((gnu packages xorg)
                 #:select (console-setup xkeyboard-config))
   #:use-module ((gnu packages make-bootstrap)
-                #:select (%guile-static-stripped))
+                #:select (%guile-static-initrd))
   #:use-module (gnu system file-systems)
   #:use-module (gnu system mapped-devices)
   #:use-module (gnu system keyboard)
@@ -62,7 +62,7 @@ (define-module (gnu system linux-initrd)
 
 (define* (expression->initrd exp
                              #:key
-                             (guile %guile-static-stripped)
+                             (guile %guile-static-initrd)
                              (gzip gzip)
                              (name "guile-initrd")
                              (system (%current-system)))
-- 
2.41.0