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) (t (cons (funcall function-name the-list)
(maplist function-name (rest the-list)))))) (maplist function-name (rest the-list))))))
(defun append (listA listB) (defun append (list-one list-two)
(cond (append-tail (reverse list-one) list-two))
((null listA) listB)
(t (cons (first listA) (append (rest listA) listB))))) (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) (defun nth (n listA)
(cond (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() { private void verifyValidRecurCall() {
if (executionContext.isRecurInitializing())
throw new NestedRecurException();
if (!executionContext.isInFunctionCall()) if (!executionContext.isInFunctionCall())
throw new RecurOutsideOfFunctionException(); throw new RecurOutsideOfFunctionException();
if (executionContext.isRecurInitializing())
throw new NestedRecurException();
} }
private Cons getRecurArguments(Cons argumentList) { private Cons getRecurArguments(Cons argumentList) {

View File

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