records: define-record-type*: Field bindings are bound with 'let*'.
* guix/records.scm (define-record-type*): Wrap field bindings in a 'let*', not in a 'letrec*', which turned out to be pointlessly inconvenient. * tests/records.scm: Adjust test names accordingly.
This commit is contained in:
parent
70a9c72028
commit
59fbeb8cae
|
@ -73,7 +73,7 @@ thunked fields."
|
||||||
(memq (syntax->datum f) '#,thunked))
|
(memq (syntax->datum f) '#,thunked))
|
||||||
|
|
||||||
(define (field-bindings field+value)
|
(define (field-bindings field+value)
|
||||||
;; Return field to value bindings, for use in `letrec*' below.
|
;; Return field to value bindings, for use in 'let*' below.
|
||||||
(map (lambda (field+value)
|
(map (lambda (field+value)
|
||||||
(syntax-case field+value ()
|
(syntax-case field+value ()
|
||||||
((field value)
|
((field value)
|
||||||
|
@ -85,7 +85,7 @@ thunked fields."
|
||||||
|
|
||||||
(syntax-case s (inherit #,@fields)
|
(syntax-case s (inherit #,@fields)
|
||||||
((_ (inherit orig-record) (field value) (... ...))
|
((_ (inherit orig-record) (field value) (... ...))
|
||||||
#`(letrec* #,(field-bindings #'((field value) (... ...)))
|
#`(let* #,(field-bindings #'((field value) (... ...)))
|
||||||
#,(record-inheritance #'orig-record
|
#,(record-inheritance #'orig-record
|
||||||
#'((field value) (... ...)))))
|
#'((field value) (... ...)))))
|
||||||
((_ (field value) (... ...))
|
((_ (field value) (... ...))
|
||||||
|
@ -116,8 +116,8 @@ thunked fields."
|
||||||
s)))))
|
s)))))
|
||||||
(let ((fields (append fields (map car dflt))))
|
(let ((fields (append fields (map car dflt))))
|
||||||
(cond ((lset= eq? fields 'expected)
|
(cond ((lset= eq? fields 'expected)
|
||||||
#`(letrec* #,(field-bindings
|
#`(let* #,(field-bindings
|
||||||
#'((field value) (... ...)))
|
#'((field value) (... ...)))
|
||||||
(ctor #,@(map field-value 'expected))))
|
(ctor #,@(map field-value 'expected))))
|
||||||
((pair? (lset-difference eq? fields 'expected))
|
((pair? (lset-difference eq? fields 'expected))
|
||||||
(error* "extraneous field initializers ~a"
|
(error* "extraneous field initializers ~a"
|
||||||
|
|
|
@ -36,9 +36,9 @@
|
||||||
(match (foo (bar 1))
|
(match (foo (bar 1))
|
||||||
(($ <foo> 1 42) #t)))))
|
(($ <foo> 1 42) #t)))))
|
||||||
|
|
||||||
(test-assert "define-record-type* with letrec* behavior"
|
(test-assert "define-record-type* with let* behavior"
|
||||||
;; Make sure field initializers can refer to each other as if they were in
|
;; Make sure field initializers can refer to each other as if they were in
|
||||||
;; a `letrec*'.
|
;; a 'let*'.
|
||||||
(begin
|
(begin
|
||||||
(define-record-type* <bar> bar make-bar
|
(define-record-type* <bar> bar make-bar
|
||||||
foo?
|
foo?
|
||||||
|
@ -69,7 +69,7 @@
|
||||||
(equal? c d)
|
(equal? c d)
|
||||||
(match e (($ <foo> 42 77) #t))))))
|
(match e (($ <foo> 42 77) #t))))))
|
||||||
|
|
||||||
(test-assert "define-record-type* & inherit & letrec* behavior"
|
(test-assert "define-record-type* & inherit & let* behavior"
|
||||||
(begin
|
(begin
|
||||||
(define-record-type* <foo> foo make-foo
|
(define-record-type* <foo> foo make-foo
|
||||||
foo?
|
foo?
|
||||||
|
|
Loading…
Reference in New Issue