From 40b91ec6be9c2b7cc2b6bd04cf2952e56f8c9762 Mon Sep 17 00:00:00 2001
From: Nat Quayle Nelson <natquaylenelson@gmail.com>
Date: Mon, 7 Dec 2020 07:37:57 -0700
Subject: [PATCH] basic (case...)

---
 src/kiss/SpecialForms.hx          | 33 +++++++++++++++++++++++++++++++
 src/test/cases/BasicTestCase.hx   |  5 +++++
 src/test/cases/BasicTestCase.kiss | 16 ++++++++++++++-
 3 files changed, 53 insertions(+), 1 deletion(-)

diff --git a/src/kiss/SpecialForms.hx b/src/kiss/SpecialForms.hx
index ce878cd..2d80c39 100644
--- a/src/kiss/SpecialForms.hx
+++ b/src/kiss/SpecialForms.hx
@@ -215,6 +215,39 @@ class SpecialForms {
         };
 
         // TODO (case... ) for switch
+        map["case"] = (wholeExp:ReaderExp, args:kiss.List<ReaderExp>, k:KissState) -> {
+            // Most Lisps don't enforce covering all possible patterns with (case...), but Kiss does,
+            // because pattern coverage is a useful feature of Haxe that Kiss can easily bring along.
+            // To be more similar to other Lisps, Kiss *could* generate a default case that returns null
+            // if no "otherwise" clause is given.
+
+            // Therefore only one case is required in a case statement, because one case could be enough
+            // to cover all patterns.
+            wholeExp.checkNumArgs(2, null, '(case [expression] [cases...] [optional: (otherwise [default])])');
+            var defaultExpr = switch (args[-1].def) {
+                case CallExp({pos: _, def: Symbol("otherwise")}, [otherwiseExp]):
+                    args.pop();
+                    k.convert(otherwiseExp);
+                default:
+                    null;
+            };
+            ESwitch(k.convert(args[0]), [
+                for (caseExp in args.slice(1))
+                    switch (caseExp.def) {
+                        // TODO support | to generate more than one case value
+                        // TODO support guards
+                        case CallExp(patternExp, caseBodyExps):
+                            {
+                                values: [k.convert(patternExp)],
+                                expr: k.convert(CallExp(Symbol("begin").withPosOf(caseExp), caseBodyExps).withPosOf(caseExp))
+                            };
+                        default:
+                            throw CompileError.fromExp(caseExp, "case expressions for (case...) must take the form ([pattern] [body...])");
+                    }
+            ], defaultExpr).withMacroPosOf(wholeExp);
+        };
+
+        // TODO macros for ifLet, expectLet, which extract from enums
 
         // Type check syntax:
         map["the"] = (wholeExp:ReaderExp, args:Array<ReaderExp>, k:KissState) -> {
diff --git a/src/test/cases/BasicTestCase.hx b/src/test/cases/BasicTestCase.hx
index d76682b..a372b91 100644
--- a/src/test/cases/BasicTestCase.hx
+++ b/src/test/cases/BasicTestCase.hx
@@ -4,6 +4,7 @@ import utest.Test;
 import utest.Assert;
 import kiss.Prelude;
 import kiss.List;
+import haxe.ds.Option;
 
 using StringTools;
 
@@ -237,6 +238,10 @@ class BasicTestCase extends Test {
     function testAnonymousObject() {
         _testAnonymousObject();
     }
+
+    function testCase() {
+        _testCase();
+    }
 }
 
 class BasicObject {
diff --git a/src/test/cases/BasicTestCase.kiss b/src/test/cases/BasicTestCase.kiss
index 4683090..15d231a 100644
--- a/src/test/cases/BasicTestCase.kiss
+++ b/src/test/cases/BasicTestCase.kiss
@@ -325,4 +325,18 @@
                     a "string A"
                     b 5)]
         (Assert.equals "string A" obj.a)
-        (Assert.equals 5 obj.b)))
\ No newline at end of file
+        (Assert.equals 5 obj.b)))
+
+(defun toOption [:Dynamic value]
+    (if value (Some value) None))
+
+(defun _testCase []
+    (case (toOption [])
+        (None (Assert.pass))
+        ((Some value) (Assert.fail)))
+    (case (toOption "hey")
+        (None (Assert.fail))
+        ((Some "hey") (Assert.pass))
+        (otherwise (Assert.fail)))
+    (Assert.equals 5 (case (toOption 0)
+        (otherwise 5))))
\ No newline at end of file