From 249d9fc787d433e4d18dc4e4001dba81023432a1 Mon Sep 17 00:00:00 2001 From: Nat Quayle Nelson Date: Fri, 16 Dec 2022 02:35:46 +0000 Subject: [PATCH] Experimental typeCase macro --- src/kiss/Macros.hx | 60 +++++++++++++++++++++++++++++++ src/test/cases/BasicTestCase.hx | 4 +++ src/test/cases/BasicTestCase.kiss | 15 +++++++- 3 files changed, 78 insertions(+), 1 deletion(-) diff --git a/src/kiss/Macros.hx b/src/kiss/Macros.hx index d84e819..0fa28d6 100644 --- a/src/kiss/Macros.hx +++ b/src/kiss/Macros.hx @@ -1437,7 +1437,67 @@ class Macros { // Prelude.print(Reader.toString(exp.def)); exp; }; + + k.doc("typeCase", 2, null, "(typeCase [] ([: ] ) (otherwise ))"); + macros["typeCase"] = (wholeExp:ReaderExp, args:Array, k:KissState) -> { + var b = wholeExp.expBuilder(); + var argsListExp = args.shift(); + var argsList = Helpers.argList(argsListExp, "typeCase", false); + + var cases:kiss.List = [for (c in args) { + Prelude.print(c.expBuilder().neverCase()); + }]; + + Helpers.checkNoEarlyOtherwise(cases); + + var symbols = [for (i in 0...argsList.length) b.symbol()]; + var dynamicSymbols = [for (s in symbols) b.typed("Dynamic", s)]; + var outerLetBindings = []; + for (i in 0...argsList.length) { + outerLetBindings.push(dynamicSymbols[i]); + outerLetBindings.push(argsList[i]); + } + + cases = [for (c in cases) { + var b = c.expBuilder(); + switch (c.def) { + case CallExp({pos:_, def:ListExp(typedNames)}, body): + var names = []; + var types = []; + var typesWithoutGenerics = []; + for (exp in typedNames) { + switch (exp.def) { + case TypedExp(type, nameSymbol): + names.push(nameSymbol); + types.push(type); + if (type.contains("<")) { + type = type.substr(type.indexOf("<")); + } + typesWithoutGenerics.push(type); + default: + throw KissError.fromExp(c, "bad typeCase case"); + } + } + var letBindings = []; + for (i in 0...names.length) { + letBindings.push(typedNames[i]); + letBindings.push(names[i]); + } + b.call(b.callSymbol("when", [b.callSymbol("and", [ + for (i in 0...names.length) { + b.callSymbol("Std.isOfType", [names[i], b.symbol(typesWithoutGenerics[i])]); + } + ]), b.list(names)]), [b.let(letBindings, body)]); + default: c; + } + }]; + + b.let(outerLetBindings, [ + b.callSymbol("case", [b.list(symbols)].concat(cases)) + ]); + } + return macros; } diff --git a/src/test/cases/BasicTestCase.hx b/src/test/cases/BasicTestCase.hx index 14807fb..2e50dc9 100644 --- a/src/test/cases/BasicTestCase.hx +++ b/src/test/cases/BasicTestCase.hx @@ -400,6 +400,10 @@ class BasicTestCase extends Test { _testPrintMacrosCheck(); } + function testTypeCase() { + _testTypeCase(); + } + var aNullToPrint = null; } diff --git a/src/test/cases/BasicTestCase.kiss b/src/test/cases/BasicTestCase.kiss index 6079e69..aaa40bf 100644 --- a/src/test/cases/BasicTestCase.kiss +++ b/src/test/cases/BasicTestCase.kiss @@ -757,4 +757,17 @@ From:[(assert false (+ \"false \" \"should \" \"have \" \"been \" \"true\"))]" m (let [u "good"] (localVar v "bad") (printLocalNulls)) - (Assert.pass)) \ No newline at end of file + (Assert.pass)) + +(function :Void _testTypeCase [] + (typeCase ["a"] + ([:String a] + (Assert.equals "a" a))) + (typeCase ["a" 1] + (never [:String a :String one]) + ([:String a :Int one] + (Assert.equals "a1" "${a}${one}"))) + (typeCase ["a" 5 5.5 true] + ([:String a :Int five :Float fivePointFive :Bool tt] + (Assert.equals "a55.5true" "${a}${five}${fivePointFive}${tt}")) + (never otherwise))) \ No newline at end of file