From 37c646859f2382fe003d0a95cc274414ba84f36c Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Thu, 4 Aug 2022 22:02:49 -0700
Subject: Add if, and, or, when and friends.

---
 lib/scheme/base.csc       |  3 +-
 lib/scheme/base/30-if.csc | 76 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 78 insertions(+), 1 deletion(-)
 create mode 100644 lib/scheme/base/30-if.csc

(limited to 'lib/scheme')

diff --git a/lib/scheme/base.csc b/lib/scheme/base.csc
index c9b5c0c..1bba9f4 100644
--- a/lib/scheme/base.csc
+++ b/lib/scheme/base.csc
@@ -1,3 +1,4 @@
 (define-library (scheme base)
   (include-library-declarations "base/10-define.csc")
-  (include-library-declarations "base/20-let.csc"))
+  (include-library-declarations "base/20-let.csc")
+  (include-library-declarations "base/30-if.csc"))
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 ...))))))
-- 
cgit v1.3.1