Package: guix-patches;
Reported by: Daniel Ziltener <dziltener <at> lyrion.ch>
Date: Thu, 17 Apr 2025 20:42:05 UTC
Severity: normal
Tags: patch
To reply to this bug, email your comments to 77877 AT debbugs.gnu.org.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#77877; Package guix-patches.
(Thu, 17 Apr 2025 20:42:07 GMT) Full text and rfc822 format available.Daniel Ziltener <dziltener <at> lyrion.ch>:guix-patches <at> gnu.org.
(Thu, 17 Apr 2025 20:42:07 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Daniel Ziltener <dziltener <at> lyrion.ch> To: guix-patches <at> gnu.org Cc: Daniel Ziltener <dziltener <at> lyrion.ch> Subject: [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
guix-patches <at> gnu.org:bug#77877; Package guix-patches.
(Tue, 22 Apr 2025 16:55:01 GMT) Full text and rfc822 format available.Message #8 received at 77877 <at> debbugs.gnu.org (full text, mbox):
From: Daniel Ziltener <dziltener <at> lyrion.ch> To: 77877 <at> debbugs.gnu.org Cc: Daniel Ziltener <dziltener <at> lyrion.ch> Subject: [PATCH] build-system: fix and future-proof Chicken build system. 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 <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..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 <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,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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.