Import Upstream version 2a6upstream/2a6

1 files changed, 27 insertions, 0 deletions

diff --git a/values.scm b/values.scm
new file mode 100644
index 0000000..b47e0f8
--- /dev/null
+++ b/values.scm
@@ -0,0 +1,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))))))