Add if, and, or, when and friends.

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 ...))))))