Perform TCO for AND & OR

fitnesse/FitNesseRoot/RecentChanges.wiki

@@ -1,4 +1,4 @@
-|TranscendentalLisp.Recursion||10:47:58 Sun, Nov 19, 2017|
+|TranscendentalLisp.Recursion||10:05:46 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

@@ -3,16 +3,21 @@ Test
 ---
 Test recursion capabilities of various functions.
 
-| script                | lisp interpreter fixture                              |
+| script                | lisp interpreter fixture                                       |
-| show  | evaluate text | (load "lisp/random/big-list.lisp")                    |
+| show  | evaluate text | (load "lisp/util/big-list.lisp")                               |
-| show  | evaluate text | (load "lisp/random/list-builder.lisp")                |
+| show  | evaluate text | (load "lisp/util/list-builder.lisp")                           |
-| check | evaluate text | big-list                                              | =~/1\)$/ |
+| check | evaluate text | big-list                                                       | =~/1\)$/  |
-| check | evaluate text | (length big-list)                                     | 16384    |
+| check | evaluate text | (length big-list)                                              | 16384     |
-| check | evaluate text | (length (apply 'list big-list))                       | 16384    |
+| check | evaluate text | (length (apply 'list big-list))                                | 16384     |
-| check | evaluate text | (apply '/ big-list)                                   | 1        |
+| check | evaluate text | (apply '/ big-list)                                            | 1         |
-| check | evaluate text | (apply '* big-list)                                   | 1        |
+| check | evaluate text | (apply '* big-list)                                            | 1         |
-| check | evaluate text | (apply '+ big-list)                                   | 16384    |
+| check | evaluate text | (apply '+ big-list)                                            | 16384     |
-| check | evaluate text | (apply '- big-list)                                   | -16382   |
+| check | evaluate text | (apply '- big-list)                                            | -16382    |
-| check | evaluate text | (apply '= big-list)                                   | T        |
+| check | evaluate text | (apply '= big-list)                                            | T         |
-| check | evaluate text | (apply '> (decreasing-list 0 10000))                  | T        |
+| check | evaluate text | (apply '> (decreasing-list 0 10000))                           | T         |
-| check | evaluate text | (apply '< (increasing-list 10000 10000))              | T        |
+| check | evaluate text | (apply '< (increasing-list 10000 10000))                       | T         |
+| check | evaluate text | (apply 'and big-list)                                          | 1         |
+| check | evaluate text | (apply 'or (list-of nil 10000))                                | NIL       |
+| 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 |

lisp/util/list-builder.lisp

@@ -17,3 +17,10 @@
 (defun increasing-list-tail (seed end size)
   (if (< size 1) seed
     (recur (cons (- (car seed) 1) seed) (- end 1) (- size 1))))
+
+(defun list-of (item size)
+  (list-of-tail nil item size))
+
+(defun list-of-tail (seed item size)
+  (if (< size 1) seed
+    (recur (cons item seed) item (- size 1))))

src/function/builtin/special/AND.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.Symbol.T;
 
 import function.ArgumentValidator;
 import function.FunctionNames;
 import function.LispSpecialFunction;
+import recursion.TailCall;
 import sexpression.Cons;
 import sexpression.SExpression;
 
@@ -22,20 +25,20 @@ public class AND extends LispSpecialFunction {
     public SExpression call(Cons argumentList) {
         argumentValidator.validate(argumentList);
 
-        return callTailRecursive(argumentList, T);
+        return callTailRecursive(argumentList, T).invoke();
     }
 
-    private SExpression callTailRecursive(Cons argumentList, SExpression lastValue) {
+    private TailCall<SExpression> callTailRecursive(Cons argumentList, SExpression lastValue) {
         SExpression currentValue = eval(argumentList.getFirst());
         Cons remainingValues = (Cons) argumentList.getRest();
 
         if (argumentList.isNull())
-            return lastValue;
+            return done(lastValue);
 
         if (currentValue.isNull())
-            return currentValue;
+            return done(currentValue);
 
-        return callTailRecursive(remainingValues, currentValue);
+        return tailCall(() -> callTailRecursive(remainingValues, currentValue));
     }
 
 }

src/function/builtin/special/OR.java

@@ -1,10 +1,13 @@
 package function.builtin.special;
 
 import static function.builtin.EVAL.eval;
+import static recursion.TailCalls.done;
+import static recursion.TailCalls.tailCall;
 
 import function.ArgumentValidator;
 import function.FunctionNames;
 import function.LispSpecialFunction;
+import recursion.TailCall;
 import sexpression.Cons;
 import sexpression.SExpression;
 
@@ -21,17 +24,17 @@ public class OR 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) {
         SExpression currentValue = eval(argumentList.getFirst());
         Cons remainingValues = (Cons) argumentList.getRest();
 
         if (remainingValues.isNull() || !currentValue.isNull())
-            return currentValue;
+            return done(currentValue);
 
-        return callTailRecursive(remainingValues);
+        return tailCall(() -> callTailRecursive(remainingValues));
     }
 
 }