From 9d70db157eb9458f6716eacf24752fcfbb205fcb Mon Sep 17 00:00:00 2001 From: David Robillard Date: Wed, 26 Dec 2012 01:00:10 +0000 Subject: Add cond macro test. git-svn-id: http://svn.drobilla.net/resp/trunk@448 ad02d1e2-f140-0410-9f75-f8b11f17cedd --- test/cond.scm | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 test/cond.scm (limited to 'test') diff --git a/test/cond.scm b/test/cond.scm new file mode 100644 index 0000000..6151ef2 --- /dev/null +++ b/test/cond.scm @@ -0,0 +1,44 @@ +(define-syntax let + (syntax-rules () + ((let ((name val) ...) body1 body2 ...) + ((lambda (name ...) body1 body2 ...) + val ...)))) + +(define-syntax begin + (syntax-rules () + ((begin exp ...) + ((lambda () exp ...))))) + +(define-syntax cond + (syntax-rules (else =>) + ((cond (else result1 result2 ...)) + (begin result1 result2 ...)) + ((cond (test => result)) + (let ((temp test)) + (if temp (result temp)))) + ((cond (test => result) clause1 clause2 ...) + (let ((temp test)) + (if temp + (result temp) + (cond clause1 clause2 ...)))) + ((cond (test)) test) + ((cond (test) clause1 clause2 ...) + (let ((temp test)) + (if temp + temp + (cond clause1 clause2 ...)))) + ((cond (test result1 result2 ...)) + (if test (begin result1 result2 ...))) + ((cond (test result1 result2 ...) + clause1 clause2 ...) + (if test + (begin result1 result2 ...) + (cond clause1 clause2 ...))))) + +(define x 2) + +(cond + ((= x 1) 1.0) + ((= x 2) 2.0) + ((= x 3) 3.0) + (else 42.0)) -- cgit v1.2.1