ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

records: Separate default-value handling.

Browse source 
* guix/records.scm (make-syntactic-constructor)[default-values]: New
  variable.
  [field-default-value]: New procedure.
  Use them.
This commit is contained in:
Ludovic Courtès 2015-06-11 21:49:02 +02:00
parent 39fc041a7d
commit b9c8647337
1 changed files with 13 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
guix/records.scm
View file

@ -91,6 +91,16 @@ (define (wrap-field-value f value)
#`(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 @@ (define (field-bindings field+value)
#,(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) (... ...)))