Package: guix-patches;
Reported by: Daniel Ziltener <dziltener <at> lyrion.ch>
Date: Thu, 17 Apr 2025 20:42:05 UTC
Severity: normal
Tags: patch
View this message in rfc822 format
From: Daniel Ziltener <dziltener <at> lyrion.ch> To: 77877 <at> debbugs.gnu.org Cc: Daniel Ziltener <dziltener <at> lyrion.ch> Subject: [bug#77877] [PATCH] build-system: fix and future-proof Chicken build system. Date: Thu, 17 Apr 2025 22:33:50 +0200
---
guix/build-system/chicken.scm | 87 +++++++++++++++++++----------
guix/build/chicken-build-system.scm | 55 ++++++++++++------
2 files changed, 96 insertions(+), 46 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 <raingloom <at> riseup.net>
;;; Copyright © 2021 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2021 Xinglu Chen <public <at> yoctocell.xyz>
+;;; Copyright © 2025 zilti <dziltener <at> 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
,@%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..b7c5ae4acd 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 <at> riseup.net>
+;;; Copyright © 2025 zilti <dziltener <at> lyrion.ch>
;;;
;;; 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,45 @@ (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-package? name)
(string-prefix? "chicken-" 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)
- '())))))
- (setenv "CHICKEN_EGG_CACHE" (getcwd))
- #t)
+(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-lib-dir chicken)
+ (string-append
+ chicken "/var/lib/chicken/"
+ (chicken-binary-version chicken) "/"))
+
+(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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.