09/09: records: match-record supports specifying a different variable name.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 363b20b68584d71556c2d8912dd07cbdacabdb25
Author: Attila Lendvai <attila@lendvai.name>
AuthorDate: Wed Dec 21 23:14:55 2022 -0300

    records: match-record supports specifying a different variable name.
    
    An example:
    
    (match-record obj <my-type>
      (field1 (field2 custom-var-name) field3)
      ...)
    
    * guix/records.scm (match-record-inner): Add support for the new syntax.
    * tests/records.scm ("match-record, simple"): Add a simple test case for the
    new syntax.
    
    Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 guix/records.scm  | 9 ++++++---
 tests/records.scm | 4 ++--
 2 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index 13463647c8..1f097c7108 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -592,13 +592,16 @@ found."
 (define-syntax match-record-inner
   (lambda (s)
     (syntax-case s ()
-      ((_ record type (field rest ...) body ...)
-       #`(let-syntax ((field-offset (syntax-rules ()
+      ((_ record type ((field variable) rest ...) body ...)
+       #'(let-syntax ((field-offset (syntax-rules ()
                                      ((_ f)
                                        (lookup-field field 0 f)))))
            (let* ((offset (type map-fields field-offset))
-                  (field  (struct-ref record offset)))
+                  (variable (struct-ref record offset)))
              (match-record-inner record type (rest ...) body ...))))
+      ((_ record type (field rest ...) body ...)
+       ;; Redirect to the canonical form above.
+       #'(match-record-inner record type ((field field) rest ...) body ...))
       ((_ record type () body ...)
        #'(begin body ...)))))
 
diff --git a/tests/records.scm b/tests/records.scm
index 8504c8d5a5..b1203dfeb7 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -540,8 +540,8 @@ Description: 1st line,
             (first second)
             (list first second))
           (match-record (foo (first 'a) (second 'b)) <foo>
-            (second first)
-            (list first second)))))
+            (second (first first/new-var))
+            (list first/new-var second)))))
 
 (test-equal "match-record, unknown field"
   'syntax-error