diff --git a/build-scripts/common-test-args.hxml b/build-scripts/common-test-args.hxml index 7b7df13..5abc7af 100644 --- a/build-scripts/common-test-args.hxml +++ b/build-scripts/common-test-args.hxml @@ -1,4 +1,6 @@ -lib utest -D test -D hscriptPos +-D var1ForCase=var1 +-D var2ForCase=var2 --main test.TestMain \ No newline at end of file diff --git a/src/kiss/Macros.hx b/src/kiss/Macros.hx index 4751494..66770f5 100644 --- a/src/kiss/Macros.hx +++ b/src/kiss/Macros.hx @@ -172,7 +172,7 @@ class Macros { ]); }; - // Conditional compilation is all based on this macro: + // Most conditional compilation macros are based on this macro: macros["#if"] = (wholeExp:ReaderExp, exps:Array, k) -> { wholeExp.checkNumArgs(2, 3, '(#if [cond] [then] [?else])'); @@ -199,6 +199,48 @@ class Macros { } }; + // But not this one: + macros["#case"] = (wholeExp:ReaderExp, exps:Array, k) -> { + wholeExp.checkNumArgs(2, null, '(#case [expression] [cases...] [optional: (otherwise [default])])'); + var b = wholeExp.expBuilder(); + + var caseVar = exps.shift(); + var matchPatterns = []; + var matchBodies = []; + var matchBodySymbols = []; + var caseArgs = [caseVar]; + for (exp in exps) { + switch (exp.def) { + case CallExp(pattern, bodyExps): + matchPatterns.push(pattern); + matchBodies.push(b.begin(bodyExps)); + var gensym = b.symbol(); + matchBodySymbols.push(gensym); + caseArgs.push(b.call(pattern, [gensym])); + default: + throw CompileError.fromExp(exp, "invalid pattern expression for #case"); + } + } + + var caseExp = b.callSymbol("case", caseArgs); + + var parser = new Parser(); + var caseInterp = new KissInterp(); + var caseStr = Reader.toString(caseExp.def); + var caseHScript = parser.parseString(Prelude.convertToHScript(caseStr)); + for (matchBodySymbol in matchBodySymbols) { + caseInterp.variables.set(Prelude.symbolNameValue(matchBodySymbol), matchBodies.shift()); + } + for (flag => value in Context.getDefines()) { + caseInterp.variables.set(flag, value); + } + try { + return caseInterp.execute(caseHScript); + } catch (e) { + throw CompileError.fromExp(caseExp, '#case evaluation threw error $e'); + } + } + function bodyIf(formName:String, underlyingIf:String, negated:Bool, wholeExp:ReaderExp, args:Array, k) { wholeExp.checkNumArgs(2, null, '($formName [condition] [body...])'); var b = wholeExp.expBuilder(); @@ -220,8 +262,8 @@ class Macros { macros["#when"] = bodyIf.bind("#when", "#if", false); macros["#unless"] = bodyIf.bind("#unless", "#if", true); - macros["cond"] = cond.bind("if"); - macros["#cond"] = cond.bind("#if"); + macros["cond"] = cond.bind("cond", "if"); + macros["#cond"] = cond.bind("#cond", "#if"); // (or... ) uses (cond... ) under the hood macros["or"] = (wholeExp:ReaderExp, args:Array, k) -> { @@ -741,8 +783,8 @@ class Macros { } // cond expands telescopically into a nested if expression - static function cond(underlyingIf:String, wholeExp:ReaderExp, exps:Array, k:KissState) { - wholeExp.checkNumArgs(1, null, "(cond [cases...])"); + static function cond(formName:String, underlyingIf:String, wholeExp:ReaderExp, exps:Array, k:KissState) { + wholeExp.checkNumArgs(1, null, '($formName [cases...])'); var b = wholeExp.expBuilder(); return switch (exps[0].def) { case CallExp(condition, body): @@ -750,7 +792,7 @@ class Macros { condition, b.begin(body), if (exps.length > 1) { - cond(underlyingIf, b.call(b.symbol("cond"), exps.slice(1)), exps.slice(1), k); + cond(formName, underlyingIf, b.callSymbol(formName, exps.slice(1)), exps.slice(1), k); } else { b.symbol("null"); } diff --git a/src/kiss/Prelude.hx b/src/kiss/Prelude.hx index 74b7c45..01b71ae 100644 --- a/src/kiss/Prelude.hx +++ b/src/kiss/Prelude.hx @@ -285,6 +285,13 @@ class Prelude { return v; } + public static function symbolNameValue(s:ReaderExp):String { + return switch (s.def) { + case Symbol(name): name; + default: throw 'expected $s to be a plain symbol'; + }; + } + // ReaderExp helpers for macros: public static function symbol(?name:String):ReaderExpDef { if (name == null) diff --git a/src/test/cases/ConditionalCompilationTestCase.hx b/src/test/cases/ConditionalCompilationTestCase.hx index f04297e..f3f9e8d 100644 --- a/src/test/cases/ConditionalCompilationTestCase.hx +++ b/src/test/cases/ConditionalCompilationTestCase.hx @@ -47,4 +47,8 @@ class ConditionalCompilationTestCase extends Test { Assert.equals("Python", targetLanguage); #end } + + function testCase() { + _testCase(); + } } diff --git a/src/test/cases/ConditionalCompilationTestCase.kiss b/src/test/cases/ConditionalCompilationTestCase.kiss index 38628db..46ec418 100644 --- a/src/test/cases/ConditionalCompilationTestCase.kiss +++ b/src/test/cases/ConditionalCompilationTestCase.kiss @@ -21,4 +21,12 @@ (interp "Haxe") (hxnodejs "NodeJS") (js "JavaScript") - (py "Python"))) \ No newline at end of file + (py "Python"))) + +(defun _testCase [] + (#case var1ForCase + ("var1" (Assert.pass)) + (otherwise (Assert.fail))) + (#case var2ForCase + ("var2" (Assert.pass)) + (otherwise (Assert.fail)))) \ No newline at end of file