Package: guix-patches;
Reported by: Maxime Devos <maximedevos <at> telenet.be>
Date: Mon, 30 Aug 2021 21:28:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Maxime Devos <maximedevos <at> telenet.be> To: 50286 <at> debbugs.gnu.org Cc: iskarian <at> mgsn.dev Subject: [bug#50286] [RFC PATCH] Let 'package-location' returns location of surrounding 'let'. Date: Mon, 30 Aug 2021 23:26:43 +0200
[Message part 1 (text/plain, inline)]
X-Debbugs-CC: ludo <at> gnu.org
X-Debbugs-CC: iskarian <at> mgsn.dev
Hi guix,
These three patches allows (guix upstream) to replace the values in the surrounding 'let'
form, if any. It's important for constructs like:
(define-public gnash
(let ((version "0.8.11")
(commit "583ccbc1275c7701dc4843ec12142ff86bb305b4")
(revision "0"))
(package
(name "gnash")
(version (git-version version revision commit))
(source (git-reference
(url "https://example.org")
(commit commit)))
[...])))
such that it can update the version, commit, revision. (Currently only the
version will be updatable, but see <https://issues.guix.gnu.org/50072#0>
and <https://issues.guix.gnu.org/50072#9> for work on making 'commit' updatable).
More details in the patches themselves.
Greetings,
Maxime
[0001-packages-package-location-returns-location-of-surrou.patch (text/x-patch, inline)]
From 0edae1f6eac69a38d23692ffe3ebc32aab00a3b7 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos <at> telenet.be>
Date: Mon, 30 Aug 2021 16:41:08 +0200
Subject: [PATCH 1/3] packages: 'package-location' returns location of
surrounding 'let'.
The idea is to let "guix refresh -u" be able to update the version,
revision and commit in packages defined like:
(define-public emacs-flymake-quickdef
(let ((version "1.0.0")
(revision "0")
(commit "150c5839768a3d32f988f9dc08052978a68f2ad7"))
(package
(name "emacs-flymake-quickdef")
(version (git-version version revision commit))
[...])))
Updating the revision and commit is not yet supported
by (guix upstream), but see <https://issues.guix.gnu.org/50072>.
* guix/packages.scm: Re-export 'letrec' from SRFI-71
* guix/packages.scm
(read-syntax*): Define as 'read-syntax', with some Guile < 3.0.7
compatibility code.
(package-field-location)[syntax-case-loop]: New macro.
(package-field-location)[syntax-assq]: New macro.
(package-field-location): Use 'syntax-case-loop' and 'syntax-case'
instead of 'match'. Recognise 'let' forms. Use syntax-source instead of
source-properties, with some compatibility code for Guile < 3.0.7.
(datum->syntax*): Define as 'datum->syntax', with some Guile < 3.0.6
compatibility code.
(with-source-location): New macro.
(let&): New macro
(let*&): New macro.
* tests/packages.scm
(goto, read-at): Extract from "package-field-location" test.
("package-field-location and 'let'", "package-field-location and symbols"):
New tests.
---
guix/packages.scm | 134 +++++++++++++++++++++++++++++++++++++++++++--
tests/packages.scm | 60 ++++++++++++--------
2 files changed, 165 insertions(+), 29 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index c825f427d8..a71c9ac74f 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2019 Marius Bakke <mbakke <at> fastmail.com>
;;; Copyright © 2021 Chris Marusich <cmmarusich <at> gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -47,11 +48,17 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (srfi srfi-71) ; used by let& and let*&
+ #:use-module ((system syntax) #:select (syntax?))
#:use-module (rnrs bytevectors)
#:use-module (web uri)
+ #:use-module (system vm program)
#:re-export (%current-system
%current-target-system
search-path-specification) ;for convenience
+ #:replace ((let& . let)
+ (let*& . let*))
+ #:re-export-and-replace ((letrec . letrec)) ;for completeness
#:export (content-hash
content-hash?
content-hash-algorithm
@@ -466,6 +473,15 @@ object."
(name old-name)
(properties `((superseded . ,p)))))
+;; XXX 'read-syntax' is new since Guile 3.0.7.
+;; For previous versions of Guile, use 'read' instead.
+;; See package-field-location for why 'read-syntax' is preferred
+;; above 'read'.
+(define read-syntax*
+ (if (defined? 'read-syntax)
+ read-syntax
+ read))
+
(define (package-field-location package field)
"Return the source code location of the definition of FIELD for PACKAGE, or
#f if it could not be determined."
@@ -474,6 +490,21 @@ object."
(= (port-line port) (- line 1)))
(unless (eof-object? (read-char port))
(goto port line column))))
+ ;; Like 'syntax-case', but for catamorphisms.
+ (define-syntax-rule (syntax-case-loop loop obj . patterns)
+ (let loop ((x obj))
+ (syntax-case x () . patterns)))
+ ;; Like 'assq', but the alist is a syntax object and the keys are converted
+ ;; to a datum before comparing them to KEY.
+ (define (syntax-assq key alist)
+ (syntax-case alist ()
+ (() #f)
+ ((pair . rest)
+ (syntax-case #'pair ()
+ ((x . y)
+ (if (eq? (syntax->datum #'x) key)
+ #'pair
+ (syntax-assq field #'rest)))))))
(match (package-location package)
(($ <location> file line column)
@@ -485,12 +516,19 @@ object."
(call-with-input-file file-found
(lambda (port)
(goto port line column)
- (match (read port)
- (('package inits ...)
- (let ((field (assoc field inits)))
- (match field
+ ;; Use 'read-syntax' such that source properties are available
+ ;; even if the expression for the field value is a symbol.
+ (syntax-case-loop loop (read-syntax* port)
+ ((p inits ...)
+ (eq? 'package (syntax->datum #'p))
+ (let ((field (syntax-assq field #'(inits ...))))
+ (syntax-case field ()
((_ value)
- (let ((loc (and=> (source-properties value)
+ ;; XXX syntax? isn't necessary when read-syntax is used.
+ (let ((loc (and=> (or (and (syntax? #'value)
+ (syntax-source #'value))
+ ;; XXX not required in Guile 3.0.7
+ (source-properties #'value))
source-properties->location)))
(and loc
;; Preserve the original file name, which may be a
@@ -498,6 +536,9 @@ object."
(set-field loc (location-file) file))))
(_
#f))))
+ ((bind stuff ... exp)
+ (memq (syntax->datum #'bind) '(let let*))
+ (loop #'exp))
(_
#f)))))
(lambda _
@@ -1635,3 +1676,86 @@ outside of the store) or SOURCE itself (if SOURCE is already a store item.)"
(add-to-store store (basename file) #t "sha256" file))
(_
(lower store source system))))))
+
+
+;;;
+;;; These let* and let*& macros adjust the source location of the package
+;;; (if any) to the location of the let* or let*& form. This hack allows
+;;; the in-place updater to update the version number, revision and
+;;; commit for packages defined like this:
+;;;
+;;; (define-public emacs-flymake-quickdef
+;;; (let ((version "1.0.0")
+;;; (revision "0")
+;;; (commit "150c5839768a3d32f988f9dc08052978a68f2ad7"))
+;;; (package
+;;; (name "emacs-flymake-quickdef")
+;;; (version (git-version version revision commit))
+;;; [...])))
+;;;
+;;; See <https://issues.guix.gnu.org/50072> for some background.
+;;; Note that updating the revision and commit is not yet supported.
+;;;
+;;; It is intended that these bindings replace the standard 'let' and
+;;; 'let*' bindings, such that:
+;;;
+;;; (1) newcomers don't have to learn to use let& and let*& instead
+;;; of let and let* in some situations, instead things mostly
+;;; ‘just work’, and
+;;; (2) old package definitions don't have to be adjusted.
+;;;
+
+;; XXX the #:source argument is only introduced since Guile 3.0.6.
+;; As adjusting the source location isn't terribly important
+;; (only "guix refresh -e" needs the adjusted location sometimes and for most
+;; packages it doesn't need it), for compatibility for Guile 3.0.5 just ignore
+;; #:source.
+
+(define datum->syntax*
+ (if (member 'source (program-lambda-list datum->syntax))
+ datum->syntax
+ (lambda* (template-id datum #:key source)
+ (datum->syntax template-id datum))))
+
+(define-syntax with-source-location
+ (lambda (s)
+ "If (EXP . EXP*) is a PACKAGE or PACKAGE/INHERIT form, expand to (EXP . EXP*),
+but with the source location replaced by the source location of SOURCE. Keep
+the original source location otherwise."
+ (define (package-identifier? s)
+ (syntax-case s (package package/inherit)
+ (package #t)
+ (package/inherit #t)
+ (_ #f)))
+ (syntax-case s ()
+ ((_ (exp . exp*) source)
+ (package-identifier? #'exp)
+ (datum->syntax* s (cons #'exp #'exp*)
+ #:source (syntax-source #'source)))
+ ((_ other-stuff source) #'other-stuff))))
+
+(define-syntax let&
+ (lambda (s)
+ "Like SRFI-71 'let', but let the last inner expression have the location
+of the 'let&' form when it is expanded, if it is a PACKAGE or PACKAGE/INHERIT
+form."
+ (syntax-case s ()
+ ;; These variable names aren't fully correct,
+ ;; because the 'named let' construction is possible as well.
+ ((_ bindings exp ... exp*)
+ (with-syntax ((s/syntax s))
+ #'(let bindings exp ... (with-source-location exp* s/syntax)))))))
+
+(define-syntax let*&
+ (lambda (s)
+ "Like SRFI-71 'let*', but let the last inner expression have the location
+of the 'let*&' form when it is expanded, if it is a PACKAGE or PACKAGE/INHERIT
+form."
+ (syntax-case s ()
+ ((_ bindings exp ... exp*)
+ (with-syntax ((s/syntax s))
+ #'(let* bindings exp ... (with-source-location exp* s/syntax)))))))
+
+;; Local Variables:
+;; eval: (put 'syntax-case-loop 'scheme-indent-function 2)
+;; End:
diff --git a/tests/packages.scm b/tests/packages.scm
index 2a290bc353..50fb3d0718 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke <at> gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximeevos <at> telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -44,6 +45,7 @@
#:use-module (guix scripts package)
#:use-module (guix sets)
#:use-module (gnu packages)
+ #:use-module (gnu packages admin) ; for 'interrobang'
#:use-module (gnu packages base)
#:use-module (gnu packages guile)
#:use-module (gnu packages bootstrap)
@@ -236,31 +238,41 @@
(eq? item new)))
(null? (manifest-transaction-remove tx)))))))
+;; These two procedures are by the "package-field-location"
+;; tests.
+(define (goto port line column)
+ (unless (and (= (port-column port) (- column 1))
+ (= (port-line port) (- line 1)))
+ (unless (eof-object? (get-char port))
+ (goto port line column))))
+
+(define read-at
+ (match-lambda
+ (($ <location> file line column)
+ (call-with-input-file (search-path %load-path file)
+ (lambda (port)
+ (goto port line column)
+ (read port))))))
+
(test-assert "package-field-location"
- (let ()
- (define (goto port line column)
- (unless (and (= (port-column port) (- column 1))
- (= (port-line port) (- line 1)))
- (unless (eof-object? (get-char port))
- (goto port line column))))
-
- (define read-at
- (match-lambda
- (($ <location> file line column)
- (call-with-input-file (search-path %load-path file)
- (lambda (port)
- (goto port line column)
- (read port))))))
-
- ;; Until Guile 2.0.6 included, source properties were added only to pairs.
- ;; Thus, check against both VALUE and (FIELD VALUE).
- (and (member (read-at (package-field-location %bootstrap-guile 'name))
- (let ((name (package-name %bootstrap-guile)))
- (list name `(name ,name))))
- (member (read-at (package-field-location %bootstrap-guile 'version))
- (let ((version (package-version %bootstrap-guile)))
- (list version `(version ,version))))
- (not (package-field-location %bootstrap-guile 'does-not-exist)))))
+ ;; Until Guile 2.0.6 included, source properties were added only to pairs.
+ ;; Thus, check against both VALUE and (FIELD VALUE).
+ (and (member (read-at (package-field-location %bootstrap-guile 'name))
+ (let ((name (package-name %bootstrap-guile)))
+ (list name `(name ,name))))
+ (member (read-at (package-field-location %bootstrap-guile 'version))
+ (let ((version (package-version %bootstrap-guile)))
+ (list version `(version ,version))))
+ (not (package-field-location %bootstrap-guile 'does-not-exist))))
+
+(test-equal "package-field-location and 'let'"
+ (package-name interrobang)
+ (read-at (package-field-location interrobang 'name)))
+
+(test-skip (if (defined? 'read-syntax) 0 1))
+(test-eq "package-field-location and symbols"
+ 'gnu-build-system
+ (read-at (package-field-location hello 'build-system)))
;; Make sure we don't change the file name to an absolute file name.
(test-equal "package-field-location, relative file name"
--
2.33.0
[0002-Remove-conflicting-SRFI-71-imports.patch (text/x-patch, inline)]
From 90c090fbf3da162e94e5467de897aa5cf1eb8c4c Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos <at> telenet.be>
Date: Mon, 30 Aug 2021 17:03:03 +0200
Subject: [PATCH 2/3] Remove conflicting SRFI-71 imports.
Don't import both (guix packages) and (srfi srfi-71),
as the let and let* bindings of one will replace the ones
of the other.
* guix/import/crate.scm: Don't import (srfi srfi-71).
* guix/import/egg.scm: Likewise.
* guix/import/utils.scm: Likewise.
* guix/scripts/pull.scm: Likewise.
* tests/packages.scm: Likewise.
---
guix/import/crate.scm | 1 -
guix/import/egg.scm | 1 -
guix/import/utils.scm | 1 -
guix/scripts/pull.scm | 1 -
tests/packages.scm | 1 -
5 files changed, 5 deletions(-)
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 287ffd2536..eb2fa1e1c4 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -40,7 +40,6 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-26)
- #:use-module (srfi srfi-71)
#:export (crate->guix-package
guix-package->crate-name
string->license
diff --git a/guix/import/egg.scm b/guix/import/egg.scm
index 107894ddcf..a7535be8a6 100644
--- a/guix/import/egg.scm
+++ b/guix/import/egg.scm
@@ -21,7 +21,6 @@
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-71)
#:use-module (gcrypt hash)
#:use-module (guix git)
#:use-module (guix i18n)
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index d1b8076ddd..e433449d18 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -47,7 +47,6 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
- #:use-module (srfi srfi-71)
#:export (factorize-uri
flatten
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index fb8ce50fa7..f81df47a0e 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -55,7 +55,6 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
- #:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:use-module (ice-9 format)
diff --git a/tests/packages.scm b/tests/packages.scm
index 50fb3d0718..5ff71b7af1 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -57,7 +57,6 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-64)
- #:use-module (srfi srfi-71)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (ice-9 vlist)
--
2.33.0
[0003-guix-Find-let-binding-when-using-guile-3.0.0.patch (text/x-patch, inline)]
From fd716c2924c96a0bf908f615adaa404a3e382e7c Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos <at> telenet.be>
Date: Mon, 30 Aug 2021 20:31:00 +0200
Subject: [PATCH 3/3] guix: Find 'let' binding when using guile <at> 3.0.0.
Without this patch, errors like this result:
[ 90%] LOAD gnu/services/nfs.scm
WARNING: (gnu services nfs): imported module (guix) overrides core binding `let'
WARNING: (gnu services nfs): `let' imported from both (guile) and (guix)
WARNING: (gnu services nfs): imported module (guix) overrides core binding `let'
WARNING: (gnu services nfs): `let' imported from both (guile) and (guix)
ice-9/eval.scm:293:34: error: let: unbound variable
hint: Did you forget `(use-modules (srfi srfi-71))'?
I don't know why this happens, but this patch stops this error.
* guix.scm: Hide 'let' and 'let*' when importing (guix packages).
---
guix.scm | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/guix.scm b/guix.scm
index 42bc8c8818..7e1e5fb109 100644
--- a/guix.scm
+++ b/guix.scm
@@ -36,5 +36,10 @@
(for-each (let ((i (module-public-interface (current-module))))
(lambda (m)
- (module-use! i (resolve-interface `(guix ,m)))))
+ (module-use! i (resolve-interface `(guix ,m)
+ ;; XXX: why is this required with Guile 3.0.2
+ ;; to allow (gnu services nfs) to compile?
+ #:hide (if (eq? m 'packages)
+ '(let let*)
+ '())))))
%public-modules)))
--
2.33.0
[signature.asc (application/pgp-signature, inline)]
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.