suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Convert srfi/61/cond to use modern module style.

Browse Source 
This ensures that `=>` and `else` have the same bindings as the ones in
`racket/private/cond`; otherwise it would not be possible to use SRFI 61
`cond` from a `#lang racket/base` program/module.

Tested under both `#lang racket` and `#lang mzscheme`.
This commit is contained in:
Chris K. Jester-Young 2013-02-27 13:18:09 -05:00 committed by Eli Barzilay
parent 39aafe3a1e
commit 9e93ee2682
1 changed files with 27 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
collects/srfi/61/cond.rkt
View File

@ -1,30 +1,30 @@
;;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))
(if t
(receiver t)
(my-cond more-clause ...))))
((_ (generator guard => receiver) more-clause ...)
(call-with-values (lambda () generator)
(lambda t
(if (apply guard t)
(apply receiver t)
(my-cond more-clause ...)))))
((_ (test) more-clause ...)
(or test (my-cond more-clause ...)))
((_ (test body ...) more-clause ...)
(if test
(begin body ...)
(my-cond more-clause ...)))
((_)
(void)))))
;; * Updated by Chris Jester-Young 2013-02-28
#lang racket/base
(provide (prefix-out srfi: (combine-out cond => else)))
(define-syntax cond
(syntax-rules (=> else)
((_ (else else1 else2 ...))
(when #t (begin else1 else2 ...)))
((_ (test => receiver) more-clause ...)
(let ((t test))
(if t
(receiver t)
(cond more-clause ...))))
((_ (generator guard => receiver) more-clause ...)
(call-with-values (lambda () generator)
(lambda t
(if (apply guard t)
(apply receiver t)
(cond more-clause ...)))))
((_ (test) more-clause ...)
(or test (cond more-clause ...)))
((_ (test body ...) more-clause ...)
(if test
(begin body ...)
(cond more-clause ...)))
((_)
(void))))