mike
/
transcendental-lisp
1
1
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

Complete tail call optimization 

Resolves #2 and #3
This commit is contained in:
Mike Cifelli 2017-11-24 10:56:02 -05:00
parent 0fd3a70171
commit 5b9fdd5618
5 changed files with 44 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
fitnesse/FitNesseRoot/RecentChanges.wiki
View File

@ -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||16:15:14 Fri, Mar 17, 2017|
|TranscendentalLisp.Macros||10:10:15 Mon, Mar 13, 2017| |TranscendentalLisp.Macros||10:10:15 Mon, Mar 13, 2017|
|TranscendentalLisp.MacroTests||10:07:00 Mon, Mar 13, 2017| |TranscendentalLisp.MacroTests||10:07:00 Mon, Mar 13, 2017|

35
fitnesse/FitNesseRoot/TranscendentalLisp/Recursion.wiki
View File

@ -6,18 +6,23 @@ Test recursion capabilities of various functions.
| script | lisp interpreter fixture | | script | lisp interpreter fixture |
| show | evaluate text | (load "lisp/util/big-list.lisp") | | show | evaluate text | (load "lisp/util/big-list.lisp") |
| show | evaluate text | (load "lisp/util/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 'and big-list) | 1 |
| check | evaluate text | (apply 'or (list-of nil 10000)) | NIL | | 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 `(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 `(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 `(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 |

13
src/function/builtin/special/CASE.java
View File

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

13
src/function/builtin/special/COND.java
View File

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

11
src/function/builtin/special/PROGN.java
View File

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