records: Factorize field property predicates.
* guix/records.scm (define-field-property-predicate): New macro. (define-record-type*)[thunked-field?, delayed-field?]: Use it.
This commit is contained in:
parent
b9c8647337
commit
faef3b6a96
|
@ -142,6 +142,17 @@ fields, and DELAYED is the list of identifiers of delayed fields."
|
||||||
'(expected ...)
|
'(expected ...)
|
||||||
fields)))))))))))))
|
fields)))))))))))))
|
||||||
|
|
||||||
|
(define-syntax-rule (define-field-property-predicate predicate property)
|
||||||
|
"Define PREDICATE as a procedure that takes a syntax object and, when passed
|
||||||
|
a field specification, returns the field name if it has the given PROPERTY."
|
||||||
|
(define (predicate s)
|
||||||
|
(syntax-case s (property)
|
||||||
|
((field (property values (... ...)) _ (... ...))
|
||||||
|
#'field)
|
||||||
|
((field _ properties (... ...))
|
||||||
|
(predicate #'(field properties (... ...))))
|
||||||
|
(_ #f))))
|
||||||
|
|
||||||
(define-syntax define-record-type*
|
(define-syntax define-record-type*
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
"Define the given record type such that an additional \"syntactic
|
"Define the given record type such that an additional \"syntactic
|
||||||
|
@ -189,23 +200,8 @@ field."
|
||||||
(field-default-value #'(field options ...)))
|
(field-default-value #'(field options ...)))
|
||||||
(_ #f)))
|
(_ #f)))
|
||||||
|
|
||||||
(define (delayed-field? s)
|
(define-field-property-predicate delayed-field? delayed)
|
||||||
;; Return the field name if the field defined by S is delayed.
|
(define-field-property-predicate thunked-field? thunked)
|
||||||
(syntax-case s (delayed)
|
|
||||||
((field (delayed) _ ...)
|
|
||||||
#'field)
|
|
||||||
((field _ options ...)
|
|
||||||
(delayed-field? #'(field options ...)))
|
|
||||||
(_ #f)))
|
|
||||||
|
|
||||||
(define (thunked-field? s)
|
|
||||||
;; Return the field name if the field defined by S is thunked.
|
|
||||||
(syntax-case s (thunked)
|
|
||||||
((field (thunked) _ ...)
|
|
||||||
#'field)
|
|
||||||
((field _ options ...)
|
|
||||||
(thunked-field? #'(field options ...)))
|
|
||||||
(_ #f)))
|
|
||||||
|
|
||||||
(define (wrapped-field? s)
|
(define (wrapped-field? s)
|
||||||
(or (thunked-field? s) (delayed-field? s)))
|
(or (thunked-field? s) (delayed-field? s)))
|
||||||
|
|
Loading…
Reference in New Issue