summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-06-11 21:49:02 +0200
committerLudovic Courtès <ludo@gnu.org>2015-06-11 23:33:32 +0200
commitb9c8647337762983ac046aec66328ad0efd2f276 (patch)
treef5cec740eba5485dff196be9a9c2924341abca65
parent39fc041a7de18e4b41c4e9007cfdadbff581334a (diff)
downloadgnu-guix-b9c8647337762983ac046aec66328ad0efd2f276.tar
gnu-guix-b9c8647337762983ac046aec66328ad0efd2f276.tar.gz
records: Separate default-value handling.
* guix/records.scm (make-syntactic-constructor)[default-values]: New variable. [field-default-value]: New procedure. Use them.
-rw-r--r--guix/records.scm23
1 files changed, 13 insertions, 10 deletions
diff --git a/guix/records.scm b/guix/records.scm
index 2378969843..f66fda8a32 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -91,6 +91,16 @@ fields, and DELAYED is the list of identifiers of delayed fields."
#`(delay #,value))
(else value)))
+ (define default-values
+ ;; List of symbol/value tuples.
+ (map (match-lambda
+ ((f v)
+ (list (syntax->datum f) v)))
+ #'defaults))
+
+ (define (field-default-value f)
+ (car (assoc-ref default-values (syntax->datum f))))
+
(define (field-bindings field+value)
;; Return field to value bindings, for use in 'let*' below.
(map (lambda (field+value)
@@ -106,22 +116,15 @@ fields, and DELAYED is the list of identifiers of delayed fields."
#,(record-inheritance #'orig-record
#'((field value) (... ...)))))
((_ (field value) (... ...))
- (let ((fields (map syntax->datum #'(field (... ...))))
- (dflt (map (match-lambda
- ((f v)
- (list (syntax->datum f) v)))
- #'defaults)))
-
+ (let ((fields (map syntax->datum #'(field (... ...)))))
(define (field-value f)
(or (and=> (find (lambda (x)
(eq? f (car (syntax->datum x))))
#'((field value) (... ...)))
car)
- (let ((value
- (car (assoc-ref dflt (syntax->datum f)))))
- (wrap-field-value f value))))
+ (wrap-field-value f (field-default-value f))))
- (let ((fields (append fields (map car dflt))))
+ (let ((fields (append fields (map car default-values))))
(cond ((lset= eq? fields '(expected ...))
#`(let* #,(field-bindings
#'((field value) (... ...)))