records: Factorize value wrapping in the record constructor.

* guix/records.scm (make-syntactic-constructor)[wrap-field-value]: New
  procedure.
  [field-bindings, field-value]: Use it.
master
Ludovic Courtès 2015-01-19 22:50:57 +01:00
parent cf4efb394f
commit c492be654b
1 changed files with 7 additions and 6 deletions

View File

@ -81,15 +81,18 @@ tuples, and THUNKED is the list of identifiers of thunked fields."
(define (thunked-field? f) (define (thunked-field? f)
(memq (syntax->datum f) '#,thunked)) (memq (syntax->datum f) '#,thunked))
(define (wrap-field-value f value)
(if (thunked-field? f)
#`(lambda () #,value)
value))
(define (field-bindings field+value) (define (field-bindings field+value)
;; Return field to value bindings, for use in 'let*' below. ;; Return field to value bindings, for use in 'let*' below.
(map (lambda (field+value) (map (lambda (field+value)
(syntax-case field+value () (syntax-case field+value ()
((field value) ((field value)
#`(field #`(field
#,(if (thunked-field? #'field) #,(wrap-field-value #'field #'value)))))
#'(lambda () value)
#'value)))))
field+value)) field+value))
(syntax-case s (inherit #,@fields) (syntax-case s (inherit #,@fields)
@ -111,9 +114,7 @@ tuples, and THUNKED is the list of identifiers of thunked fields."
car) car)
(let ((value (let ((value
(car (assoc-ref dflt (syntax->datum f))))) (car (assoc-ref dflt (syntax->datum f)))))
(if (thunked-field? f) (wrap-field-value f value))))
#`(lambda () #,value)
value))))
(let ((fields (append fields (map car dflt)))) (let ((fields (append fields (map car dflt))))
(cond ((lset= eq? fields 'expected) (cond ((lset= eq? fields 'expected)