aboutsummaryrefslogtreecommitdiffstats
path: root/lib/scheme/base/30-if.csc
diff options
context:
space:
mode:
Diffstat (limited to 'lib/scheme/base/30-if.csc')
-rw-r--r--lib/scheme/base/30-if.csc76
1 files changed, 76 insertions, 0 deletions
diff --git a/lib/scheme/base/30-if.csc b/lib/scheme/base/30-if.csc
new file mode 100644
index 0000000..09012fa
--- /dev/null
+++ b/lib/scheme/base/30-if.csc
@@ -0,0 +1,76 @@
+(export
+ and
+ cond
+ if
+ or
+ unless
+ when)
+(import (only (csc builtins)
+ builtin-if))
+(begin
+
+
+ (define-syntax if
+ (syntax-rules ()
+ ((if test consequent)
+ (builtin-if test consequent #f))
+ ((if test consequent alternate)
+ (builtin-if test consequent alternate))))
+
+
+ (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-syntax and
+ (syntax-rules ()
+ ((and) #t)
+ ((and test) test)
+ ((and test1 test2 ...)
+ (if test1 (and test2 ...) #f))))
+
+
+ (define-syntax or
+ (syntax-rules ()
+ ((or) #f)
+ ((or test) test)
+ ((or test1 test2 ...)
+ (let ((x test1))
+ (if x x (or test2 ...))))))
+
+
+ (define-syntax when
+ (syntax-rules ()
+ ((when test result1 result2 ...)
+ (if test
+ (begin result1 result2 ...)))))
+
+
+ (define-syntax unless
+ (syntax-rules ()
+ ((unless test result1 result2 ...)
+ (if (not test)
+ (begin result1 result2 ...))))))