From 1f0ea932e8c77481382ae043f55601284add381d Mon Sep 17 00:00:00 2001
From: Nat Quayle Nelson <natquaylenelson@gmail.com>
Date: Sun, 3 Jan 2021 17:51:31 -0700
Subject: [PATCH] Allow case guards, |

---
 kiss/src/kiss/Helpers.hx               | 31 ++++++++++++++++++++++++++
 kiss/src/kiss/SpecialForms.hx          | 15 +------------
 kiss/src/test/cases/BasicTestCase.kiss | 14 ++++++++++--
 3 files changed, 44 insertions(+), 16 deletions(-)

diff --git a/kiss/src/kiss/Helpers.hx b/kiss/src/kiss/Helpers.hx
index eda44395..c593f9cd 100644
--- a/kiss/src/kiss/Helpers.hx
+++ b/kiss/src/kiss/Helpers.hx
@@ -153,6 +153,37 @@ class Helpers {
         }
     }
 
+    public static function makeSwitchCase(caseExp:ReaderExp, k:KissState, ?guard:Expr):Case {
+        var guard:Expr = null;
+
+        function makeSwitchPattern(patternExp:ReaderExp):Array<Expr> {
+            return switch (patternExp.def) {
+                case CallExp({pos: _, def: Symbol("when")}, whenExps):
+                    patternExp.checkNumArgs(2, 2, "(when [guard] [pattern])");
+                    if (guard != null)
+                        throw CompileError.fromExp(caseExp, "case expression can only have one `when` guard");
+                    guard = macro Prelude.truthy(${k.convert(whenExps[0])});
+                    makeSwitchPattern(whenExps[1]);
+                case CallExp({pos: _, def: Symbol("or")}, orExps):
+                    patternExp.checkNumArgs(2, null, "(or [pattern1] [pattern2] [patterns...])");
+                    orExps.map(k.forCaseParsing().convert);
+                default:
+                    [k.forCaseParsing().convert(patternExp)];
+            }
+        }
+
+        return switch (caseExp.def) {
+            case CallExp(patternExp, caseBodyExps):
+                {
+                    values: makeSwitchPattern(patternExp),
+                    expr: k.convert(CallExp(Symbol("begin").withPosOf(caseExp), caseBodyExps).withPosOf(caseExp)),
+                    guard: guard
+                };
+            default:
+                throw CompileError.fromExp(caseExp, "case expressions for (case...) must take the form ([pattern] [body...])");
+        }
+    }
+
     /**
         Throw a CompileError if the given expression has the wrong number of arguments
     **/
diff --git a/kiss/src/kiss/SpecialForms.hx b/kiss/src/kiss/SpecialForms.hx
index 009dd519..afcc43c1 100644
--- a/kiss/src/kiss/SpecialForms.hx
+++ b/kiss/src/kiss/SpecialForms.hx
@@ -252,20 +252,7 @@ class SpecialForms {
                 default:
                     null;
             };
-            ESwitch(k.forCaseParsing().convert(args[0]), [
-                for (caseExp in args.slice(1))
-                    switch (caseExp.def) {
-                        // TODO support CallExp(Symbol("or")) to generate more than one case value
-                        // TODO support guards
-                        case CallExp(patternExp, caseBodyExps):
-                            {
-                                values: [k.forCaseParsing().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);
+            ESwitch(k.forCaseParsing().convert(args[0]), args.slice(1).map(Helpers.makeSwitchCase.bind(_, k)), defaultExpr).withMacroPosOf(wholeExp);
         };
 
         // TODO macros for ifLet, expectLet, which extract from enums
diff --git a/kiss/src/test/cases/BasicTestCase.kiss b/kiss/src/test/cases/BasicTestCase.kiss
index e0e5e3b9..cb531019 100644
--- a/kiss/src/test/cases/BasicTestCase.kiss
+++ b/kiss/src/test/cases/BasicTestCase.kiss
@@ -330,7 +330,17 @@
         ((Some "hey") (Assert.pass))
         (otherwise (Assert.fail)))
     (Assert.equals 5 (case (toOption 0)
-        (otherwise 5))))
+        (otherwise 5)))
+    // Test case with guards and multiple values
+    (case 5
+        ((or 5 6) (Assert.pass))
+        (otherwise (Assert.fail)))
+    (case [2 3]
+        ((or [_ 3] [1 1]) (Assert.pass))
+        (otherwise (Assert.fail)))
+    (case 5
+        ((when false (or 5 6)) (Assert.fail))
+        (otherwise (Assert.pass))))
 
 (defun _testMaps []
     (deflocal :Map<String,String> myMap [=>"hey" "you"
@@ -400,4 +410,4 @@
 // Make sure built-in call aliases don't override user-defined variables
 (defun _testCallAlias []
     (let [map [=>"hey" "you"]]
-        (Assert.equals "you" (dictGet map "hey"))))
\ No newline at end of file
+        (Assert.equals "you" (dictGet map "hey"))))