Complete tail call optimization

Resolves #2 and #3

fitnesse/FitNesseRoot/RecentChanges.wiki

@@ -1,4 +1,4 @@
-|TranscendentalLisp.Recursion||10:05:46 Fri, Nov 24, 2017|
+|TranscendentalLisp.Recursion||10:47:57 Fri, Nov 24, 2017|
 |TranscendentalLisp||16:15:14 Fri, Mar 17, 2017|
 |TranscendentalLisp.Macros||10:10:15 Mon, Mar 13, 2017|
 |TranscendentalLisp.MacroTests||10:07:00 Mon, Mar 13, 2017|

fitnesse/FitNesseRoot/TranscendentalLisp/Recursion.wiki

@@ -21,3 +21,8 @@ Test recursion capabilities of various functions.
 | check | evaluate text | (eval `(defun big-defun ,(list-of 'x 10000) ,big-list))        | BIG-DEFUN  |
 | check | evaluate text | (eval `(define-special special ,(list-of 'x 10000) ,big-list)) | SPECIAL    |
 | check | evaluate text | (eval `(defmacro big-macro ,(list-of 'x 10000) ,big-list))     | BIG-MACRO  |
+| check | evaluate text | (eval `(lambda ,(list-of 'x 10000) ,big-list))                 | =~/1\)\)$/ |
+| check | evaluate text | (apply 'progn big-list)                                        | 1          |
+| check | evaluate text | (eval (append `(let ,(list-of '(x 20) 10000)) big-list))       | 1          |
+| check | evaluate text | (apply 'cond (list-of '((= 1 2) 1) 10000))                     | NIL        |
+| check | evaluate text | (eval (append '(case :a) (list-of '((:b :c :d) 1) 10000)))             | NIL        |

src/function/builtin/special/CASE.java

@@ -2,12 +2,15 @@ package function.builtin.special;
 
 import static function.builtin.EVAL.eval;
 import static function.builtin.predicate.EQUAL.isEqual;
+import static recursion.TailCalls.done;
+import static recursion.TailCalls.tailCall;
 import static sexpression.Nil.NIL;
 import static sexpression.Symbol.T;
 
 import function.ArgumentValidator;
 import function.FunctionNames;
 import function.LispSpecialFunction;
+import recursion.TailCall;
 import sexpression.Cons;
 import sexpression.Nil;
 import sexpression.SExpression;
@@ -29,21 +32,21 @@ public class CASE extends LispSpecialFunction {
         argumentValidator.validate(argumentList);
         SExpression key = eval(argumentList.getFirst());
 
-        return callTailRecursive(key, (Cons) argumentList.getRest());
+        return callTailRecursive(key, (Cons) argumentList.getRest()).invoke();
     }
 
-    private SExpression callTailRecursive(SExpression key, Cons argumentList) {
+    private TailCall<SExpression> callTailRecursive(SExpression key, Cons argumentList) {
         if (argumentList.isNull())
-            return NIL;
+            return done(NIL);
 
         Cons clause = (Cons) argumentList.getFirst();
         Cons remainingClauses = (Cons) argumentList.getRest();
         SExpression keyList = clause.getFirst();
 
         if (isMatch(key, keyList))
-            return evaluateConsequents(clause.getRest());
+            return done(evaluateConsequents(clause.getRest()));
 
-        return callTailRecursive(key, remainingClauses);
+        return tailCall(() -> callTailRecursive(key, remainingClauses));
     }
 
     private boolean isMatch(SExpression key, SExpression keyList) {

src/function/builtin/special/COND.java

@@ -1,11 +1,14 @@
 package function.builtin.special;
 
 import static function.builtin.EVAL.eval;
+import static recursion.TailCalls.done;
+import static recursion.TailCalls.tailCall;
 import static sexpression.Nil.NIL;
 
 import function.ArgumentValidator;
 import function.FunctionNames;
 import function.LispSpecialFunction;
+import recursion.TailCall;
 import sexpression.Cons;
 import sexpression.Nil;
 import sexpression.SExpression;
@@ -25,21 +28,21 @@ public class COND extends LispSpecialFunction {
     public SExpression call(Cons argumentList) {
         argumentValidator.validate(argumentList);
 
-        return callTailRecursive(argumentList);
+        return callTailRecursive(argumentList).invoke();
     }
 
-    private SExpression callTailRecursive(Cons argumentList) {
+    private TailCall<SExpression> callTailRecursive(Cons argumentList) {
         if (argumentList.isNull())
-            return NIL;
+            return done(NIL);
 
         Cons clause = (Cons) argumentList.getFirst();
         Cons remainingClauses = (Cons) argumentList.getRest();
         SExpression test = eval(clause.getFirst());
 
         if (isTestSuccessful(test))
-            return evaluateConsequents(clause.getRest(), test);
+            return done(evaluateConsequents(clause.getRest(), test));
 
-        return callTailRecursive(remainingClauses);
+        return tailCall(() -> callTailRecursive(remainingClauses));
     }
 
     private boolean isTestSuccessful(SExpression test) {

src/function/builtin/special/PROGN.java

@@ -1,11 +1,14 @@
 package function.builtin.special;
 
 import static function.builtin.EVAL.eval;
+import static recursion.TailCalls.done;
+import static recursion.TailCalls.tailCall;
 import static sexpression.Nil.NIL;
 
 import function.ArgumentValidator;
 import function.FunctionNames;
 import function.LispSpecialFunction;
+import recursion.TailCall;
 import sexpression.Cons;
 import sexpression.SExpression;
 
@@ -22,17 +25,17 @@ public class PROGN extends LispSpecialFunction {
     public SExpression call(Cons argumentList) {
         argumentValidator.validate(argumentList);
 
-        return callTailRecursive(argumentList, NIL);
+        return callTailRecursive(argumentList, NIL).invoke();
     }
 
-    private SExpression callTailRecursive(Cons argumentList, SExpression lastValue) {
+    private TailCall<SExpression> callTailRecursive(Cons argumentList, SExpression lastValue) {
         if (argumentList.isNull())
-            return lastValue;
+            return done(lastValue);
 
         SExpression currentValue = eval(argumentList.getFirst());
         Cons remainingValues = (Cons) argumentList.getRest();
 
-        return callTailRecursive(remainingValues, currentValue);
+        return tailCall(() -> callTailRecursive(remainingValues, currentValue));
     }
 
 }