03/10: records: Factorize field property predicates.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit faef3b6a96114524c2a25e3b84caa042a2d2e598
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jun 11 22:22:05 2015 +0200

    records: Factorize field property predicates.
    
    * guix/records.scm (define-field-property-predicate): New macro.
      (define-record-type*)[thunked-field?, delayed-field?]: Use it.
---
 guix/records.scm |   30 +++++++++++++-----------------
 1 files changed, 13 insertions(+), 17 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index f66fda8..dbdd220 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -142,6 +142,17 @@ fields, and DELAYED is the list of identifiers of delayed 
fields."
                                                       '(expected ...)
                                                       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*
   (lambda (s)
     "Define the given record type such that an additional \"syntactic
@@ -189,23 +200,8 @@ field."
          (field-default-value #'(field options ...)))
         (_ #f)))
 
-    (define (delayed-field? s)
-      ;; Return the field name if the field defined by S is delayed.
-      (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-field-property-predicate delayed-field? delayed)
+    (define-field-property-predicate thunked-field? thunked)
 
     (define (wrapped-field? s)
       (or (thunked-field? s) (delayed-field? s)))