diff --git a/kiss/src/kiss/SpecialForms.hx b/kiss/src/kiss/SpecialForms.hx index ce878cd8..2d80c394 100644 --- a/kiss/src/kiss/SpecialForms.hx +++ b/kiss/src/kiss/SpecialForms.hx @@ -215,6 +215,39 @@ class SpecialForms { }; // TODO (case... ) for switch + map["case"] = (wholeExp:ReaderExp, args:kiss.List, 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, k:KissState) -> { diff --git a/kiss/src/test/cases/BasicTestCase.hx b/kiss/src/test/cases/BasicTestCase.hx index d76682b7..a372b912 100644 --- a/kiss/src/test/cases/BasicTestCase.hx +++ b/kiss/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/kiss/src/test/cases/BasicTestCase.kiss b/kiss/src/test/cases/BasicTestCase.kiss index 4683090a..15d231ae 100644 --- a/kiss/src/test/cases/BasicTestCase.kiss +++ b/kiss/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