06/08: records: Factorize value wrapping in the record constructor.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit c492be654be7c994d39d5aa6a7575792baf9edb9
Author: Ludovic Courtès <address@hidden>
Date:   Mon Jan 19 22:50:57 2015 +0100

    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.
---
 guix/records.scm |   13 +++++++------
 1 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index af6396f..bef8ff8 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)