From 2febfc7846783857625f4db1bf7a74e303721f80 Mon Sep 17 00:00:00 2001
From: Nat Quayle Nelson <natquaylenelson@gmail.com>
Date: Sun, 14 Nov 2021 13:54:32 -0700
Subject: [PATCH] countingLambda

---
 kiss/src/kiss/Macros.hx                | 19 +++++++++++++++++++
 kiss/src/kiss/Reader.hx                | 24 ++++++++++++++++++++----
 kiss/src/kiss/SpecialForms.hx          |  2 +-
 kiss/src/test/cases/BasicTestCase.hx   |  4 ++++
 kiss/src/test/cases/BasicTestCase.kiss | 12 +++++++++++-
 5 files changed, 55 insertions(+), 6 deletions(-)

diff --git a/kiss/src/kiss/Macros.hx b/kiss/src/kiss/Macros.hx
index c2d3b2dd..5a887423 100644
--- a/kiss/src/kiss/Macros.hx
+++ b/kiss/src/kiss/Macros.hx
@@ -1039,6 +1039,25 @@ class Macros {
                 ]));
         };
 
+        macros["countingLambda"] = (wholeExp:ReaderExp, exps:Array<ReaderExp>, k:KissState) -> {
+            wholeExp.checkNumArgs(3, null, "(countingLambda <countVar> [<argsNames...>] <body...>)");
+            var b = wholeExp.expBuilder();
+
+            var countVarSymbol = exps[0];
+            var args = exps[1];
+            var body = exps.slice(2);
+
+            return b.let([
+                b.meta("mut", countVarSymbol), b.int(0)
+            ], [b.callSymbol("lambda", [
+                args,
+                b.callSymbol("+=", [
+                    countVarSymbol,
+                    b.int(1)
+                ])
+            ].concat(body))]);
+        };
+
         return macros;
     }
 
diff --git a/kiss/src/kiss/Reader.hx b/kiss/src/kiss/Reader.hx
index d27feb01..eb277eb0 100644
--- a/kiss/src/kiss/Reader.hx
+++ b/kiss/src/kiss/Reader.hx
@@ -96,8 +96,17 @@ class Reader {
         //     ->[args] body
         //     ->arg body
         //     ->{body}
-        // or any of those with the first expression after -> prefixed by :Void
-        readTable["->"] = (stream:Stream, k) -> {
+        // OR, for countingLambda:
+        //     -+>countVar [args] body
+        //     -+>countVar arg body
+        //     -+>countVar {body}
+        // or any of those with the first expression after -> or -+> prefixed by :Void
+        function arrowSyntax(countingLambda:Bool, stream:Stream, k:KissState) {
+            var countVar = if (countingLambda) {
+                assertRead(stream, k);
+            } else {
+                null;
+            }
             var firstExp = assertRead(stream, k);
             var b = firstExp.expBuilder();
 
@@ -127,8 +136,15 @@ class Reader {
             if (!returnsValue) {
                 argsExp = TypedExp("Void", argsExp).withPosOf(argsExp);
             }
-            CallExp(b.symbol("lambda"), [argsExp, bodyExp]);
-        };
+            return if (countingLambda) {
+                CallExp(b.symbol("countingLambda"), [countVar, argsExp, bodyExp]);
+            } else {
+                CallExp(b.symbol("lambda"), [argsExp, bodyExp]);
+            };
+        }
+
+        readTable["->"] = arrowSyntax.bind(false);
+        readTable["-+>"] = arrowSyntax.bind(true);
 
         // Because macro keys are sorted by length and peekChars(0) returns "", this will be used as the default reader macro:
         readTable[""] = (stream:Stream, k:KissState) -> {
diff --git a/kiss/src/kiss/SpecialForms.hx b/kiss/src/kiss/SpecialForms.hx
index 200581c8..ca0c55db 100644
--- a/kiss/src/kiss/SpecialForms.hx
+++ b/kiss/src/kiss/SpecialForms.hx
@@ -204,7 +204,7 @@ class SpecialForms {
         };
 
         map["lambda"] = (wholeExp:ReaderExp, args:Array<ReaderExp>, k:KissState) -> {
-            wholeExp.checkNumArgs(2, null, "(lambda [[argsNames...]] [body...])");
+            wholeExp.checkNumArgs(2, null, "(lambda [<argsNames...>] <body...>)");
             var returnsValue = switch (args[0].def) {
                 case TypedExp("Void", argNames):
                     args[0] = argNames;
diff --git a/kiss/src/test/cases/BasicTestCase.hx b/kiss/src/test/cases/BasicTestCase.hx
index 462defb9..74e902ff 100644
--- a/kiss/src/test/cases/BasicTestCase.hx
+++ b/kiss/src/test/cases/BasicTestCase.hx
@@ -317,6 +317,10 @@ class BasicTestCase extends Test {
     function testClamp() {
         _testClamp();
     }
+
+    function testCountingLambda() {
+        _testCountingLambda();
+    }
 }
 
 class BasicObject {
diff --git a/kiss/src/test/cases/BasicTestCase.kiss b/kiss/src/test/cases/BasicTestCase.kiss
index 946e0572..56e42fcf 100644
--- a/kiss/src/test/cases/BasicTestCase.kiss
+++ b/kiss/src/test/cases/BasicTestCase.kiss
@@ -560,4 +560,14 @@
         (Assert.equals 10 (clamp bigValue 5 10))
         (Assert.equals 10 bigValue)
         (Assert.equals 5 (clamp smallValue 5 10))
-        (Assert.equals 5 smallValue)))
\ No newline at end of file
+        (Assert.equals 5 smallValue)))
+
+(function _testCountingLambda []
+    (let [fullSyntax
+                (countingLambda a [] a)
+            arrowSyntax
+                -+>b {b}]
+        (Assert.equals 1 (fullSyntax))
+        (Assert.equals 2 (fullSyntax))
+        (Assert.equals 1 (arrowSyntax))
+        (Assert.equals 2 (arrowSyntax))))
\ No newline at end of file