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.Macros||10:10:15 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 |
| 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 |

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.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) {

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

@ -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) {

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

@ -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));
}
}