self: Drop support for Guix < 0.15 on Guile 2.0.
* guix/self.scm (false-if-wrong-guile, package-for-guile): Remove. (specification->package): Remove "guile2.0-" variants. (compiled-guix): #:guile-for-build defaults to (default-guile). Use 'specification->package' instead of 'package-for-guile'. (guile-for-build): Remove. (guix-derivation): Use 'default-guile' instead of 'guile-for-build'. Check whether we're running on Guile 2.0 with PULL-VERSION < 1.
This commit is contained in:
parent
76832d3420
commit
6e54e488c6
|
@ -31,6 +31,7 @@
|
||||||
#:use-module ((guix build compile) #:select (%lightweight-optimizations))
|
#:use-module ((guix build compile) #:select (%lightweight-optimizations))
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
|
#:use-module (srfi srfi-35)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (make-config.scm
|
#:export (make-config.scm
|
||||||
whole-package ;for internal use in 'guix pull'
|
whole-package ;for internal use in 'guix pull'
|
||||||
|
@ -43,35 +44,6 @@
|
||||||
;;; Dependency handling.
|
;;; Dependency handling.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define* (false-if-wrong-guile package
|
|
||||||
#:optional (guile-version (effective-version)))
|
|
||||||
"Return #f if PACKAGE depends on the \"wrong\" major version of Guile (e.g.,
|
|
||||||
2.0 instead of 2.2), otherwise return PACKAGE."
|
|
||||||
(let ((guile (any (match-lambda
|
|
||||||
((label (? package? dep) _ ...)
|
|
||||||
(and (string=? (package-name dep) "guile")
|
|
||||||
dep)))
|
|
||||||
(package-direct-inputs package))))
|
|
||||||
(and (or (not guile)
|
|
||||||
(string-prefix? guile-version
|
|
||||||
(package-version guile)))
|
|
||||||
package)))
|
|
||||||
|
|
||||||
(define (package-for-guile guile-version . names)
|
|
||||||
"Return the package with one of the given NAMES that depends on
|
|
||||||
GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches."
|
|
||||||
(let loop ((names names))
|
|
||||||
(match names
|
|
||||||
(()
|
|
||||||
#f)
|
|
||||||
((name rest ...)
|
|
||||||
(match (specification->package name)
|
|
||||||
(#f
|
|
||||||
(loop rest))
|
|
||||||
((? package? package)
|
|
||||||
(or (false-if-wrong-guile package guile-version)
|
|
||||||
(loop rest))))))))
|
|
||||||
|
|
||||||
(define specification->package
|
(define specification->package
|
||||||
;; Use our own variant of that procedure because that of (gnu packages)
|
;; Use our own variant of that procedure because that of (gnu packages)
|
||||||
;; would traverse all the .scm files, which is wasteful.
|
;; would traverse all the .scm files, which is wasteful.
|
||||||
|
@ -89,12 +61,7 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches."
|
||||||
("gzip" (ref '(gnu packages compression) 'gzip))
|
("gzip" (ref '(gnu packages compression) 'gzip))
|
||||||
("bzip2" (ref '(gnu packages compression) 'bzip2))
|
("bzip2" (ref '(gnu packages compression) 'bzip2))
|
||||||
("xz" (ref '(gnu packages compression) 'xz))
|
("xz" (ref '(gnu packages compression) 'xz))
|
||||||
("guile2.0-json" (ref '(gnu packages guile) 'guile2.0-json))
|
(_ #f)))) ;no such package
|
||||||
("guile2.0-ssh" (ref '(gnu packages ssh) 'guile2.0-ssh))
|
|
||||||
("guile2.0-git" (ref '(gnu packages guile) 'guile2.0-git))
|
|
||||||
;; XXX: No "guile2.0-sqlite3".
|
|
||||||
("guile2.0-gnutls" (ref '(gnu packages tls) 'gnutls/guile-2.0))
|
|
||||||
(_ #f)))) ;no such package
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
@ -528,7 +495,7 @@ Info manual."
|
||||||
(pull-version 1)
|
(pull-version 1)
|
||||||
(name (string-append "guix-" version))
|
(name (string-append "guix-" version))
|
||||||
(guile-version (effective-version))
|
(guile-version (effective-version))
|
||||||
(guile-for-build (guile-for-build guile-version))
|
(guile-for-build (default-guile))
|
||||||
(zlib (specification->package "zlib"))
|
(zlib (specification->package "zlib"))
|
||||||
(gzip (specification->package "gzip"))
|
(gzip (specification->package "gzip"))
|
||||||
(bzip2 (specification->package "bzip2"))
|
(bzip2 (specification->package "bzip2"))
|
||||||
|
@ -536,32 +503,22 @@ Info manual."
|
||||||
(guix (specification->package "guix")))
|
(guix (specification->package "guix")))
|
||||||
"Return a file-like object that contains a compiled Guix."
|
"Return a file-like object that contains a compiled Guix."
|
||||||
(define guile-json
|
(define guile-json
|
||||||
(package-for-guile guile-version
|
(specification->package "guile-json"))
|
||||||
"guile-json"
|
|
||||||
"guile2.0-json"))
|
|
||||||
|
|
||||||
(define guile-ssh
|
(define guile-ssh
|
||||||
(package-for-guile guile-version
|
(specification->package "guile-ssh"))
|
||||||
"guile-ssh"
|
|
||||||
"guile2.0-ssh"))
|
|
||||||
|
|
||||||
(define guile-git
|
(define guile-git
|
||||||
(package-for-guile guile-version
|
(specification->package "guile-git"))
|
||||||
"guile-git"
|
|
||||||
"guile2.0-git"))
|
|
||||||
|
|
||||||
(define guile-sqlite3
|
(define guile-sqlite3
|
||||||
(package-for-guile guile-version
|
(specification->package "guile-sqlite3"))
|
||||||
"guile-sqlite3"
|
|
||||||
"guile2.0-sqlite3"))
|
|
||||||
|
|
||||||
(define guile-gcrypt
|
(define guile-gcrypt
|
||||||
(package-for-guile guile-version
|
(specification->package "guile-gcrypt"))
|
||||||
"guile-gcrypt"))
|
|
||||||
|
|
||||||
(define gnutls
|
(define gnutls
|
||||||
(package-for-guile guile-version
|
(specification->package "gnutls"))
|
||||||
"gnutls" "guile2.0-gnutls"))
|
|
||||||
|
|
||||||
(define dependencies
|
(define dependencies
|
||||||
(match (append-map (lambda (package)
|
(match (append-map (lambda (package)
|
||||||
|
@ -950,21 +907,6 @@ containing MODULE-FILES and possibly other files as well."
|
||||||
;;; Building.
|
;;; Building.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define (guile-for-build version)
|
|
||||||
"Return a derivation for Guile 2.0 or 2.2, whichever matches the currently
|
|
||||||
running Guile."
|
|
||||||
(define canonical-package ;soft reference
|
|
||||||
(module-ref (resolve-interface '(gnu packages base))
|
|
||||||
'canonical-package))
|
|
||||||
|
|
||||||
(match version
|
|
||||||
("2.2"
|
|
||||||
(canonical-package (module-ref (resolve-interface '(gnu packages guile))
|
|
||||||
'guile-2.2)))
|
|
||||||
("2.0"
|
|
||||||
(module-ref (resolve-interface '(gnu packages guile))
|
|
||||||
'guile-2.0))))
|
|
||||||
|
|
||||||
(define* (guix-derivation source version
|
(define* (guix-derivation source version
|
||||||
#:optional (guile-version (effective-version))
|
#:optional (guile-version (effective-version))
|
||||||
#:key (pull-version 0))
|
#:key (pull-version 0))
|
||||||
|
@ -981,9 +923,16 @@ is not supported."
|
||||||
(define guile
|
(define guile
|
||||||
;; When PULL-VERSION >= 1, produce a self-contained Guix and use Guile 2.2
|
;; When PULL-VERSION >= 1, produce a self-contained Guix and use Guile 2.2
|
||||||
;; unconditionally.
|
;; unconditionally.
|
||||||
(guile-for-build (if (>= pull-version 1)
|
(default-guile))
|
||||||
"2.2"
|
|
||||||
guile-version)))
|
(when (and (< pull-version 1)
|
||||||
|
(not (string=? (package-version guile) guile-version)))
|
||||||
|
;; Guix < 0.15.0 has PULL-VERSION = 0, where the host Guile is reused and
|
||||||
|
;; can be any version. When that happens and Guile is not current (e.g.,
|
||||||
|
;; it's Guile 2.0), just bail out.
|
||||||
|
(raise (condition
|
||||||
|
(&message
|
||||||
|
(message "Guix is too old and cannot be upgraded")))))
|
||||||
|
|
||||||
(mbegin %store-monad
|
(mbegin %store-monad
|
||||||
(set-guile-for-build guile)
|
(set-guile-for-build guile)
|
||||||
|
|
Loading…
Reference in New Issue