@@ -535,17 +535,25 @@ (define (recutils->alist port)
(else
(error "unmatched line" line))))))))
+(define-syntax match-record/fields
+ (syntax-rules ()
+ ((_ record type (field fields ...) body ...)
+ (let ((field ((record-accessor type 'field) record)))
+ ;; TODO compute indices and report wrong-field-name errors at
+ ;; expansion time
+ ;; TODO support thunked and delayed fields
+ (match-record/fields record type (fields ...) body ...)))
+ ((_ record type () body ...)
+ (begin body ...))))
+
(define-syntax match-record
(syntax-rules ()
"Bind each FIELD of a RECORD of the given TYPE to it's FIELD name.
The current implementation does not support thunked and delayed fields."
((_ record type (field fields ...) body ...)
(if (eq? (struct-vtable record) type)
- ;; TODO compute indices and report wrong-field-name errors at
- ;; expansion time
- ;; TODO support thunked and delayed fields
- (let ((field ((record-accessor type 'field) record)))
- (match-record record type (fields ...) body ...))
+ ;; So that we only test the type once.
+ (match-record/fields record type (field fields ...) body ...)
(throw 'wrong-type-arg record)))
((_ record type () body ...)
(begin body ...))))