diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-06-11 21:49:02 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-06-11 23:33:32 +0200 |
| commit | b9c8647337762983ac046aec66328ad0efd2f276 (patch) | |
| tree | f5cec740eba5485dff196be9a9c2924341abca65 | |
| parent | 39fc041a7de18e4b41c4e9007cfdadbff581334a (diff) | |
| download | gnu-guix-b9c8647337762983ac046aec66328ad0efd2f276.tar gnu-guix-b9c8647337762983ac046aec66328ad0efd2f276.tar.gz | |
records: Separate default-value handling.
* guix/records.scm (make-syntactic-constructor)[default-values]: New
variable.
[field-default-value]: New procedure.
Use them.
| -rw-r--r-- | guix/records.scm | 23 |
1 files changed, 13 insertions, 10 deletions
diff --git a/guix/records.scm b/guix/records.scm index 2378969843..f66fda8a32 100644 --- a/guix/records.scm +++ b/guix/records.scm @@ -91,6 +91,16 @@ fields, and DELAYED is the list of identifiers of delayed fields." #`(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 @@ fields, and DELAYED is the list of identifiers of delayed fields." #,(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) (... ...))) |