diff options
| author | Attila Lendvai <attila@lendvai.name> | 2022-12-21 23:14:55 -0300 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-12-27 23:53:42 +0100 |
| commit | 363b20b68584d71556c2d8912dd07cbdacabdb25 (patch) | |
| tree | 298c02b808007db90d8c006a7de1be0dc6589182 | |
| parent | 361aad5ce33afeefa269533c33141fc77f74837c (diff) | |
| download | guix-363b20b68584d71556c2d8912dd07cbdacabdb25.tar.gz | |
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>
| -rw-r--r-- | guix/records.scm | 9 | ||||
| -rw-r--r-- | 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 |