kiss-lang/kiss
1
0
Fork 0
Code Issues 4 Pull Requests Actions Packages Projects Releases Wiki Activity

Experimental typeCase macro

Browse Source
This commit is contained in:
Nat Quayle Nelson
2022-12-16 02:35:46 +00:00
parent 60880215fd
commit 249d9fc787
3 changed files with 78 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

60
src/kiss/Macros.hx
View File

@@ -1437,7 +1437,67 @@ class Macros {
// Prelude.print(Reader.toString(exp.def)); // Prelude.print(Reader.toString(exp.def));
exp; exp;
}; };
k.doc("typeCase", 2, null, "(typeCase [<values>] ([:<Type> <name> <more typed names...>] <body>) <more cases...> (otherwise <required default>))");
macros["typeCase"] = (wholeExp:ReaderExp, args:Array<ReaderExp>, k:KissState) -> {
var b = wholeExp.expBuilder();
var argsListExp = args.shift();
var argsList = Helpers.argList(argsListExp, "typeCase", false);
var cases:kiss.List<ReaderExp> = [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; return macros;
} }

4
src/test/cases/BasicTestCase.hx
View File

@@ -400,6 +400,10 @@ class BasicTestCase extends Test {
_testPrintMacrosCheck(); _testPrintMacrosCheck();
} }
function testTypeCase() {
_testTypeCase();
}
var aNullToPrint = null; var aNullToPrint = null;
} }

15
src/test/cases/BasicTestCase.kiss
View File

@@ -757,4 +757,17 @@ From:[(assert false (+ \"false \" \"should \" \"have \" \"been \" \"true\"))]" m
(let [u "good"] (let [u "good"]
(localVar v "bad") (localVar v "bad")
(printLocalNulls)) (printLocalNulls))
(Assert.pass)) (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)))