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

[Daniel Ziltener via Guix-patches via <guix-patches@gnu.org>]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 7382 bytes --]

---
 guix/build-system/chicken.scm       | 38 ++++++++++++++++++++++-------
 guix/build/chicken-build-system.scm | 25 ++++++++-----------
 2 files changed, 39 insertions(+), 24 deletions(-)

diff --git a/guix/build-system/chicken.scm b/guix/build-system/chicken.scm
index 9f518e66e6..e2b93391bf 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.
 ;;;
@@ -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
     ,@%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 +61,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,18 +81,31 @@ (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)
@@ -103,6 +120,9 @@ (define builder
                          #: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
diff --git a/guix/build/chicken-build-system.scm b/guix/build/chicken-build-system.scm
index 8f9f59cc25..944f023987 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 <raingloom@riseup.net>
+;;; Copyright © 2024 Daniel Ziltener <dziltener@lyrion.ch>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,7 +33,6 @@ (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.
@@ -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)
 
@@ -58,9 +57,9 @@ (define* (setup-chicken-environment #:key inputs outputs #:allow-other-keys)
 (define* (unpack #:key source egg-name unpack-path #:allow-other-keys)
   "Relative to $CHICKEN_EGG_CACHE, unpack SOURCE in UNPACK-PATH, or EGG-NAME
 when UNPACK-PATH is unset.  If the SOURCE archive has a single top level
-directory, it is stripped so that the sources appear directly under UNPACK-PATH.
-When SOURCE is a directory, copy its content into UNPACK-PATH instead of
-unpacking."
+directory, it is stripped so that the sources appear directly under
+UNPACK-PATH.  When SOURCE is a directory, copy its content into UNPACK-PATH
+instead of unpacking."
   (define (unpack-maybe-strip source dest)
     (let* ((scratch-dir (string-append (or (getenv "TMPDIR") "/tmp")
                                        "/scratch-dir"))
@@ -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.44.0