blob: 23d3a1b4e546a62ec2e77a28b2d1a0df6e68d67b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
;"values.scm" multiple values
;By david carlton, carlton@husc.harvard.edu.
;
;This code is in the public domain.
(require 'record)
(define values:*values-rtd*
(make-record-type "values"
'(values)))
;@
(define values
(let ((make-values (record-constructor values:*values-rtd*)))
(lambda x
(if (and (not (null? x))
(null? (cdr x)))
(car x)
(make-values x)))))
;@
(define call-with-values
(let ((access-values (record-accessor values:*values-rtd* 'values))
(values-predicate? (record-predicate values:*values-rtd*)))
(lambda (producer consumer)
(let ((result (producer)))
(if (values-predicate? result)
(apply consumer (access-values result))
(consumer result))))))
|
