From 5b9fdd5618c361ffd3e3886738166b135750ba3e Mon Sep 17 00:00:00 2001 From: Mike Cifelli Date: Fri, 24 Nov 2017 10:56:02 -0500 Subject: [PATCH] Complete tail call optimization Resolves #2 and #3 --- fitnesse/FitNesseRoot/RecentChanges.wiki | 2 +- .../TranscendentalLisp/Recursion.wiki | 35 +++++++++++-------- src/function/builtin/special/CASE.java | 13 ++++--- src/function/builtin/special/COND.java | 13 ++++--- src/function/builtin/special/PROGN.java | 11 +++--- 5 files changed, 44 insertions(+), 30 deletions(-) diff --git a/fitnesse/FitNesseRoot/RecentChanges.wiki b/fitnesse/FitNesseRoot/RecentChanges.wiki index fbd457b..56d131a 100644 --- a/fitnesse/FitNesseRoot/RecentChanges.wiki +++ b/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| diff --git a/fitnesse/FitNesseRoot/TranscendentalLisp/Recursion.wiki b/fitnesse/FitNesseRoot/TranscendentalLisp/Recursion.wiki index c7a7917..363377e 100644 --- a/fitnesse/FitNesseRoot/TranscendentalLisp/Recursion.wiki +++ b/fitnesse/FitNesseRoot/TranscendentalLisp/Recursion.wiki @@ -6,18 +6,23 @@ Test recursion capabilities of various functions. | 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 | +| 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 | +| 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 | diff --git a/src/function/builtin/special/CASE.java b/src/function/builtin/special/CASE.java index 5828d36..e839f33 100644 --- a/src/function/builtin/special/CASE.java +++ b/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 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) { diff --git a/src/function/builtin/special/COND.java b/src/function/builtin/special/COND.java index 99ae885..8875b91 100644 --- a/src/function/builtin/special/COND.java +++ b/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 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) { diff --git a/src/function/builtin/special/PROGN.java b/src/function/builtin/special/PROGN.java index 4759e27..be97589 100644 --- a/src/function/builtin/special/PROGN.java +++ b/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 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)); } }