slight improvement to R6RS carry-test expansion

svn: r10879
This commit is contained in:
Matthew Flatt 2008-07-23 15:51:13 +00:00
parent 7bd75641c7
commit f7767aefaa

View File

@ -22,11 +22,14 @@
[s1 (div0 s (expt 2 (fixnum-width)))]) [s1 (div0 s (expt 2 (fixnum-width)))])
(values s0 s1))) (values s0 s1)))
(define (vals->list f a b c)
(call-with-values (lambda () (f a b c)) list))
(define-syntax carry-test (define-syntax carry-test
(syntax-rules () (syntax-rules ()
[(_ fxop/carry fxop/carry-reference fx1 fx2 fx3) [(_ fxop/carry fxop/carry-reference fx1 fx2 fx3)
(test (call-with-values (lambda () (fxop/carry fx1 fx2 fx3)) list) (test (vals->list fxop/carry fx1 fx2 fx3)
(call-with-values (lambda () (fxop/carry-reference fx1 fx2 fx3)) list))])) (vals->list fxop/carry-reference fx1 fx2 fx3))]))
(define-syntax carry-tests (define-syntax carry-tests
(syntax-rules () (syntax-rules ()