nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Ludovic Courtès 2013-10-15 23:31:22 +02:00
parent 70a9c72028
commit 59fbeb8cae
2 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
guix/records.scm
View File

@ -73,7 +73,7 @@ thunked fields."
(memq (syntax->datum f) '#,thunked))
(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)
(syntax-case field+value ()
((field value)
@ -85,7 +85,7 @@ thunked fields."
(syntax-case s (inherit #,@fields)
((_ (inherit orig-record) (field value) (... ...))
#`(letrec* #,(field-bindings #'((field value) (... ...)))
#`(let* #,(field-bindings #'((field value) (... ...)))
#,(record-inheritance #'orig-record
#'((field value) (... ...)))))
((_ (field value) (... ...))
@ -116,8 +116,8 @@ thunked fields."
s)))))
(let ((fields (append fields (map car dflt))))
(cond ((lset= eq? fields 'expected)
#`(letrec* #,(field-bindings
#'((field value) (... ...)))
#`(let* #,(field-bindings
#'((field value) (... ...)))
(ctor #,@(map field-value 'expected))))
((pair? (lset-difference eq? fields 'expected))
(error* "extraneous field initializers ~a"

6
tests/records.scm
View File

@ -36,9 +36,9 @@
(match (foo (bar 1))
(($ <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
;; a `letrec*'.
;; a 'let*'.
(begin
(define-record-type* <bar> bar make-bar
foo?
@ -69,7 +69,7 @@
(equal? c d)
(match e (($ <foo> 42 77) #t))))))
(test-assert "define-record-type* & inherit & letrec* behavior"
(test-assert "define-record-type* & inherit & let* behavior"
(begin
(define-record-type* <foo> foo make-foo
foo?