From 62b2653b2c7bb7b3a71f43a9f2472d972ef0bdfe Mon Sep 17 00:00:00 2001 From: Mike Cifelli Date: Sat, 18 Nov 2017 14:54:53 -0500 Subject: [PATCH] Allow for tail calls in recurse argument list --- lisp/lang/functions.lisp | 26 ++++++++-- lisp/lang/reverse.lisp | 16 ------ lisp/random/list-builder.lisp | 5 ++ src/function/builtin/special/RECUR.java | 6 +-- src/table/ExecutionContext.java | 52 ++++++++++++++------ test/function/builtin/special/RECURTest.java | 7 +++ 6 files changed, 74 insertions(+), 38 deletions(-) delete mode 100644 lisp/lang/reverse.lisp create mode 100644 lisp/random/list-builder.lisp diff --git a/lisp/lang/functions.lisp b/lisp/lang/functions.lisp index 0119aaf..d00dffc 100644 --- a/lisp/lang/functions.lisp +++ b/lisp/lang/functions.lisp @@ -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 diff --git a/lisp/lang/reverse.lisp b/lisp/lang/reverse.lisp deleted file mode 100644 index 917555c..0000000 --- a/lisp/lang/reverse.lisp +++ /dev/null @@ -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)))))) diff --git a/lisp/random/list-builder.lisp b/lisp/random/list-builder.lisp new file mode 100644 index 0000000..b831bb5 --- /dev/null +++ b/lisp/random/list-builder.lisp @@ -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)))) diff --git a/src/function/builtin/special/RECUR.java b/src/function/builtin/special/RECUR.java index 551e840..4d025f0 100644 --- a/src/function/builtin/special/RECUR.java +++ b/src/function/builtin/special/RECUR.java @@ -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) { diff --git a/src/table/ExecutionContext.java b/src/table/ExecutionContext.java index c39961b..f23bf1f 100644 --- a/src/table/ExecutionContext.java +++ b/src/table/ExecutionContext.java @@ -14,15 +14,17 @@ public class ExecutionContext { } private SymbolTable scope; - private Stack functionCalls; - private boolean recurInitializing; + private Stack 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; + } } } diff --git a/test/function/builtin/special/RECURTest.java b/test/function/builtin/special/RECURTest.java index 4cd6280..e4ed2e1 100644 --- a/test/function/builtin/special/RECURTest.java +++ b/test/function/builtin/special/RECURTest.java @@ -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());