Rough implementation of list-eater pattern matching. Close #1

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<Expr> {
             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:

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}';
         }
     }
 }

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<ReaderExp>); // [::exp exp ...exps exp]
+    ListRestExp(name:String); // ...exps or ...
 }

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"; }`

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();
+    }
+}

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<Int> 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)))))