Allow for tail calls in recurse argument list
This commit is contained in:
		
							parent
							
								
									eb80afb21d
								
							
						
					
					
						commit
						62b2653b2c
					
				| @ -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 | ||||||
|  | |||||||
| @ -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)))))) |  | ||||||
							
								
								
									
										5
									
								
								lisp/random/list-builder.lisp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								lisp/random/list-builder.lisp
									
									
									
									
									
										Normal 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)))) | ||||||
| @ -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) { | ||||||
|  | |||||||
| @ -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; | ||||||
|  |         } | ||||||
|     } |     } | ||||||
| } | } | ||||||
|  | |||||||
| @ -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()); | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user