Fix apply for macros

This commit is contained in:
Mike Cifelli 2017-11-18 10:21:57 -05:00
parent aeb3074750
commit e0e726d6c0
7 changed files with 53 additions and 12 deletions

View File

@ -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);
}
}

View File

@ -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);

View File

@ -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))"));
}
}

View File

@ -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"));
}
}

View File

@ -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)"));
}
}

View File

@ -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))))");

View File

@ -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