2 files changed, 30 insertions(+), 15 deletions(-)

M guix/utils.scm
M tests/utils.scm

@@ 479,20 479,18 @@ tuples."
             (lambda (s)
               (syntax-case s expected
                 ((_ (field value) (... ...))
-                 (let ((fields   (map syntax->datum #'(field (... ...))))
-                       (inits    (map (match-lambda
-                                       ((f v)
-                                        (list (syntax->datum f) v)))
-                                      #'((field value) (... ...))))
-                       (dflt      (map (match-lambda
-                                        ((f v)
-                                         (list (syntax->datum f) v)))
-                                       #'defaults)))
-
-                   (define (field-value f)
-                     (match (assoc f inits)
-                       ((_ v) v)
-                       (#f (car (assoc-ref dflt f)))))
+                 (let ((fields (map syntax->datum #'(field (... ...))))
+                       (dflt   (map (match-lambda
+                                     ((f v)
+                                      (list (syntax->datum f) v)))
+                                    #'defaults)))
+
+                    (define (field-value f)
+                      (or (and=> (find (lambda (x)
+                                         (eq? f (car (syntax->datum x))))
+                                       #'((field value) (... ...)))
+                                 car)
+                          (car (assoc-ref dflt (syntax->datum f)))))
 
                    (let-syntax ((error*
                                  (syntax-rules ()


@@ 503,7 501,8 @@ tuples."
                                                       s)))))
                      (let ((fields (append fields (map car dflt))))
                        (cond ((lset= eq? fields 'expected)
-                              #`(ctor #,@(map field-value 'expected)))
+                              #`(letrec* ((field value) (... ...))
+                                  (ctor #,@(map field-value 'expected))))
                              ((pair? (lset-difference eq? fields 'expected))
                               (error* "extraneous field initializers ~a"
                                       (lset-difference eq? fields 'expected)))

@@ 112,6 112,22 @@
          (match (foo (bar 1))
            (($ <foo> 1 42) #t)))))
 
+(test-assert "define-record-type* with letrec* behavior"
+  ;; Make sure field initializers can refer to each other as if they were in
+  ;; a `letrec*'.
+  (begin
+    (define-record-type* <bar> bar make-bar
+      foo?
+      (x bar-x)
+      (y bar-y (default (+ 40 2)))
+      (z bar-z))
+    (and (match (bar (x 1) (y (+ x 1)) (z (* y 2)))
+           (($ <bar> 1 2 4) #t))
+         (match (bar (x 7) (z (* x 3)))
+           (($ <bar> 7 42 21)))
+         (match (bar (z 21) (x (/ z 3)))
+           (($ <bar> 7 42 21))))))
+
 (test-end)