From e0e726d6c0a66802d9b1449996cf526636765b95 Mon Sep 17 00:00:00 2001 From: Mike Cifelli Date: Sat, 18 Nov 2017 10:21:57 -0500 Subject: [PATCH] Fix apply for macros --- src/function/builtin/APPLY.java | 3 ++- src/function/builtin/EVAL.java | 8 +++++++ test/function/builtin/APPLYTest.java | 5 +++++ test/function/builtin/EVALTest.java | 16 ++++++++++++++ .../builtin/special/DEFMACROTest.java | 6 ++++++ test/function/builtin/special/RECURTest.java | 6 ++++++ test/table/ExecutionContextTest.java | 21 +++++++++---------- 7 files changed, 53 insertions(+), 12 deletions(-) diff --git a/src/function/builtin/APPLY.java b/src/function/builtin/APPLY.java index 809e1aa..62c6a00 100644 --- a/src/function/builtin/APPLY.java +++ b/src/function/builtin/APPLY.java @@ -1,5 +1,6 @@ package function.builtin; +import static function.builtin.EVAL.applyFunction; import static function.builtin.EVAL.lookupFunctionOrLambda; import static table.FunctionTable.lookupFunction; @@ -33,7 +34,7 @@ public class APPLY extends LispFunction { SExpression functionName = argumentList.getFirst(); LispFunction function = lookupFunctionOrLambda(functionName); - return function.call(functionArguments); + return applyFunction(function, functionArguments); } } diff --git a/src/function/builtin/EVAL.java b/src/function/builtin/EVAL.java index 5530956..559dcce 100644 --- a/src/function/builtin/EVAL.java +++ b/src/function/builtin/EVAL.java @@ -36,6 +36,10 @@ public class EVAL extends LispFunction { } } + public static SExpression applyFunction(LispFunction function, Cons argumentList) { + return ((EVAL) lookupFunction("EVAL")).applyFunctionWithoutEvaluatingArguments(function, argumentList); + } + public static Cons evalRecurArgumentList(Cons argumentList) { return ((EVAL) lookupFunction("EVAL")).evaluateArgumentList(argumentList); } @@ -132,6 +136,10 @@ public class EVAL extends LispFunction { if (function.isArgumentListEvaluated()) argumentList = evaluateArgumentList(argumentList); + return applyFunctionWithoutEvaluatingArguments(function, argumentList); + } + + private SExpression applyFunctionWithoutEvaluatingArguments(LispFunction function, Cons argumentList) { verifyNotRecurring(); SExpression result = function.call(argumentList); diff --git a/test/function/builtin/APPLYTest.java b/test/function/builtin/APPLYTest.java index ee75ca3..b3e5746 100644 --- a/test/function/builtin/APPLYTest.java +++ b/test/function/builtin/APPLYTest.java @@ -71,4 +71,9 @@ public class APPLYTest extends SymbolAndFunctionCleaner { evaluateString("(apply 'apply (cons 'T 'T))"); } + @Test + public void applyWithMacro() { + evaluateString("(defmacro m (x) `(+ 2 ,x))"); + assertSExpressionsMatch(parseString("27"), evaluateString("(apply 'm '(25))")); + } } diff --git a/test/function/builtin/EVALTest.java b/test/function/builtin/EVALTest.java index 66bb304..be83f06 100644 --- a/test/function/builtin/EVALTest.java +++ b/test/function/builtin/EVALTest.java @@ -183,6 +183,7 @@ public class EVALTest extends SymbolAndFunctionCleaner { @Test public void scopeRestoredAfterFailure_Let() { evaluateString("(setq n 100)"); + try { evaluateString("(let ((n 200)) (begin 1 2 3 y))"); fail("expected exception"); @@ -194,6 +195,7 @@ public class EVALTest extends SymbolAndFunctionCleaner { @Test public void scopeRestoredAfterFailure_Defun() { evaluateString("(setq n 100)"); + try { evaluateString("(defun test (n) (begin 1 2 3 y))"); evaluateString("(test 200)"); @@ -206,6 +208,7 @@ public class EVALTest extends SymbolAndFunctionCleaner { @Test public void scopeRestoredAfterFailure_Lambda() { evaluateString("(setq n 100)"); + try { evaluateString("((lambda (n) (begin 1 2 3 y)) 200)"); fail("expected exception"); @@ -217,6 +220,7 @@ public class EVALTest extends SymbolAndFunctionCleaner { @Test public void scopeRestoredAfterFailure_Recur() { evaluateString("(setq n 100)"); + try { evaluateString("(defun tail-recursive (n) (begin (recur) 2))"); evaluateString("(tail-recursive 200)"); @@ -226,4 +230,16 @@ public class EVALTest extends SymbolAndFunctionCleaner { assertSExpressionsMatch(parseString("100"), evaluateString("n")); } + @Test + public void scopeRestoredAfterFailure_Apply() { + evaluateString("(setq n 100)"); + + try { + evaluateString("(defun tail-recursive (n) (begin (recur) 2))"); + evaluateString("(apply 'tail-recursive '(200))"); + fail("expected exception"); + } catch (RecurNotInTailPositionException e) {} + + assertSExpressionsMatch(parseString("100"), evaluateString("n")); + } } diff --git a/test/function/builtin/special/DEFMACROTest.java b/test/function/builtin/special/DEFMACROTest.java index 13a7a8e..b59eeba 100644 --- a/test/function/builtin/special/DEFMACROTest.java +++ b/test/function/builtin/special/DEFMACROTest.java @@ -182,4 +182,10 @@ public class DEFMACROTest extends SymbolAndFunctionCleaner { assertSExpressionsMatch(parseString("sprouts"), evaluateString("x")); } + @Test + public void macroIsEvaluatedCorrectly() { + evaluateString("(defmacro m (x) `'(+ 2 ,x))"); + assertSExpressionsMatch(parseString("(+ 2 25)"), evaluateString("(m 25)")); + } + } diff --git a/test/function/builtin/special/RECURTest.java b/test/function/builtin/special/RECURTest.java index 0a910fe..8fc1e22 100644 --- a/test/function/builtin/special/RECURTest.java +++ b/test/function/builtin/special/RECURTest.java @@ -65,6 +65,12 @@ public class RECURTest extends SymbolAndFunctionCleaner { evaluateString("(tail-recursive 900)"); } + @Test(expected = RecurNotInTailPositionException.class) + public void recurInNonTailPositionInApply() { + evaluateString("(defun tail-recursive (n) (if (= n 0) 'PASS (apply 'list (recur (- n 1)))))"); + evaluateString("(tail-recursive 900)"); + } + @Test public void recurCallsCurrentFunction() { evaluateString("(defun tail-recursive (n) (if (= n 0) 'PASS (recur (- n 1))))"); diff --git a/test/table/ExecutionContextTest.java b/test/table/ExecutionContextTest.java index a003e83..9dacbfc 100644 --- a/test/table/ExecutionContextTest.java +++ b/test/table/ExecutionContextTest.java @@ -1,9 +1,8 @@ package table; import static org.hamcrest.Matchers.is; -import static org.junit.Assert.assertEquals; -import static org.junit.Assert.assertNotEquals; -import static org.junit.Assert.assertNull; +import static org.hamcrest.Matchers.not; +import static org.hamcrest.Matchers.nullValue; import static org.junit.Assert.assertThat; import static sexpression.Nil.NIL; import static sexpression.Symbol.T; @@ -35,7 +34,7 @@ public class ExecutionContextTest { SymbolTable scope = new SymbolTable(); executionContext.setScope(scope); - assertEquals(scope, executionContext.getScope()); + assertThat(executionContext.getScope(), is(scope)); } @Test @@ -43,17 +42,17 @@ public class ExecutionContextTest { SymbolTable scope = new SymbolTable(); executionContext.setScope(scope); - assertEquals(scope, executionContext.getScope()); + assertThat(executionContext.getScope(), is(scope)); executionContext.clearContext(); - assertNotEquals(scope, executionContext.getScope()); - assertNull(executionContext.getScope().getParent()); + assertThat(executionContext.getScope(), is(not(scope))); + assertThat(executionContext.getScope().getParent(), is(nullValue())); } @Test public void lookupVariable() { executionContext.getScope().put("test", T); - assertEquals(T, executionContext.lookupSymbolValue("test")); + assertThat(executionContext.lookupSymbolValue("test"), is(T)); } @Test @@ -63,7 +62,7 @@ public class ExecutionContextTest { scope.put("local", T); executionContext.setScope(scope); - assertEquals(T, executionContext.lookupSymbolValue("local")); + assertThat(executionContext.lookupSymbolValue("local"), is(T)); } @Test @@ -73,7 +72,7 @@ public class ExecutionContextTest { executionContext.getScope().put("global", T); executionContext.setScope(scope); - assertEquals(T, executionContext.lookupSymbolValue("global")); + assertThat(executionContext.lookupSymbolValue("global"), is(T)); } @Test @@ -84,7 +83,7 @@ public class ExecutionContextTest { executionContext.getScope().put("shadowed", T); executionContext.setScope(scope); - assertEquals(NIL, executionContext.lookupSymbolValue("shadowed")); + assertThat(executionContext.lookupSymbolValue("shadowed"), is(NIL)); } @Test