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; package function.builtin;
import static function.builtin.EVAL.applyFunction;
import static function.builtin.EVAL.lookupFunctionOrLambda; import static function.builtin.EVAL.lookupFunctionOrLambda;
import static table.FunctionTable.lookupFunction; import static table.FunctionTable.lookupFunction;
@ -33,7 +34,7 @@ public class APPLY extends LispFunction {
SExpression functionName = argumentList.getFirst(); SExpression functionName = argumentList.getFirst();
LispFunction function = lookupFunctionOrLambda(functionName); 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) { public static Cons evalRecurArgumentList(Cons argumentList) {
return ((EVAL) lookupFunction("EVAL")).evaluateArgumentList(argumentList); return ((EVAL) lookupFunction("EVAL")).evaluateArgumentList(argumentList);
} }
@ -132,6 +136,10 @@ public class EVAL extends LispFunction {
if (function.isArgumentListEvaluated()) if (function.isArgumentListEvaluated())
argumentList = evaluateArgumentList(argumentList); argumentList = evaluateArgumentList(argumentList);
return applyFunctionWithoutEvaluatingArguments(function, argumentList);
}
private SExpression applyFunctionWithoutEvaluatingArguments(LispFunction function, Cons argumentList) {
verifyNotRecurring(); verifyNotRecurring();
SExpression result = function.call(argumentList); SExpression result = function.call(argumentList);

View File

@ -71,4 +71,9 @@ public class APPLYTest extends SymbolAndFunctionCleaner {
evaluateString("(apply 'apply (cons 'T 'T))"); 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 @Test
public void scopeRestoredAfterFailure_Let() { public void scopeRestoredAfterFailure_Let() {
evaluateString("(setq n 100)"); evaluateString("(setq n 100)");
try { try {
evaluateString("(let ((n 200)) (begin 1 2 3 y))"); evaluateString("(let ((n 200)) (begin 1 2 3 y))");
fail("expected exception"); fail("expected exception");
@ -194,6 +195,7 @@ public class EVALTest extends SymbolAndFunctionCleaner {
@Test @Test
public void scopeRestoredAfterFailure_Defun() { public void scopeRestoredAfterFailure_Defun() {
evaluateString("(setq n 100)"); evaluateString("(setq n 100)");
try { try {
evaluateString("(defun test (n) (begin 1 2 3 y))"); evaluateString("(defun test (n) (begin 1 2 3 y))");
evaluateString("(test 200)"); evaluateString("(test 200)");
@ -206,6 +208,7 @@ public class EVALTest extends SymbolAndFunctionCleaner {
@Test @Test
public void scopeRestoredAfterFailure_Lambda() { public void scopeRestoredAfterFailure_Lambda() {
evaluateString("(setq n 100)"); evaluateString("(setq n 100)");
try { try {
evaluateString("((lambda (n) (begin 1 2 3 y)) 200)"); evaluateString("((lambda (n) (begin 1 2 3 y)) 200)");
fail("expected exception"); fail("expected exception");
@ -217,6 +220,7 @@ public class EVALTest extends SymbolAndFunctionCleaner {
@Test @Test
public void scopeRestoredAfterFailure_Recur() { public void scopeRestoredAfterFailure_Recur() {
evaluateString("(setq n 100)"); evaluateString("(setq n 100)");
try { try {
evaluateString("(defun tail-recursive (n) (begin (recur) 2))"); evaluateString("(defun tail-recursive (n) (begin (recur) 2))");
evaluateString("(tail-recursive 200)"); evaluateString("(tail-recursive 200)");
@ -226,4 +230,16 @@ public class EVALTest extends SymbolAndFunctionCleaner {
assertSExpressionsMatch(parseString("100"), evaluateString("n")); 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")); 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)"); 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 @Test
public void recurCallsCurrentFunction() { public void recurCallsCurrentFunction() {
evaluateString("(defun tail-recursive (n) (if (= n 0) 'PASS (recur (- n 1))))"); evaluateString("(defun tail-recursive (n) (if (= n 0) 'PASS (recur (- n 1))))");

View File

@ -1,9 +1,8 @@
package table; package table;
import static org.hamcrest.Matchers.is; import static org.hamcrest.Matchers.is;
import static org.junit.Assert.assertEquals; import static org.hamcrest.Matchers.not;
import static org.junit.Assert.assertNotEquals; import static org.hamcrest.Matchers.nullValue;
import static org.junit.Assert.assertNull;
import static org.junit.Assert.assertThat; import static org.junit.Assert.assertThat;
import static sexpression.Nil.NIL; import static sexpression.Nil.NIL;
import static sexpression.Symbol.T; import static sexpression.Symbol.T;
@ -35,7 +34,7 @@ public class ExecutionContextTest {
SymbolTable scope = new SymbolTable(); SymbolTable scope = new SymbolTable();
executionContext.setScope(scope); executionContext.setScope(scope);
assertEquals(scope, executionContext.getScope()); assertThat(executionContext.getScope(), is(scope));
} }
@Test @Test
@ -43,17 +42,17 @@ public class ExecutionContextTest {
SymbolTable scope = new SymbolTable(); SymbolTable scope = new SymbolTable();
executionContext.setScope(scope); executionContext.setScope(scope);
assertEquals(scope, executionContext.getScope()); assertThat(executionContext.getScope(), is(scope));
executionContext.clearContext(); executionContext.clearContext();
assertNotEquals(scope, executionContext.getScope()); assertThat(executionContext.getScope(), is(not(scope)));
assertNull(executionContext.getScope().getParent()); assertThat(executionContext.getScope().getParent(), is(nullValue()));
} }
@Test @Test
public void lookupVariable() { public void lookupVariable() {
executionContext.getScope().put("test", T); executionContext.getScope().put("test", T);
assertEquals(T, executionContext.lookupSymbolValue("test")); assertThat(executionContext.lookupSymbolValue("test"), is(T));
} }
@Test @Test
@ -63,7 +62,7 @@ public class ExecutionContextTest {
scope.put("local", T); scope.put("local", T);
executionContext.setScope(scope); executionContext.setScope(scope);
assertEquals(T, executionContext.lookupSymbolValue("local")); assertThat(executionContext.lookupSymbolValue("local"), is(T));
} }
@Test @Test
@ -73,7 +72,7 @@ public class ExecutionContextTest {
executionContext.getScope().put("global", T); executionContext.getScope().put("global", T);
executionContext.setScope(scope); executionContext.setScope(scope);
assertEquals(T, executionContext.lookupSymbolValue("global")); assertThat(executionContext.lookupSymbolValue("global"), is(T));
} }
@Test @Test
@ -84,7 +83,7 @@ public class ExecutionContextTest {
executionContext.getScope().put("shadowed", T); executionContext.getScope().put("shadowed", T);
executionContext.setScope(scope); executionContext.setScope(scope);
assertEquals(NIL, executionContext.lookupSymbolValue("shadowed")); assertThat(executionContext.lookupSymbolValue("shadowed"), is(NIL));
} }
@Test @Test