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
					
				
					 1 changed files with 13 additions and 17 deletions
				
			
		| 
						 | 
					@ -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)))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue