aboutsummaryrefslogtreecommitdiffstats
path: root/srfi-61.scm
diff options
context:
space:
mode:
authorThomas Bushnell, BSG <tb@debian.org>2005-12-04 20:03:34 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:33 -0800
commit69d4f1c761291d2c33c4b22454877402465b2c48 (patch)
treee46e0725a432b1f6460515fa521da6bb174bb226 /srfi-61.scm
parentf351d4a6571016e8a571e274032891e06e03911a (diff)
downloadslib-69d4f1c761291d2c33c4b22454877402465b2c48.tar.gz
slib-69d4f1c761291d2c33c4b22454877402465b2c48.zip
Import Debian changes 3a2-3debian/3a2-3
slib (3a2-3) unstable; urgency=low * Brought all source files up-to-date with upstream CVS. Repeat changes from version 3a2-1 in Makefile.
Diffstat (limited to 'srfi-61.scm')
-rw-r--r--srfi-61.scm49
1 files changed, 49 insertions, 0 deletions
diff --git a/srfi-61.scm b/srfi-61.scm
new file mode 100644
index 0000000..015320b
--- /dev/null
+++ b/srfi-61.scm
@@ -0,0 +1,49 @@
+;;; "srfi-61.scm" -- A more general cond clause -*- Scheme -*-
+
+;;; Public domain
+;;; Author: Taylor Campbell
+;;; URL:http://srfi.schemers.org/srfi-61/srfi-61.html
+
+;@
+(define-syntax cond
+ (syntax-rules (=> else)
+
+ ((cond (else else1 else2 ...))
+ ;; The (IF #T (BEGIN ...)) wrapper ensures that there may be no
+ ;; internal definitions in the body of the clause. R5RS mandates
+ ;; this in text (by referring to each subform of the clauses as
+ ;; <expression>) but not in its reference implementation of COND,
+ ;; which just expands to (BEGIN ...) with no (IF #T ...) wrapper.
+ (if #t (begin else1 else2 ...)))
+
+ ((cond (test => receiver) more-clause ...)
+ (let ((T test))
+ (cond/maybe-more T
+ (receiver T)
+ more-clause ...)))
+
+ ((cond (generator guard => receiver) more-clause ...)
+ (call-with-values (lambda () generator)
+ (lambda T
+ (cond/maybe-more (apply guard T)
+ (apply receiver T)
+ more-clause ...))))
+
+ ((cond (test) more-clause ...)
+ (let ((T test))
+ (cond/maybe-more T T more-clause ...)))
+
+ ((cond (test body1 body2 ...) more-clause ...)
+ (cond/maybe-more test
+ (begin body1 body2 ...)
+ more-clause ...))))
+
+(define-syntax cond/maybe-more
+ (syntax-rules ()
+ ((cond/maybe-more test consequent)
+ (if test
+ consequent))
+ ((cond/maybe-more test consequent clause ...)
+ (if test
+ consequent
+ (cond clause ...)))))