nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

records: Separate default-value handling. 

* 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 @@ fields, and DELAYED is the list of identifiers of delayed fields."
#`(delay #,value)) #`(delay #,value))
(else 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) (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)
@ -106,22 +116,15 @@ fields, and DELAYED is the list of identifiers of delayed fields."
#,(record-inheritance #'orig-record #,(record-inheritance #'orig-record
#'((field value) (... ...))))) #'((field value) (... ...)))))
((_ (field value) (... ...)) ((_ (field value) (... ...))
(let ((fields (map syntax->datum #'(field (... ...)))) (let ((fields (map syntax->datum #'(field (... ...)))))
(dflt (map (match-lambda
((f v)
(list (syntax->datum f) v)))
#'defaults)))
(define (field-value f) (define (field-value f)
(or (and=> (find (lambda (x) (or (and=> (find (lambda (x)
(eq? f (car (syntax->datum x)))) (eq? f (car (syntax->datum x))))
#'((field value) (... ...))) #'((field value) (... ...)))
car) car)
(let ((value (wrap-field-value f (field-default-value f))))
(car (assoc-ref dflt (syntax->datum f)))))
(wrap-field-value f value))))
(let ((fields (append fields (map car dflt)))) (let ((fields (append fields (map car default-values))))
(cond ((lset= eq? fields '(expected ...)) (cond ((lset= eq? fields '(expected ...))
#`(let* #,(field-bindings #`(let* #,(field-bindings
#'((field value) (... ...))) #'((field value) (... ...)))