diff --git a/collects/srfi/61.ss b/collects/srfi/61.ss new file mode 100644 index 0000000000..7200d2eafd --- /dev/null +++ b/collects/srfi/61.ss @@ -0,0 +1,4 @@ +;; module loader for SRFI-61 +(module |61| mzscheme + (require (lib "cond.ss" "srfi" "61")) + (provide (rename srfi:cond cond))) \ No newline at end of file diff --git a/collects/srfi/61/cond.ss b/collects/srfi/61/cond.ss new file mode 100644 index 0000000000..bd932fcedc --- /dev/null +++ b/collects/srfi/61/cond.ss @@ -0,0 +1,41 @@ +;;SRFI 61 A more general COND clause +;;Chongkai Zhu mrmathematica@yahoo.com +;;12-18-2005 +(module cond mzscheme + + (provide (rename my-cond srfi:cond)) + + (define-syntax my-cond + (syntax-rules (=> else) + ((_ (else else1 else2 ...)) + (if #t (begin else1 else2 ...))) + ((_ (test => receiver) more-clause ...) + (let ((t test)) + (cond/maybe-more t + (receiver t) + more-clause ...))) + ((_ (generator guard => receiver) more-clause ...) + (call-with-values (lambda () generator) + (lambda t + (cond/maybe-more (apply guard t) + (apply receiver t) + more-clause ...)))) + ((_ (test) more-clause ...) + (let ((t test)) + (cond/maybe-more t t more-clause ...))) + ((_ (test body1 body2 ...) more-clause ...) + (cond/maybe-more test + (begin body1 body2 ...) + more-clause ...)) + ((_) + (cond)))) + + (define-syntax cond/maybe-more + (syntax-rules () + ((_ test consequent) + (if test + consequent)) + ((_ test consequent clause ...) + (if test + consequent + (my-cond clause ...)))))) \ No newline at end of file