diff options
| author | (unmatched-parenthesis ew syntax <paren@disroot.org> | 2023-04-28 20:19:05 +0100 |
|---|---|---|
| committer | Josselin Poiret <dev@jpoiret.xyz> | 2023-06-04 10:59:25 +0200 |
| commit | 4cd529362108086eeec25d4d465261415cff45b3 (patch) | |
| tree | cbb0b3e462513d52260f8be7bcc8f2176fbf3840 | |
| parent | e6dc1d399663b9fab30ded8bcb716a5b1dbf8743 (diff) | |
| download | guix-4cd529362108086eeec25d4d465261415cff45b3.tar.gz | |
records: Add MATCH-RECORD-LAMBDA.
* guix/records.scm (match-record-lambda): New syntax.
* tests/records.scm ("match-record-lambda"): New test.
Signed-off-by: Josselin Poiret <dev@jpoiret.xyz>
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rw-r--r-- | guix/read-print.scm | 1 | ||||
| -rw-r--r-- | guix/records.scm | 14 | ||||
| -rw-r--r-- | tests/records.scm | 12 |
4 files changed, 27 insertions, 1 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index 3ffd25ee94..d79b5c9d7e 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -71,6 +71,7 @@ (eval . (put 'lambda* 'scheme-indent-function 1)) (eval . (put 'substitute* 'scheme-indent-function 1)) (eval . (put 'match-record 'scheme-indent-function 3)) + (eval . (put 'match-record-lambda 'scheme-indent-function 2)) ;; TODO: Contribute these to Emacs' scheme-mode. (eval . (put 'let-keywords 'scheme-indent-function 3)) diff --git a/guix/read-print.scm b/guix/read-print.scm index 04dc0dcfbe..25be289d60 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -319,6 +319,7 @@ expressions and blanks that were read." ('letrec* 2) ('match 2) ('match-record 3) + ('match-record-lambda 2) ('when 2) ('unless 2) ('package 1) diff --git a/guix/records.scm b/guix/records.scm index cfa46f0d80..2a88cb4b3c 100644 --- a/guix/records.scm +++ b/guix/records.scm @@ -31,7 +31,8 @@ alist->record object->fields recutils->alist - match-record)) + match-record + match-record-lambda)) ;;; Commentary: ;;; @@ -640,4 +641,15 @@ an unknown field is queried." (match-record-inner record type (fields ...) body ...) (throw 'wrong-type-arg record))))) +(define-syntax match-record-lambda + (syntax-rules () + "Return a procedure accepting a single record of the given TYPE for which each +FIELD will be bound to its FIELD name within the returned procedure. A syntax error +is raised if an unknown field is queried." + ((_ type (field ...) body ...) + (lambda (record) + (if (eq? (struct-vtable record) type) + (match-record-inner record type (field ...) body ...) + (throw 'wrong-type-arg record)))))) + ;;; records.scm ends here diff --git a/tests/records.scm b/tests/records.scm index 4f0aeb3903..8ee306bddc 100644 --- a/tests/records.scm +++ b/tests/records.scm @@ -590,4 +590,16 @@ Description: 1st line, (match-record rec <with-thunked> (normal thunked) (list normal thunked))))) +(test-equal "match-record-lambda" + '("thing: foo" "thing: bar") + (begin + (define-record-type* <with-text> with-text make-with-text + with-text? + (text with-text-text)) + + (map (match-record-lambda <with-text> (text) + (string-append "thing: " text)) + (list (with-text (text "foo")) + (with-text (text "bar")))))) + (test-end) |