ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-26 14:28:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

records: Factorize value wrapping in the record constructor.

Browse source 
* guix/records.scm (make-syntactic-constructor)[wrap-field-value]: New
  procedure.
  [field-bindings, field-value]: Use it.
This commit is contained in:
Ludovic Courtès 2015-01-19 22:50:57 +01:00
parent cf4efb394f
commit c492be654b
1 changed files with 7 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
guix/records.scm
View file

@ -81,15 +81,18 @@ (define (field-inherited-value f)
(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 @@ (define (field-value f)
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)