[bug#50286] [RFC PATCH] Let 'package-location' returns location of surrounding 'let'.

[bug#50286] [RFC PATCH] Let 'package-location' returns location of surrounding 'let'.

[Maxime Devos]

[-- Attachment #1.1: Type: text/plain, Size: 883 bytes --]

X-Debbugs-CC: ludo@gnu.org
X-Debbugs-CC: iskarian@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

[-- Attachment #1.2: 0001-packages-package-location-returns-location-of-surrou.patch --]
[-- Type: text/x-patch, Size: 12994 bytes --]

From 0edae1f6eac69a38d23692ffe3ebc32aab00a3b7 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@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@flashner.co.il>
 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@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))))))
+
+\f
+;;;
+;;; 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@gnu.org>
 ;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximeevos@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


[-- Attachment #1.3: 0002-Remove-conflicting-SRFI-71-imports.patch --]
[-- Type: text/x-patch, Size: 2582 bytes --]

From 90c090fbf3da162e94e5467de897aa5cf1eb8c4c Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@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


[-- Attachment #1.4: 0003-guix-Find-let-binding-when-using-guile-3.0.0.patch --]
[-- Type: text/x-patch, Size: 1659 bytes --]

From fd716c2924c96a0bf908f615adaa404a3e382e7c Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Mon, 30 Aug 2021 20:31:00 +0200
Subject: [PATCH 3/3] guix: Find 'let' binding when using guile@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


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

[bug#50286] [RFC PATCH] Let 'package-location' returns location of surrounding 'let'.

[Ludovic Courtès]

Hello,

Maxime Devos <maximedevos@telenet.be> skribis:

> 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).

This is smart!

I wonder if we’re going overboard, though.  Intuitively, I would rather
leave ‘location’ fields dumb, and instead add editing features to do
things like getting the location of the parent sexp.  It does add some
overhead, but it also makes things more explicit and preserves
separation of concern.  (Also, in ‘core-updates-frozen’,
‘go-to-location’ uses a location cache that makes it less expensive than
on ‘master’.)  But yeah, it’s trickier…

Hmm, thinking out loud, what about this: use the same trick as you did,
but replace ‘define-public’ instead of ‘let’ & co., so as to be less
intrusive.

  (define-syntax-parameter current-definition-location
    (identifier-syntax #f))

  (define-syntax define-public*
    (syntax-rules ()
      ((_ prototype body)
       (define-public prototype
         (syntax-parameterize ((current-definition-location
                                (identifier-syntax (current-source-location))))
           body)))))

Since there’s code that assumes ‘package-location’ returns the location
of the (package …) sexp, we could add a ‘definition-location’ field in
<package>, defaulting to ‘current-definition-location’, or tweak
‘location’ to include both.

WDYT?

Thanks,
Ludo’.

[bug#50286] [RFC PATCH] Let 'package-location' returns location of surrounding 'let'.

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 2146 bytes --]

Hi Maxime & Sarah,

Ludovic Courtès <ludo@gnu.org> skribis:

> Hmm, thinking out loud, what about this: use the same trick as you did,
> but replace ‘define-public’ instead of ‘let’ & co., so as to be less
> intrusive.
>
>   (define-syntax-parameter current-definition-location
>     (identifier-syntax #f))
>
>   (define-syntax define-public*
>     (syntax-rules ()
>       ((_ prototype body)
>        (define-public prototype
>          (syntax-parameterize ((current-definition-location
>                                 (identifier-syntax (current-source-location))))
>            body)))))
>
> Since there’s code that assumes ‘package-location’ returns the location
> of the (package …) sexp, we could add a ‘definition-location’ field in
> <package>, defaulting to ‘current-definition-location’, or tweak
> ‘location’ to include both.

Below is an attempt at doing this.  As discussed on IRC, the first patch
switches the ‘location’ field to a more compact format that may reduce
load time by a tiny bit, though it’s hard to measure.  The second patch
introduces an extra field for the definition location; that means that
<package> records now occupy an extra word, which is not great, but
unfortunately OTOH location is slightly smaller.

Example:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> ,use(gnu packages base)
scheme@(guile-user)> ,use(gnu packages accessibility)
scheme@(guile-user)> ,use(guix)
scheme@(guile-user)> (package-location footswitch)
$1 = #<<location> file: "gnu/packages/accessibility.scm" line: 257 column: 4>
scheme@(guile-user)> (package-definition-location footswitch)
$2 = #<<location> file: "gnu/packages/accessibility.scm" line: 254 column: 0>
scheme@(guile-user)> (package-location hello)
$3 = #<<location> file: "gnu/packages/base.scm" line: 79 column: 2>
scheme@(guile-user)> (package-definition-location hello)
$4 = #<<location> file: "gnu/packages/base.scm" line: 78 column: 0>
--8<---------------cut here---------------end--------------->8---

Thoughts?

Thanks,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: the patch --]
[-- Type: text/x-patch, Size: 3116 bytes --]

From 758ca5c95b97f3fd2b08a2828e21c45a86393d59 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 7 Sep 2021 18:04:21 +0200
Subject: [PATCH 1/2] packages: Store 'location' field as a literal vector.

This is slightly more efficient than storing an alist in terms of .go
file size (< 1% smaller) and load time.

* guix/packages.scm (current-location-vector): New macro.
(sanitize-location): New procedure.
(<package>)[location]: Change 'default' and add 'sanitize'.
(package-location): New procedure.
---
 guix/packages.scm | 38 ++++++++++++++++++++++++++++++++++----
 1 file changed, 34 insertions(+), 4 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index c825f427d8..01de50ebd7 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -360,6 +360,30 @@ name of its URI."
   ;; <https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00790.html>.
   (fold delete %supported-systems '("mips64el-linux")))
 
+(define-syntax current-location-vector
+  (lambda (s)
+    "Like 'current-source-location' but expand to a literal vector with
+one-indexed line numbers."
+    ;; Storing a literal vector in .go files is more efficient than storing an
+    ;; alist: less initialization code, fewer relocations, etc.
+    (syntax-case s ()
+      ((_)
+       (match (syntax-source s)
+         (#f #f)
+         (properties
+          (let ((file   (assq-ref properties 'filename))
+                (line   (assq-ref properties 'line))
+                (column (assq-ref properties 'column)))
+            (and file line column
+                 #`#(#,file #,(+ 1 line) #,column)))))))))
+
+(define-inlinable (sanitize-location loc)
+  ;; Convert LOC to a vector or to #f.
+  (cond ((vector? loc) loc)
+        ((not loc) loc)
+        (else (vector (location-file loc)
+                      (location-line loc)
+                      (location-column loc)))))
 
 ;; A package.
 (define-record-type* <package>
@@ -404,10 +428,9 @@ name of its URI."
 
   (properties package-properties (default '()))   ; alist for anything else
 
-  (location package-location
-            (default (and=> (current-source-location)
-                            source-properties->location))
-            (innate)))
+  (location package-location-vector
+            (default (current-location-vector))
+            (innate) (sanitize sanitize-location)))
 
 (set-record-type-printer! <package>
                           (lambda (package port)
@@ -425,6 +448,13 @@ name of its URI."
                                                        package)
                                                       16)))))
 
+(define (package-location package)
+  "Return the source code location of PACKAGE as a <location> record, or #f if
+it is not known."
+  (match (package-location-vector package)
+    (#f #f)
+    (#(file line column) (location file line column))))
+
 (define-syntax-rule (package/inherit p overrides ...)
   "Like (package (inherit P) OVERRIDES ...), except that the same
 transformation is done to the package P's replacement, if any.  P must be a bare
-- 
2.33.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: the second one --]
[-- Type: text/x-patch, Size: 4552 bytes --]

From bc2d7144bb9ef0ea74f9ef5922d568291818de32 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 7 Sep 2021 21:19:11 +0200
Subject: [PATCH 2/2] packages: Add 'package-definition-location'.

Suggested by Maxime Devos <maximedevos@telenet.be>.

* guix/packages.scm (current-definition-location-vector): New syntax parameter.
(define-public*): New macro.
(<package>)[definition-location]: New field.
(package-definition-location): New procedure.
* tests/packages.scm ("package-definition-location"): New test.
---
 guix/packages.scm  | 42 +++++++++++++++++++++++++++++++++++++++++-
 tests/packages.scm | 11 +++++++++++
 2 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 01de50ebd7..2f70ec9c64 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -52,6 +52,7 @@
   #:re-export (%current-system
                %current-target-system
                search-path-specification)         ;for convenience
+  #:replace ((define-public* . define-public))
   #:export (content-hash
             content-hash?
             content-hash-algorithm
@@ -99,6 +100,7 @@
             package-supported-systems
             package-properties
             package-location
+            package-definition-location
             hidden-package
             hidden-package?
             package-superseded
@@ -385,6 +387,31 @@ one-indexed line numbers."
                       (location-line loc)
                       (location-column loc)))))
 
+(define-syntax-parameter current-definition-location-vector
+  ;; Location of the encompassing 'define-public'.
+  (const #f))
+
+(define-syntax define-public*
+  (lambda (s)
+    "Like 'define-public' but set 'current-definition-location' for the
+lexical scope of its body."
+    (define location
+      (match (syntax-source s)
+        (#f #f)
+        (properties
+         (let ((line   (assq-ref properties 'line))
+               (column (assq-ref properties 'column)))
+           ;; Don't repeat the file name since it's redundant with 'location'.
+           (and line column
+                #`#(#,(+ 1 line) #,column))))))
+
+    (syntax-case s ()
+      ((_ prototype body ...)
+       #`(define-public prototype
+           (syntax-parameterize ((current-definition-location-vector
+                                  (lambda (s) #,location)))
+             body ...))))))
+
 ;; A package.
 (define-record-type* <package>
   package make-package
@@ -430,7 +457,10 @@ one-indexed line numbers."
 
   (location package-location-vector
             (default (current-location-vector))
-            (innate) (sanitize sanitize-location)))
+            (innate) (sanitize sanitize-location))
+  (definition-location package-definition-location-vector
+                       (default (current-definition-location-vector))
+                       (innate)))
 
 (set-record-type-printer! <package>
                           (lambda (package port)
@@ -455,6 +485,16 @@ it is not known."
     (#f #f)
     (#(file line column) (location file line column))))
 
+(define (package-definition-location package)
+  "Like 'package-location', but return the location of the definition
+itself--i.e., that of the enclosing 'define-public' form, if any, or #f."
+  (match (package-definition-location-vector package)
+    (#f #f)
+    (#(line column)
+     (match (package-location-vector package)
+       (#f #f)
+       (#(file _ _) (location file line column))))))
+
 (define-syntax-rule (package/inherit p overrides ...)
   "Like (package (inherit P) OVERRIDES ...), except that the same
 transformation is done to the package P's replacement, if any.  P must be a bare
diff --git a/tests/packages.scm b/tests/packages.scm
index 2a290bc353..3756877270 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -236,6 +236,17 @@
                 (eq? item new)))
              (null? (manifest-transaction-remove tx)))))))
 
+(test-assert "package-definition-location"
+  (let ((location   (package-location hello))
+        (definition (package-definition-location hello)))
+    ;; Check for the usual layout of (define-public hello (package ...)).
+    (and (string=? (location-file location)
+                   (location-file definition))
+         (= 0 (location-column definition))
+         (= 2 (location-column location))
+         (= (location-line definition)
+            (- (location-line location) 1)))))
+
 (test-assert "package-field-location"
   (let ()
     (define (goto port line column)
-- 
2.33.0

[bug#50286] [RFC PATCH] Let 'package-location' returns location of surrounding 'let'.

[Sarah Morgensen]

Hi Ludo,

Ludovic Courtès <ludo@gnu.org> writes:

> Example:
>
> scheme@(guile-user)> ,use(gnu packages base)
> scheme@(guile-user)> ,use(gnu packages accessibility)
> scheme@(guile-user)> ,use(guix)
> scheme@(guile-user)> (package-location footswitch)
> $1 = #<<location> file: "gnu/packages/accessibility.scm" line: 257 column: 4>
> scheme@(guile-user)> (package-definition-location footswitch)
> $2 = #<<location> file: "gnu/packages/accessibility.scm" line: 254 column: 0>
> scheme@(guile-user)> (package-location hello)
> $3 = #<<location> file: "gnu/packages/base.scm" line: 79 column: 2>
> scheme@(guile-user)> (package-definition-location hello)
> $4 = #<<location> file: "gnu/packages/base.scm" line: 78 column: 0>
>
> Thoughts?

This is very clever!  Thanks for the work on this.  I'm not very good
with macros, but it *looks* like it should work quite well for our
use-case of adjusting a surrounding 'let' expression.  And it's less
invasive than rewriting 'let'.

However... it doesn't work for unexported packages.  It looks there are
about 200 such packages:

--8<---------------cut here---------------start------------->8---
~/guix$ rg -U '\(define [^\(]+\n.*?\(package' gnu/packages --count --no-filename | awk '{a+=$1} END {print a}'
233
--8<---------------cut here---------------end--------------->8---

And, to play the pessimist:

What do we get out of this that couldn't be done by "go to package
location; read backwards one sexp until we reach a defining form"
(like Emacs' 'beginning-of-defun')?

--
Sarah

[bug#50286] [RFC PATCH] Let 'package-location' returns location of surrounding 'let'.

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 2704 bytes --]

Ludovic Courtès schreef op di 07-09-2021 om 21:27 [+0200]:
> Hi Maxime & Sarah,
> 
> Ludovic Courtès <ludo@gnu.org> skribis:
> 
> > Hmm, thinking out loud, what about this: use the same trick as you did,
> > but replace ‘define-public’ instead of ‘let’ & co., so as to be less
> > intrusive.
> > 
> >   (define-syntax-parameter current-definition-location
> >     (identifier-syntax #f))
> > 
> >   (define-syntax define-public*
> >     (syntax-rules ()
> >       ((_ prototype body)
> >        (define-public prototype
> >          (syntax-parameterize ((current-definition-location
> >                                 (identifier-syntax (current-source-location))))
> >            body)))))
> > 
> > Since there’s code that assumes ‘package-location’ returns the location
> > of the (package …) sexp, we could add a ‘definition-location’ field in
> > <package>, defaulting to ‘current-definition-location’, or tweak
> > ‘location’ to include both.
> 
> Below is an attempt at doing this.  As discussed on IRC, the first patch
> switches the ‘location’ field to a more compact format that may reduce
> load time by a tiny bit, though it’s hard to measure.


> The second patch
> introduces an extra field for the definition location; that means that
> <package> records now occupy an extra word, which is not great, but
> unfortunately OTOH location is slightly smaller.

Why not always let the location of a package be the location of the
surrounding define-public* form, instead of having two separate
locations?  Letting the location of a package be the location of the
define-public* form (or 'let' form) seems more useful to people using
"guix edit minetest-etheral" for example, and the package-field-location
code can easily be adjusted to support 'define-public*' (or let) forms.

If two separate package-definition-location and package-location are
introduced, what should "guix show minetest-ethereal" show?  The location
of the 'package' form, the location of the 'let' form or the location
of the 'define-public' form?

Having two separate define-public* and define-public macros might be a
little confusing.  Would it be possible to let 'define-public*' replace
'define-public'?

I don't really have an opinion on whether package-[field-]location should
return the location of the 'let' form or the location of the 'define-public'
form.  I think 'package-location' should return the location of the 'let'
form (or a surrounding form), because the 'commit' and 'version' variable
from the 'let' form are part of the package -- change them, and you'll
get a different package.

Greetings,
Maxime

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

[bug#50286] [RFC PATCH] Let 'package-location' returns location of surrounding 'let'.

[Ludovic Courtès]

Hello,

Maxime Devos <maximedevos@telenet.be> skribis:

> Why not always let the location of a package be the location of the
> surrounding define-public* form, instead of having two separate
> locations?  Letting the location of a package be the location of the
> define-public* form (or 'let' form) seems more useful to people using
> "guix edit minetest-etheral" for example, and the package-field-location
> code can easily be adjusted to support 'define-public*' (or let) forms.
>
> If two separate package-definition-location and package-location are
> introduced, what should "guix show minetest-ethereal" show?  The location
> of the 'package' form, the location of the 'let' form or the location
> of the 'define-public' form?

A package always has a ‘location’, but it may lack a definition
location, for instance if it’s produced by a procedure, or if it’s not
bound to a top-level variable.

Things like ‘package-field-location’ are likely more accurate if they
start searching from the beginning of the (package …) sexp.

These patches leave the UIs unchanged (‘guix show’, ‘guix edit’, etc.)
because I think ‘location’ is good for these.

> Having two separate define-public* and define-public macros might be a
> little confusing.  Would it be possible to let 'define-public*' replace
> 'define-public'?

‘define-public*’ is exported as ‘define-public’, so package definitions
do not need to be changed:

  #:replace ((define-public* . define-public))

> I don't really have an opinion on whether package-[field-]location should
> return the location of the 'let' form or the location of the 'define-public'
> form.  I think 'package-location' should return the location of the 'let'
> form (or a surrounding form), because the 'commit' and 'version' variable
> from the 'let' form are part of the package -- change them, and you'll
> get a different package.

Yeah, I see what you mean.  The work ‘guix refresh -u’ and ‘guix style’
do is essentially correlating live objects (package records) to their
source code.  This is necessarily an approximation; it’s similar to
version strings constructed with ‘string-append’: that’s something that
inspection of the live object cannot reveal, so we use heuristic to
match common conventions.

Thoughts?

Thanks,
Ludo’.

[bug#50286] [RFC PATCH] Let 'package-location' returns location of surrounding 'let'.

[Ludovic Courtès]

Hi Sarah,

Sarah Morgensen <iskarian@mgsn.dev> skribis:

> However... it doesn't work for unexported packages.  It looks there are
> about 200 such packages:
>
> ~/guix$ rg -U '\(define [^\(]+\n.*?\(package' gnu/packages --count --no-filename | awk '{a+=$1} END {print a}'
> 233

Ah, hmm, well.  I’d have said these are beyond our scope :-), and in
fact we’d need to know how many among these 233 packages use the
(let ((commit …)) …) idiom, but if this is deemed important, we can
replace ‘define’ similarly.

> And, to play the pessimist:
>
> What do we get out of this that couldn't be done by "go to package
> location; read backwards one sexp until we reach a defining form"
> (like Emacs' 'beginning-of-defun')?

Nothing!  It’s just easier to implement and more accurate—we’re sure to
get the exact location of the ‘define-public’ form that surrounds the
package record we’re looking at.

Now, longer-term, I’d like to have Emacs/paredit-like features and more
tools to correlate source and live objects.  I found myself doing a bit
of that in ‘guix style’, and I think that’s a fun area to explore so we
can improve our package maintenance tools.

Thanks,
Ludo’.

bug#50286: [RFC PATCH] Let 'package-location' returns location of surrounding 'let'.

[Ludovic Courtès]

Hello!

Following our discussion on IRC, I pushed this as
8531997d2a1e10d574a6e9ab70bc86ade6af4733.

I made one change, which is that the ‘definition-location’ field is now
stored as a fixnum (column << 22 | line) rather than a vector.

This should be enough to unlock Sarah’s patches at
<https://issues.guix.gnu.org/50072>!

Thanks,
Ludo’.