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

Perform TCO for AND & OR

This commit is contained in:
Mike Cifelli 2017-11-24 10:07:49 -05:00
parent c4e6de88e1
commit 0fd3a70171
6 changed files with 41 additions and 23 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: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|

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

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

0
lisp/random/big-list.lisp → lisp/util/big-list.lisp
View File

7
lisp/random/list-builder.lisp → lisp/util/list-builder.lisp
View File

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

13
src/function/builtin/special/AND.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.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));
}
}

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

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