Allow for tail calls in recurse argument list

This commit is contained in:
Mike Cifelli 2017-11-18 14:54:53 -05:00
parent eb80afb21d
commit 62b2653b2c
6 changed files with 74 additions and 38 deletions

View File

@ -10,10 +10,28 @@
(t (cons (funcall function-name the-list)
(maplist function-name (rest the-list))))))
(defun append (listA listB)
(cond
((null listA) listB)
(t (cons (first listA) (append (rest listA) listB)))))
(defun append (list-one list-two)
(append-tail (reverse list-one) list-two))
(defun append-tail (reversed-list list-two)
(if (null reversed-list) list-two
(recur (rest reversed-list) (cons (car reversed-list) list-two))))
(defun reverse (the-list)
(reverse-tail () the-list))
(defun reverse-tail (accumulator the-list)
(if (null the-list) accumulator
(recur (cons (first the-list) accumulator) (rest the-list))))
(defun deep-reverse (the-list)
(if the-list
(append
(deep-reverse (rest the-list))
(list
(if (listp (first the-list))
(deep-reverse (first the-list))
(first the-list))))))
(defun nth (n listA)
(cond

View File

@ -1,16 +0,0 @@
(load "functions.lisp")
(defun reverse (the-list)
(if the-list
(append
(reverse (rest the-list))
(list (first the-list)))))
(defun deep-reverse (the-list)
(if the-list
(append
(deep-reverse (rest the-list))
(list
(if (listp (first the-list))
(deep-reverse (first the-list))
(first the-list))))))

View File

@ -0,0 +1,5 @@
(load "../lang/functions.lisp")
(defun list-doubler (seed times-to-double)
(if (< times-to-double 1) seed
(recur (append seed seed) (- times-to-double 1))))

View File

@ -32,11 +32,11 @@ public class RECUR extends LispSpecialFunction {
}
private void verifyValidRecurCall() {
if (executionContext.isRecurInitializing())
throw new NestedRecurException();
if (!executionContext.isInFunctionCall())
throw new RecurOutsideOfFunctionException();
if (executionContext.isRecurInitializing())
throw new NestedRecurException();
}
private Cons getRecurArguments(Cons argumentList) {

View File

@ -14,15 +14,17 @@ public class ExecutionContext {
}
private SymbolTable scope;
private Stack<LispFunction> functionCalls;
private boolean recurInitializing;
private Stack<LispFunctionRecurInfo> functionCalls;
private boolean recur;
private ExecutionContext() {
clearContext();
}
public void clearContext() {
this.scope = new SymbolTable();
this.functionCalls = new Stack<>();
this.clearRecur();
this.clearRecurInitializing();
}
public SymbolTable getScope() {
@ -38,13 +40,6 @@ public class ExecutionContext {
scope = scope.getParent();
}
public void clearContext() {
this.scope = new SymbolTable();
this.functionCalls = new Stack<>();
this.clearRecur();
this.clearRecurInitializing();
}
public SExpression lookupSymbolValue(String symbolName) {
for (SymbolTable t = scope; t != null; t = t.getParent())
if (t.contains(symbolName))
@ -54,7 +49,7 @@ public class ExecutionContext {
}
public void pushFunctionCall(LispFunction function) {
functionCalls.push(function);
functionCalls.push(new LispFunctionRecurInfo(function));
}
public void popFunctionCall() {
@ -66,7 +61,7 @@ public class ExecutionContext {
}
public LispFunction getCurrentFunction() {
return functionCalls.peek();
return functionCalls.peek().getLispFunction();
}
public boolean isRecur() {
@ -82,14 +77,41 @@ public class ExecutionContext {
}
public boolean isRecurInitializing() {
return recurInitializing;
return functionCalls.peek().isRecurInitializing();
}
public void setRecurInitializing() {
recurInitializing = true;
functionCalls.peek().setRecurInitializing();
}
public void clearRecurInitializing() {
recurInitializing = false;
functionCalls.peek().clearRecurInitializing();
}
public static class LispFunctionRecurInfo {
private LispFunction lispFunction;
private boolean recurInitializing;
public LispFunctionRecurInfo(LispFunction lispFunction) {
this.lispFunction = lispFunction;
this.clearRecurInitializing();
}
public boolean isRecurInitializing() {
return recurInitializing;
}
public void setRecurInitializing() {
this.recurInitializing = true;
}
public void clearRecurInitializing() {
this.recurInitializing = false;
}
public LispFunction getLispFunction() {
return lispFunction;
}
}
}

View File

@ -166,6 +166,13 @@ public class RECURTest extends SymbolAndFunctionCleaner {
assertSExpressionsMatch(parseString("PASS"), evaluateString("(nested-tail)"));
}
@Test
public void recurWithNestedTailRecursiveFunction() {
evaluateString("(defun one (n) (if (= n 0) 0 (recur (- n 1))))");
evaluateString("(defun two (n) (if (= n 0) 'PASS (recur (one n))))");
assertSExpressionsMatch(parseString("PASS"), evaluateString("(two 20)"));
}
@Test
public void nestedRecurException_HasCorrectAttributes() {
assertIsErrorWithMessage(new NestedRecurException());