[bug#68564] [PATCH] build-system: fix the Chicken build system

[Daniel Ziltener]

---
 guix/build-system/chicken.scm       | 68 +++++++++++++++++++----------
 guix/build/chicken-build-system.scm | 17 +++-----
 2 files changed, 50 insertions(+), 35 deletions(-)

diff --git a/guix/build-system/chicken.scm b/guix/build-system/chicken.scm
index 9f518e66e6..8c6b1f5e75 100644
--- a/guix/build-system/chicken.scm
+++ b/guix/build-system/chicken.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2020 raingloom <raingloom@riseup.net>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2024 Daniel Ziltener <dziltener@lyrion.ch>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,8 @@ (define-module (guix build-system chicken)
   #: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
@@ -40,15 +43,15 @@ (define* (egg-uri name version #:optional (extension 
".tar.gz"))
 
 (define %chicken-build-system-modules
   ;; Build-side modules imported and used by default.
-  `((guix build chicken-build-system)
+  `((zilti build chicken-build-system)
     (guix build union)
     ,@%gnu-build-system-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,7 +60,7 @@ (define* (lower name
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:target #:chicken #:inputs #:native-inputs))
+    '(#:target #:chicken #:inputs #:native-inputs #:outputs))
 
   ;; TODO: cross-compilation support
   (and (not target)
@@ -77,41 +80,58 @@ (define private-keywords
                          ,@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
-                        source
+                        #:key 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)
-                        (modules '((guix build chicken-build-system)
+                        (modules '((zilti build chicken-build-system)
                                    (guix build union)
                                    (guix build utils))))
   (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)))))
+          #$(with-build-variables inputs outputs
+              #~(chicken-build #:name #$name
+                               #: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)))
diff --git a/guix/build/chicken-build-system.scm 
b/guix/build/chicken-build-system.scm
index 8f9f59cc25..6a4f0c43eb 100644
--- a/guix/build/chicken-build-system.scm
+++ b/guix/build/chicken-build-system.scm
@@ -42,13 +42,12 @@ (define (chicken-package? name)
 
 (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)
-                         '())))))
+          (string-append (assoc-ref outputs "out") "/var/lib/chicken/11/"))
+  (setenv "CHICKEN_INSTALL_PREFIX"
+          (string-append (assoc-ref outputs "out") "/bin/"))
+  (setenv "CHICKEN_REPOSITORY_PATH"
+          (string-append (getenv "CHICKEN_REPOSITORY_PATH")
+                         ":" (getenv "CHICKEN_INSTALL_REPOSITORY")))
   (setenv "CHICKEN_EGG_CACHE" (getcwd))
   #t)
 
@@ -104,10 +103,6 @@ (define* (check #:key egg-name tests? #:allow-other-keys)
   ;; there is no "-test-only" option, but we've already run install
   ;; so this just runs tests.
   ;; i think it's a fair assumption that phases won't be reordered.
-  (setenv "CHICKEN_REPOSITORY_PATH"
-          (string-append (getenv "CHICKEN_INSTALL_REPOSITORY")
-                         ":"
-                         (getenv "CHICKEN_REPOSITORY_PATH")))
   (when tests?
     (invoke "chicken-install" "-cached" "-test" "-no-install" egg-name)))
 
-- 
2.41.0