diff --git a/src/kiss/Helpers.hx b/src/kiss/Helpers.hx index 7f698de..2773c41 100644 --- a/src/kiss/Helpers.hx +++ b/src/kiss/Helpers.hx @@ -179,17 +179,53 @@ class Helpers { } } - public static function makeSwitchCase(caseExp:ReaderExp, k:KissState, ?guard:Expr):Case { + // The name of this function is confusing--it actually makes a Haxe `case` expression, not a switch-case expression + public static function makeSwitchCase(caseExp:ReaderExp, k:KissState):Case { var guard:Expr = null; + var restExpIndex = -1; + var restExpName = ""; + var expNames = []; + var listVarSymbol = null; function makeSwitchPattern(patternExp:ReaderExp):Array { 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"); + throw CompileError.fromExp(caseExp, "case pattern can only have one `when` guard"); guard = macro Prelude.truthy(${k.convert(whenExps[0])}); makeSwitchPattern(whenExps[1]); + case ListEatingExp(exps) if (exps.length == 0): + throw CompileError.fromExp(patternExp, "list-eating pattern should not be empty"); + case ListEatingExp(exps): + for (idx in 0...exps.length) { + var exp = exps[idx]; + switch (exp.def) { + case Symbol(_): + expNames.push(exp); + case ListRestExp(name): + if (restExpIndex > -1) { + throw CompileError.fromExp(patternExp, "list-eating pattern cannot have multiple ... or ...[restVar] expressions"); + } + restExpIndex = idx; + restExpName = name; + default: + throw CompileError.fromExp(exp, "list-eating pattern can only contain symbols, ..., or ...[restVar]"); + } + } + + if (restExpIndex == -1) { + throw CompileError.fromExp(patternExp, "list-eating pattern is missing ... or ...[restVar]"); + } + + if (expNames.length == 0) { + throw CompileError.fromExp(patternExp, "list-eating pattern must match at least one single element"); + } + + var b = patternExp.expBuilder(); + listVarSymbol = b.symbol(); + guard = k.convert(b.callSymbol(">", [b.field("length", listVarSymbol), b.raw(Std.string(expNames.length))])); + makeSwitchPattern(listVarSymbol); default: [k.forCaseParsing().convert(patternExp)]; } @@ -197,9 +233,40 @@ class Helpers { return switch (caseExp.def) { case CallExp(patternExp, caseBodyExps): + var pattern = makeSwitchPattern(patternExp); + var b = caseExp.expBuilder(); + var body = if (restExpIndex == -1) { + k.convert(b.begin(caseBodyExps)); + } else { + var letBindings = []; + for (idx in 0...restExpIndex) { + letBindings.push(expNames.shift()); + letBindings.push(b.callSymbol("nth", [listVarSymbol, b.raw(Std.string(idx))])); + } + if (restExpName == "") { + restExpName = "_"; + } + letBindings.push(b.symbol(restExpName)); + var sliceArgs = [b.raw(Std.string(restExpIndex))]; + if (expNames.length > 0) { + sliceArgs.push(b.callSymbol("-", [b.field("length", listVarSymbol), b.raw(Std.string(expNames.length))])); + } + letBindings.push(b.call(b.field("slice", listVarSymbol), sliceArgs)); + while (expNames.length > 0) { + var idx = b.callSymbol("-", [b.field("length", listVarSymbol), b.raw(Std.string(expNames.length))]); + letBindings.push(expNames.shift()); + letBindings.push(b.callSymbol("nth", [listVarSymbol, idx])); + } + var letExp = b.callSymbol("let", [b.list(letBindings)].concat(caseBodyExps)); + k.convert(letExp); + }; + // These prints for debugging need to be wrapped in comments because they'll get picked up by convertToHScript() + // Prelude.print('/* $pattern */'); + // Prelude.print('/* $body */'); + // Prelude.print('/* $guard */'); { - values: makeSwitchPattern(patternExp), - expr: k.convert(CallExp(Symbol("begin").withPosOf(caseExp), caseBodyExps).withPosOf(caseExp)), + values: pattern, + expr: body, guard: guard }; default: diff --git a/src/kiss/Reader.hx b/src/kiss/Reader.hx index da7c033..51c3f67 100644 --- a/src/kiss/Reader.hx +++ b/src/kiss/Reader.hx @@ -29,8 +29,10 @@ class Reader { readTable["("] = (stream, k) -> CallExp(assertRead(stream, k), readExpArray(stream, ")", k)); readTable["["] = (stream, k) -> ListExp(readExpArray(stream, "]", k)); + readTable["[::"] = (stream, k) -> ListEatingExp(readExpArray(stream, "]", k)); + readTable["..."] = (stream, k) -> ListRestExp(nextToken(stream, "name for list-eating rest exp", true)); // Provides a nice syntactic sugar for (if... {[then block]} {[else block]}), - // and also handles string interpolation cases like "${}more" + // and also handles string interpolation cases like "${exp}moreString" readTable["{"] = (stream:Stream, k) -> CallExp(Symbol("begin").withPos(stream.position()), readExpArray(stream, "}", k)); readTable['"'] = readString; @@ -133,9 +135,9 @@ class Reader { public static final terminators = [")", "]", "}", '"', "/*", "\n", " "]; - public static function nextToken(stream:Stream, expect:String) { + public static function nextToken(stream:Stream, expect:String, allowEmptyString = false) { switch (stream.takeUntilOneOf(terminators, true)) { - case Some(tok) if (tok.length > 0): + case Some(tok) if (tok.length > 0 || allowEmptyString): return tok; default: stream.error('Expected $expect'); @@ -380,6 +382,17 @@ class Reader { ',${exp.def.toString()}'; case UnquoteList(exp): ',@${exp.def.toString()}'; + case ListEatingExp(exps): + var str = '[::'; + str += [ + for (exp in exps) { + exp.def.toString(); + } + ].join(" "); + str += ']'; + str; + case ListRestExp(name): + '...${name}'; } } } diff --git a/src/kiss/ReaderExp.hx b/src/kiss/ReaderExp.hx index a0dae77..088f459 100644 --- a/src/kiss/ReaderExp.hx +++ b/src/kiss/ReaderExp.hx @@ -20,4 +20,6 @@ enum ReaderExpDef { Quasiquote(exp:ReaderExp); // `[exp] Unquote(exp:ReaderExp); // ,[exp] UnquoteList(exp:ReaderExp); // ,@[exp] + ListEatingExp(exps:Array); // [::exp exp ...exps exp] + ListRestExp(name:String); // ...exps or ... } diff --git a/src/test/cases/BasicTestCase.kiss b/src/test/cases/BasicTestCase.kiss index 3659be8..961269f 100644 --- a/src/test/cases/BasicTestCase.kiss +++ b/src/test/cases/BasicTestCase.kiss @@ -348,6 +348,7 @@ (otherwise (Assert.fail))) (case 5 ((when false (or 5 6)) (Assert.fail)) + ((when true (or 7 8 9)) (Assert.fail)) (otherwise (Assert.pass))) // In Haxe, // `switch (Some(true)) { case Some(true | false): "a"; default: "b"; }` diff --git a/src/test/cases/ListEatingTestCase.hx b/src/test/cases/ListEatingTestCase.hx new file mode 100644 index 0000000..1028260 --- /dev/null +++ b/src/test/cases/ListEatingTestCase.hx @@ -0,0 +1,12 @@ +package test.cases; + +import utest.Assert; +import utest.Test; +import kiss.Prelude; + +@:build(kiss.Kiss.build()) +class ListEatingTestCase extends Test { + function testListEating() { + _testListEating(); + } +} diff --git a/src/test/cases/ListEatingTestCase.kiss b/src/test/cases/ListEatingTestCase.kiss new file mode 100644 index 0000000..4bd4824 --- /dev/null +++ b/src/test/cases/ListEatingTestCase.kiss @@ -0,0 +1,31 @@ +(defun _testListEating [] + // TODO document that list-eating only works on explictly Array-typed variables + (let [:Array l [1 2 3 4]] + (case l + ([::a b ... c d] + (Assert.fail)) + ([a b c d] + (Assert.pass)) + (otherwise + (Assert.fail))) + + (case l + ([::a ...rest] + (Assert.equals 1 a) + (Assert.equals (.toString [2 3 4]) (.toString rest))) + (otherwise + (Assert.fail))) + + (case l + ([::a ...rest b] + (Assert.equals 1 a) + (Assert.equals (.toString [2 3]) (.toString rest)) + (Assert.equals 4 b)) + (otherwise + (Assert.fail))) + (case l + ([::...rest last] + (Assert.equals (.toString [1 2 3]) (.toString rest)) + (Assert.equals 4 last)) + (otherwise + (Assert.fail))))) \ No newline at end of file