Subject: [PATCH] build-system: fix and future-proof Chicken build system.

From: Daniel Ziltener <[email-masked]>
Date: Tue, 22 Apr 2025 18:52:55 +0200

This amendment removes the unused "chicken-package?" procedure.

---
 guix/build-system/chicken.scm       | 87 +++++++++++++++++++----------
 guix/build/chicken-build-system.scm | 54 ++++++++++++------
 2 files changed, 94 insertions(+), 47 deletions(-)

diff --git a/guix/build-system/chicken.scm b/guix/build-system/chicken.scm
index e6fcfa7ee3..c5705018d1 100644
--- a/guix/build-system/chicken.scm
+++ b/guix/build-system/chicken.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2020 raingloom <[email-masked]>
 ;;; Copyright © 2021 Ludovic Courtès <[email-masked]>
 ;;; Copyright © 2021 Xinglu Chen <[email-masked]>
+;;; Copyright © 2025 zilti <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,9 +24,12 @@ (define-module (guix build-system chicken)
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix monads)
+  #:use-module (guix download)
   #:use-module (guix search-paths)
   #:use-module (guix build-system)
   #:use-module (guix build-system gnu)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:use-module (guix packages)
   #:export (%chicken-build-system-modules
             chicken-build
@@ -45,10 +49,10 @@ (define %chicken-build-system-modules
     ,@%default-gnu-imported-modules))
 
 (define (default-chicken)
+  "Return the default Chicken package."
   ;; Lazily resolve the binding to avoid a circular dependency.
-  ;; TODO is this actually needed in every build system?
   (let ((chicken (resolve-interface '(gnu packages chicken))))
-      (module-ref chicken 'chicken)))
+    (module-ref chicken 'chicken)))
 
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
@@ -57,38 +61,55 @@ (define* (lower name
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:target #:chicken #:inputs #:native-inputs))
+    '(#:target #:inputs #:native-inputs #:outputs))
 
   ;; TODO: cross-compilation support
   (and (not target)
        (bag
          (name name)
          (system system)
-         (host-inputs `(,@(if source
-                              `(("source" ,source))
-                              '())
-                        ,@inputs
+         (host-inputs
+          `(,@(if source
+                  `(("source" ,source))
+                  '())
+            ,@inputs
 
-                        ;; Keep the standard inputs of 'gnu-build-system', since
-                        ;; Chicken compiles Scheme by using C as an intermediate
-                        ;; language.
-                        ,@(standard-packages)))
+            ;; Keep the standard inputs of 'gnu-build-system', since
+            ;; Chicken compiles Scheme by using C as an intermediate
+            ;; language.
+            ,@(standard-packages)))
          (build-inputs `(("chicken" ,chicken)
                          ,@native-inputs))
          (outputs outputs)
          (build chicken-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+         (arguments
+          (substitute-keyword-arguments
+              (strip-keyword-arguments private-keywords arguments)
+            ((#:extra-directories extra-directories)
+             `(list
+               ,@(append-map
+                  (lambda (name)
+                    (match (assoc name inputs)
+                      ((_ pkg)
+                       (match (package-transitive-propagated-inputs pkg)
+                         (((propagated-names . _) ...)
+                          (cons name propagated-names))))))
+                  extra-directories))))))))
 
 (define* (chicken-build name inputs
                         #:key
+                        (chicken (default-chicken))
                         source
+                        (tests? #t)
+                        (parallel-build? #f)
+                        (build-flags ''())
+                        (configure-flags ''())
+                        (extra-directories ''())
                         (phases '%standard-phases)
-                        (outputs '("out"))
+                        (outputs '("out" "static"))
                         (search-paths '())
                         (egg-name "")
                         (unpack-path "")
-                        (build-flags ''())
-                        (tests? #t)
                         (system (%current-system))
                         (guile #f)
                         (imported-modules %chicken-build-system-modules)
@@ -99,22 +120,28 @@ (define builder
     (with-imported-modules imported-modules
       #~(begin
           (use-modules #$@(sexp->gexp modules))
-          (chicken-build #:name #$name
-                         #:source #+source
-                         #:system #$system
-                         #:phases #$phases
-                         #:outputs #$(outputs->gexp outputs)
-                         #:search-paths '#$(sexp->gexp
-                                            (map search-path-specification->sexp
-                                                 search-paths))
-                         #:egg-name #$egg-name
-                         #:unpack-path #$unpack-path
-                         #:build-flags #$build-flags
-                         #:tests? #$tests?
-                         #:inputs #$(input-tuples->gexp inputs)))))
+          (chicken-build
+           #:name #$name
+           #:chicken #$chicken
+           #:source #+source
+           #:system #$system
+           #:phases #$phases
+           #:configure-flags #$configure-flags
+           #:extra-directories #$extra-directories
+           #:parallel-build? #$parallel-build?
+           #:outputs #$(outputs->gexp outputs)
+           #:search-paths '#$(sexp->gexp
+                              (map search-path-specification->sexp
+                                   search-paths))
+           #:egg-name #$egg-name
+           #:unpack-path #$unpack-path
+           #:build-flags #$build-flags
+           #:tests? #$tests?
+           #:inputs #$(input-tuples->gexp inputs)))))
 
-  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
-                                                  system #:graft? #f)))
+  (mlet %store-monad ((guile (package->derivation
+                              (or guile (default-guile))
+                              system #:graft? #f)))
     (gexp->derivation name builder
                       #:system system
                       #:guile-for-build guile)))
diff --git a/guix/build/chicken-build-system.scm b/guix/build/chicken-build-system.scm
index fd5a33fd22..6b1826ac5a 100644
--- a/guix/build/chicken-build-system.scm
+++ b/guix/build/chicken-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020 raingloom <[email-masked]>
+;;; Copyright © 2025 zilti <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,8 @@ (define-module (guix build chicken-build-system)
   #:use-module (guix build utils)
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 popen)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (rnrs io ports)
@@ -32,25 +35,42 @@ (define-module (guix build chicken-build-system)
 ;; CHICKEN_INSTALL_REPOSITORY is where dependencies are looked up
 ;; its first component is also where new eggs are installed.
 
-;; TODO: deduplicate with go-build-system.scm ?
-;; TODO: the binary version should be defined in one of the relevant modules
-;; instead of being hardcoded everywhere. Tried to do that but got undefined
-;; variable errors.
+(define (chicken-binary-version chicken)
+  (let* ((port (open-pipe*
+                OPEN_READ
+                (string-append chicken "/bin/csi")
+                "-p"
+                "(begin (import (chicken pathname) (chicken platform)) (pathname-file (car (repository-path))))"))
+         (str (read-line port)))
+    (close-pipe port)
+    str))
 
-(define (chicken-package? name)
-  (string-prefix? "chicken-" name))
+(define (chicken-lib-dir chicken)
+  (string-append
+   chicken "/var/lib/chicken/"
+   (chicken-binary-version chicken) "/"))
 
-(define* (setup-chicken-environment #:key inputs outputs #:allow-other-keys)
-  (setenv "CHICKEN_INSTALL_REPOSITORY"
-          (string-concatenate
-           ;; see TODO item about binary version above
-           (append (list (assoc-ref outputs "out") "/var/lib/chicken/11/")
-                   (let ((oldenv (getenv "CHICKEN_INSTALL_REPOSITORY")))
-                     (if oldenv
-                         (list  ":" oldenv)
-                         '())))))
-  (setenv "CHICKEN_EGG_CACHE" (getcwd))
-  #t)
+(define (egg-lib-dir chicken outputs)
+  (string-append
+   (assoc-ref outputs "out") "/var/lib/chicken/"
+   (chicken-binary-version chicken) "/"))
+
+(define* (setup-chicken-environment #:key inputs outputs chicken #:allow-other-keys)
+  (let ((chickenlibdir (chicken-lib-dir chicken))
+        (egglibdir (egg-lib-dir chicken outputs)))
+    (setenv "CHICKEN_INSTALL_REPOSITORY"
+            (string-concatenate
+             (append `(,egglibdir)
+                     (let ((oldenv (getenv "CHICKEN_INSTALL_REPOSITORY")))
+                       (if oldenv (list ":" oldenv) '())))))
+    (setenv "CHICKEN_INSTALL_PREFIX" (assoc-ref outputs "out"))
+    (setenv "CHICKEN_REPOSITORY_PATH"
+            (string-concatenate
+             (append `(,egglibdir ":" ,chickenlibdir)
+                     (let ((oldenv (getenv "CHICKEN_REPOSITORY_PATH")))
+                       (if oldenv (list ":" oldenv) '())))))
+    (setenv "CHICKEN_EGG_CACHE" (getcwd))
+    #t))
 
 ;; This is copied from go-build-system.scm so it could probably be simplified.
 ;; I used it because the source of the egg needs to be unpacked into a directory
-- 
2.49.0