mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 13:58:15 -05:00
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.
This commit is contained in:
parent
cf4efb394f
commit
c492be654b
1 changed files with 7 additions and 6 deletions
|
@ -81,15 +81,18 @@ (define (field-inherited-value f)
|
|||
(define (thunked-field? f)
|
||||
(memq (syntax->datum f) '#,thunked))
|
||||
|
||||
(define (wrap-field-value f value)
|
||||
(if (thunked-field? f)
|
||||
#`(lambda () #,value)
|
||||
value))
|
||||
|
||||
(define (field-bindings field+value)
|
||||
;; Return field to value bindings, for use in 'let*' below.
|
||||
(map (lambda (field+value)
|
||||
(syntax-case field+value ()
|
||||
((field value)
|
||||
#`(field
|
||||
#,(if (thunked-field? #'field)
|
||||
#'(lambda () value)
|
||||
#'value)))))
|
||||
#,(wrap-field-value #'field #'value)))))
|
||||
field+value))
|
||||
|
||||
(syntax-case s (inherit #,@fields)
|
||||
|
@ -111,9 +114,7 @@ (define (field-value f)
|
|||
car)
|
||||
(let ((value
|
||||
(car (assoc-ref dflt (syntax->datum f)))))
|
||||
(if (thunked-field? f)
|
||||
#`(lambda () #,value)
|
||||
value))))
|
||||
(wrap-field-value f value))))
|
||||
|
||||
(let ((fields (append fields (map car dflt))))
|
||||
(cond ((lset= eq? fields 'expected)
|
||||
|
|
Loading…
Reference in a new issue