maint: Require Guile 3.0.

* configure.ac: Require Guile 3.0.
* doc/guix.texi (Requirements): Adjust accordingly.
* gnu/packages/package-management.scm (guile2.2-guix): Remove.
* guix/lint.scm (exception-with-kind-and-args?): Remove 'cond-expand'.
* guix/scripts/deploy.scm (deploy-machine*): Likewise.
* guix/store.scm (call-with-store): Likewise.
* guix/swh.scm (http-get*, http-post*): Likewise.
* guix/ui.scm (without-compiler-optimizations, guard*)
(call-with-error-handling): Likewise.
This commit is contained in:
Ludovic Courtès 2021-05-26 22:30:31 +02:00
parent 49b15701ad
commit 82d8ab01f5
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
8 changed files with 32 additions and 109 deletions

View File

@ -96,16 +96,12 @@ m4_pattern_forbid([^GUIX_])
dnl Search for 'guile' and 'guild'. This macro defines dnl Search for 'guile' and 'guild'. This macro defines
dnl 'GUILE_EFFECTIVE_VERSION'. dnl 'GUILE_EFFECTIVE_VERSION'.
GUILE_PKG([3.0 2.2]) GUILE_PKG([3.0])
GUILE_PROGS GUILE_PROGS
if test "x$GUILD" = "x"; then if test "x$GUILD" = "x"; then
AC_MSG_ERROR(['guild' binary not found; please check your Guile installation.]) AC_MSG_ERROR(['guild' binary not found; please check your Guile installation.])
fi fi
if test "x$GUILE_EFFECTIVE_VERSION" = "x2.2"; then
PKG_CHECK_MODULES([GUILE], [guile-2.2 >= 2.2.6])
fi
dnl Get CFLAGS and LDFLAGS for libguile. dnl Get CFLAGS and LDFLAGS for libguile.
GUILE_FLAGS GUILE_FLAGS

View File

@ -840,8 +840,7 @@ GNU Guix is available for download from its website at
GNU Guix depends on the following packages: GNU Guix depends on the following packages:
@itemize @itemize
@item @url{https://gnu.org/software/guile/, GNU Guile}, version 3.0.x or @item @url{https://gnu.org/software/guile/, GNU Guile}, version 3.0.x;
2.2.x;
@item @url{https://notabug.org/cwebber/guile-gcrypt, Guile-Gcrypt}, version @item @url{https://notabug.org/cwebber/guile-gcrypt, Guile-Gcrypt}, version
0.1.0 or later; 0.1.0 or later;
@item @item

View File

@ -518,40 +518,6 @@ the Nix package manager.")
(invoke "make" "install-binPROGRAMS"))) (invoke "make" "install-binPROGRAMS")))
(delete 'wrap-program))))))) (delete 'wrap-program)))))))
(define-public guile2.2-guix
(package
(inherit guix)
(name "guile2.2-guix")
(native-inputs
`(("guile" ,guile-2.2)
("gnutls" ,guile2.2-gnutls)
("guile-gcrypt" ,guile2.2-gcrypt)
("guile-json" ,guile2.2-json)
("guile-lib" ,guile2.2-lib)
("guile-sqlite3" ,guile2.2-sqlite3)
("guile-ssh" ,guile2.2-ssh)
("guile-git" ,guile2.2-git)
("guile-zlib" ,guile2.2-zlib)
("guile-lzlib" ,guile2.2-lzlib)
,@(fold alist-delete (package-native-inputs guix)
'("guile" "gnutls" "guile-gcrypt" "guile-json"
"guile-lib" "guile-sqlite3" "guile-ssh" "guile-git"
"guile-zlib" "guile-lzlib"))))
(inputs
`(("guile" ,guile-2.2)
,@(alist-delete "guile" (package-inputs guix))))
(propagated-inputs
`(("gnutls" ,gnutls)
("guile-gcrypt" ,guile2.2-gcrypt)
("guile-json" ,guile2.2-json)
("guile-lib" ,guile2.2-lib)
("guile-sqlite3" ,guile2.2-sqlite3)
("guile-ssh" ,guile2.2-ssh)
("guile-git" ,guile2.2-git)
("guile-zlib" ,guile2.2-zlib)
("guile-lzlib" ,guile2.2-lzlib)))))
(define-public guile3.0-guix (define-public guile3.0-guix
(deprecated-package "guile3.0-guix" guix)) (deprecated-package "guile3.0-guix" guix))

View File

@ -1003,14 +1003,9 @@ descriptions maintained upstream."
(origin-uris origin)) (origin-uris origin))
'()))) '())))
(cond-expand ;; Guile 3.0.0 does not export this predicate.
(guile-3 (define exception-with-kind-and-args?
;; Guile 3.0.0 does not export this predicate. (exception-predicate &exception-with-kind-and-args))
(define exception-with-kind-and-args?
(exception-predicate &exception-with-kind-and-args)))
(else ;Guile 2
(define exception-with-kind-and-args?
(const #f))))
(define* (check-derivation package #:key store) (define* (check-derivation package #:key store)
"Emit a warning if we fail to compile PACKAGE to a derivation." "Emit a warning if we fail to compile PACKAGE to a derivation."

View File

@ -125,10 +125,7 @@ Perform the deployment specified by FILE.\n"))
;; and include a '&message'. However, that message only contains ;; and include a '&message'. However, that message only contains
;; the format string. Thus, special-case it here to avoid ;; the format string. Thus, special-case it here to avoid
;; displaying a bare format string. ;; displaying a bare format string.
((cond-expand (((exception-predicate &exception-with-kind-and-args) c)
(guile-3
((exception-predicate &exception-with-kind-and-args) c))
(else #f))
(raise c)) (raise c))
((message-condition? c) ((message-condition? c)

View File

@ -648,18 +648,10 @@ connection. Use with care."
(close-connection store) (close-connection store)
(apply values results))))) (apply values results)))))
(cond-expand (with-exception-handler (lambda (exception)
(guile-3 (close-connection store)
(with-exception-handler (lambda (exception) (raise-exception exception))
(close-connection store) thunk)))
(raise-exception exception))
thunk))
(else ;Guile 2.2
(catch #t
thunk
(lambda (key . args)
(close-connection store)
(apply throw key args)))))))
(define-syntax-rule (with-store store exp ...) (define-syntax-rule (with-store store exp ...)
"Bind STORE to an open connection to the store and evaluate EXPs; "Bind STORE to an open connection to the store and evaluate EXPs;

View File

@ -148,20 +148,12 @@
url url
(string-append url "/"))) (string-append url "/")))
(cond-expand ;; XXX: Work around a bug in Guile 3.0.2 where #:verify-certificate? would
(guile-3 ;; be ignored (<https://bugs.gnu.org/40486>).
;; XXX: Work around a bug in Guile 3.0.2 where #:verify-certificate? would (define* (http-get* uri #:rest rest)
;; be ignored (<https://bugs.gnu.org/40486>). (apply http-request uri #:method 'GET rest))
(define* (http-get* uri #:rest rest) (define* (http-post* uri #:rest rest)
(apply http-request uri #:method 'GET rest)) (apply http-request uri #:method 'POST rest))
(define* (http-post* uri #:rest rest)
(apply http-request uri #:method 'POST rest)))
(else ;Guile 2.2
;; Guile 2.2 did not have #:verify-certificate? so ignore it.
(define* (http-get* uri #:key verify-certificate? streaming?)
(http-request uri #:method 'GET #:streaming? streaming?))
(define* (http-post* uri #:key verify-certificate? streaming?)
(http-request uri #:method 'POST #:streaming? streaming?))))
(define %date-regexp (define %date-regexp
;; Match strings like "2014-11-17T22:09:38+01:00" or ;; Match strings like "2014-11-17T22:09:38+01:00" or

View File

@ -196,17 +196,11 @@ information, or #f if it could not be found."
(stack-ref stack 1) ;skip the 'throw' frame (stack-ref stack 1) ;skip the 'throw' frame
last)))) last))))
(cond-expand (define-syntax-rule (without-compiler-optimizations exp)
(guile-3 ;; Compile with the baseline compiler (-O1), which is much less expensive
(define-syntax-rule (without-compiler-optimizations exp) ;; than -O2.
;; Compile with the baseline compiler (-O1), which is much less expensive (parameterize (((@ (system base compile) default-optimization-level) 1))
;; than -O2. exp))
(parameterize (((@ (system base compile) default-optimization-level) 1))
exp)))
(else
(define-syntax-rule (without-compiler-optimizations exp)
;; No easy way to turn off optimizations on Guile 2.2.
exp)))
(define* (load* file user-module (define* (load* file user-module
#:key (on-error 'nothing-special)) #:key (on-error 'nothing-special))
@ -674,22 +668,17 @@ or variants of @code{~a} in the same profile.")
or remove one of them from the profile.") or remove one of them from the profile.")
name1 name2))))) name1 name2)))))
(cond-expand ;; On Guile 3.0, in 'call-with-error-handling' we need to re-raise. To
(guile-3 ;; preserve useful backtraces in case of unhandled errors, we want that to
;; On Guile 3.0, in 'call-with-error-handling' we need to re-raise. To ;; happen before the stack has been unwound, hence 'guard*'.
;; preserve useful backtraces in case of unhandled errors, we want that to (define-syntax-rule (guard* (var clauses ...) exp ...)
;; happen before the stack has been unwound, hence 'guard*'. "This variant of SRFI-34 'guard' does not unwind the stack before
(define-syntax-rule (guard* (var clauses ...) exp ...)
"This variant of SRFI-34 'guard' does not unwind the stack before
evaluating the tests and bodies of CLAUSES." evaluating the tests and bodies of CLAUSES."
(with-exception-handler (with-exception-handler
(lambda (var) (lambda (var)
(cond clauses ... (else (raise var)))) (cond clauses ... (else (raise var))))
(lambda () exp ...) (lambda () exp ...)
#:unwind? #f))) #:unwind? #f))
(else
(define-syntax-rule (guard* (var clauses ...) exp ...)
(guard (var clauses ...) exp ...))))
(define (call-with-error-handling thunk) (define (call-with-error-handling thunk)
"Call THUNK within a user-friendly error handler." "Call THUNK within a user-friendly error handler."
@ -822,10 +811,7 @@ directories:~{ ~a~}~%")
;; Furthermore, use of 'guard*' ensures that the stack has not ;; Furthermore, use of 'guard*' ensures that the stack has not
;; been unwound when we re-raise, since that would otherwise show ;; been unwound when we re-raise, since that would otherwise show
;; useless backtraces. ;; useless backtraces.
((cond-expand (((exception-predicate &exception-with-kind-and-args) c)
(guile-3
((exception-predicate &exception-with-kind-and-args) c))
(else #f))
(raise c)) (raise c))
((message-condition? c) ((message-condition? c)