Fix apply for macros
This commit is contained in:
parent
aeb3074750
commit
e0e726d6c0
|
@ -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);
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -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);
|
||||||
|
|
|
@ -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))"));
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -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"));
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -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)"));
|
||||||
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -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))))");
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue