From de85eee10077b23e015450d42fbe32b27aa2ac67 Mon Sep 17 00:00:00 2001
From: Nat Quayle Nelson <natquaylenelson@gmail.com>
Date: Tue, 24 Nov 2020 17:46:28 -0700
Subject: [PATCH] cond

---
 src/kiss/Macros.hx                | 20 ++++++++++++++++++++
 src/kiss/Prelude.hx               |  2 --
 src/kiss/SpecialForms.hx          |  2 --
 src/test/cases/BasicTestCase.hx   |  7 +++++++
 src/test/cases/BasicTestCase.kiss | 21 ++++++++++++++++++++-
 5 files changed, 47 insertions(+), 5 deletions(-)

diff --git a/src/kiss/Macros.hx b/src/kiss/Macros.hx
index 33894f25..f36be3fe 100644
--- a/src/kiss/Macros.hx
+++ b/src/kiss/Macros.hx
@@ -51,6 +51,8 @@ class Macros {
 
         // TODO when
 
+        macros["cond"] = cond;
+
         // Under the hood, (defmacrofun ...) defines a runtime function that accepts Quote arguments and a special form that quotes the arguments to macrofun calls
         macros["defmacrofun"] = (exps:Array<ReaderExp>, k:KissState) -> {
             if (exps.length < 3)
@@ -107,6 +109,24 @@ class Macros {
         return macros;
     }
 
+    // cond expands telescopically into a nested if expression
+    static function cond(exps:Array<ReaderExp>, k:KissState) {
+        return switch (exps[0].def) {
+            case CallExp(condition, body):
+                CallExp(Symbol("if").withPos(exps[0].pos), [
+                    condition,
+                    CallExp(Symbol("begin").withPos(exps[0].pos), body).withPos(exps[0].pos),
+                    if (exps.length > 1) {
+                        cond(exps.slice(1), k);
+                    } else {
+                        Symbol("null").withPos(exps[0].pos);
+                    }
+                ]).withPos(exps[0].pos);
+            default:
+                throw 'top-level expression of (cond... ) cannot be ${exps[0]}, must be call lists starting with a condition expression';
+        };
+    }
+
     static function foldMacro(func:String):MacroFunction {
         return (exps:Array<ReaderExp>, k) -> {
             CallExp(Symbol("Lambda.fold").withPos(exps[0].pos), [
diff --git a/src/kiss/Prelude.hx b/src/kiss/Prelude.hx
index ee55d1e7..b7c1512f 100644
--- a/src/kiss/Prelude.hx
+++ b/src/kiss/Prelude.hx
@@ -62,8 +62,6 @@ class Prelude {
         return fullGroups;
     }
 
-    // TODO put truthy in KissState
-    // TODO make [] falsy
     public static dynamic function truthy(v:Any) {
         return switch (Type.typeof(v)) {
             case TNull: false;
diff --git a/src/kiss/SpecialForms.hx b/src/kiss/SpecialForms.hx
index 619f5bab..94c195b3 100644
--- a/src/kiss/SpecialForms.hx
+++ b/src/kiss/SpecialForms.hx
@@ -163,8 +163,6 @@ class SpecialForms {
             EIf(condition, thenExp, elseExp).withContextPos();
         };
 
-        // TODO cond
-
         return map;
     }
 
diff --git a/src/test/cases/BasicTestCase.hx b/src/test/cases/BasicTestCase.hx
index 7730c49c..675528c6 100644
--- a/src/test/cases/BasicTestCase.hx
+++ b/src/test/cases/BasicTestCase.hx
@@ -157,4 +157,11 @@ class BasicTestCase extends Test {
     function testConstructors() {
         Assert.equals("sup", BasicTestCase.myConstructedString);
     }
+
+    function testCond() {
+        Assert.equals("this one", BasicTestCase.myCond1);
+        Assert.equals("the default", BasicTestCase.myCond2);
+        Assert.equals("this", BasicTestCase.myCond3);
+        Assert.equals(null, BasicTestCase.myCondFallthrough);
+    }
 }
diff --git a/src/test/cases/BasicTestCase.kiss b/src/test/cases/BasicTestCase.kiss
index 1fa1dc6a..e429f327 100644
--- a/src/test/cases/BasicTestCase.kiss
+++ b/src/test/cases/BasicTestCase.kiss
@@ -103,4 +103,23 @@
         (Assert.equals 6 b)
         (Assert.equals "stuff" c)))
 
-(defvar myConstructedString (new String "sup"))
\ No newline at end of file
+(defvar myConstructedString (new String "sup"))
+
+(defvar myCond1 (cond 
+    ((= 5 6) "not this")
+    ((= 8 9) "not this either")
+    ((= 1 1) "this one")
+    (true "not the default")))
+
+(defvar myCond2 (cond 
+    ((= 5 6) "not this")
+    ((= 8 9) "not this either")
+    ((= 2 1) "not the third one")
+    (true "the default")))
+
+(defvar myCond3 (cond
+    ((= 5 5) "this")
+    (true "default")))
+
+(defvar myCondFallthrough (cond
+    (false "not this")))
\ No newline at end of file