Codebase list slib / cme/main values.scm
cme/main

Tree @cme/main (Download .tar.gz)

values.scm @cme/main — raw · history · blame 

 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* '(values))))
    (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))))))