blob: 015320bbb01ffd05f813ef167979b84ef4626b42 (
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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
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 ...)))))
|
