diff --git a/fitnesse/FitNesseRoot/RecentChanges.wiki b/fitnesse/FitNesseRoot/RecentChanges.wiki index b933b35..fbd457b 100644 --- a/fitnesse/FitNesseRoot/RecentChanges.wiki +++ b/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| diff --git a/fitnesse/FitNesseRoot/TranscendentalLisp/Recursion.wiki b/fitnesse/FitNesseRoot/TranscendentalLisp/Recursion.wiki index ea73907..c7a7917 100644 --- a/fitnesse/FitNesseRoot/TranscendentalLisp/Recursion.wiki +++ b/fitnesse/FitNesseRoot/TranscendentalLisp/Recursion.wiki @@ -3,16 +3,21 @@ Test --- Test recursion capabilities of various functions. -| script | lisp interpreter fixture | -| show | evaluate text | (load "lisp/random/big-list.lisp") | -| show | evaluate text | (load "lisp/random/list-builder.lisp") | -| check | evaluate text | big-list | =~/1\)$/ | -| check | evaluate text | (length 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) | 16384 | -| check | evaluate text | (apply '- big-list) | -16382 | -| check | evaluate text | (apply '= big-list) | T | -| check | evaluate text | (apply '> (decreasing-list 0 10000)) | T | -| check | evaluate text | (apply '< (increasing-list 10000 10000)) | T | \ No newline at end of file +| script | lisp interpreter fixture | +| show | evaluate text | (load "lisp/util/big-list.lisp") | +| show | evaluate text | (load "lisp/util/list-builder.lisp") | +| check | evaluate text | big-list | =~/1\)$/ | +| check | evaluate text | (length 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) | 16384 | +| check | evaluate text | (apply '- big-list) | -16382 | +| check | evaluate text | (apply '= big-list) | T | +| check | evaluate text | (apply '> (decreasing-list 0 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 | diff --git a/lisp/random/big-list.lisp b/lisp/util/big-list.lisp similarity index 100% rename from lisp/random/big-list.lisp rename to lisp/util/big-list.lisp diff --git a/lisp/random/list-builder.lisp b/lisp/util/list-builder.lisp similarity index 78% rename from lisp/random/list-builder.lisp rename to lisp/util/list-builder.lisp index dd2b479..b0501be 100644 --- a/lisp/random/list-builder.lisp +++ b/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)))) diff --git a/src/function/builtin/special/AND.java b/src/function/builtin/special/AND.java index bccbec5..aa18d0c 100644 --- a/src/function/builtin/special/AND.java +++ b/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 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)); } } diff --git a/src/function/builtin/special/OR.java b/src/function/builtin/special/OR.java index 400fb80..43ec14e 100644 --- a/src/function/builtin/special/OR.java +++ b/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 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)); } }