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.
master
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)) (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"

6
tests/records.scm
View File

@ -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?