summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-01-19 22:50:57 +0100
committerLudovic Courtès <ludo@gnu.org>2015-01-19 23:30:42 +0100
commitc492be654be7c994d39d5aa6a7575792baf9edb9 (patch)
tree4e83df8abad1b40bf502ecbffaa23e9746276ebc
parentcf4efb394fb685f7762667f39378b88e7df87f36 (diff)
downloadguix-c492be654be7c994d39d5aa6a7575792baf9edb9.tar.gz
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.
-rw-r--r--guix/records.scm13
1 files changed, 7 insertions, 6 deletions
diff --git a/guix/records.scm b/guix/records.scm
index af6396f3dd..bef8ff861b 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -81,15 +81,18 @@ tuples, and THUNKED is the list of identifiers of thunked fields."
           (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 @@ tuples, and THUNKED is the list of identifiers of thunked fields."
                             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)