diff mbox series

[bug#60225] records: match-record supports specifying a different variable name.

Message ID 20221220174018.14433-1-attila@lendvai.name
State New
Headers show
Series [bug#60225] records: match-record supports specifying a different variable name. | expand

Commit Message

Attila Lendvai Dec. 20, 2022, 5:40 p.m. UTC 
An example:

(match-record obj <my-type>
  (field1 (field2 custom-var-name) field3)
  ...)
---
 guix/records.scm | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

Comments

Ludovic Courtès Dec. 21, 2022, 10:15 p.m. UTC | #1 
Hi,

Attila Lendvai <attila@lendvai.name> skribis:

> An example:
>
> (match-record obj <my-type>
>   (field1 (field2 custom-var-name) field3)
>   ...)

Nice!  It looks like a useful extension to me.

> -      ((_ record type (field rest ...) body ...)
> -       #`(let-syntax ((field-offset (syntax-rules ()
> +      ((_ record type ((field-name variable-name) rest ...) body ...)
> +       #'(let-syntax ((field-offset (syntax-rules ()

I’d just drop ‘-name’, it’s all names anyway.  :-)

Could you also add a test in ‘tests/records.scm’ next to the others?

TIA,
Ludo’.
diff mbox series

Patch

diff --git a/guix/records.scm b/guix/records.scm
index 13463647c8..0b2487a156 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -592,13 +592,16 @@  (define-syntax lookup-field
 (define-syntax match-record-inner
   (lambda (s)
     (syntax-case s ()
-      ((_ record type (field rest ...) body ...)
-       #`(let-syntax ((field-offset (syntax-rules ()
+      ((_ record type ((field-name variable-name) rest ...) body ...)
+       #'(let-syntax ((field-offset (syntax-rules ()
 			              ((_ f)
-                                       (lookup-field field 0 f)))))
+                                       (lookup-field field-name 0 f)))))
            (let* ((offset (type map-fields field-offset))
-                  (field  (struct-ref record offset)))
+                  (variable-name (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 ...)))))