From b9c8647337762983ac046aec66328ad0efd2f276 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 11 Jun 2015 21:49:02 +0200 Subject: records: Separate default-value handling. * guix/records.scm (make-syntactic-constructor)[default-values]: New variable. [field-default-value]: New procedure. Use them. --- guix/records.scm | 23 +++++++++++++---------- 1 file 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) (... ...))) -- cgit v1.2.3