mike
/
transcendental-lisp
1
1
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

Add DEFMACRO special function 

Resolves #16
This commit is contained in:
Mike Cifelli 2017-03-10 15:08:42 -05:00
parent 16b9a4dd30
commit 655f49e612
19 changed files with 452 additions and 207 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
lisp/finance/interest-compounder.lisp
View File

@ -3,13 +3,11 @@
(let ((static)) (let ((static))
(setq static (setq static
(eval (dlambda
(dlambda (:percent-of-number (n percentage)
(if (> percentage 0)
(:percent-of-number (n percentage) (/ (+ (* n percentage) 50) 100)
(if (> percentage 0) (/ (- (* n percentage) 50) 100)))))
(/ (+ (* n percentage) 50) 100)
(/ (- (* n percentage) 50) 100))))))
(defun interest-compounder (initial-principal initial-interest-rate) (defun interest-compounder (initial-principal initial-interest-rate)
(let ((private) (public) (let ((private) (public)
@ -18,40 +16,36 @@
(years-passed 0)) (years-passed 0))
(setq private (setq private
(eval (dlambda
(dlambda (:add-years (years)
(if (> years 0)
(setq years-passed (+ years-passed years))))
(:add-years (years) (:compound-interest (years)
(if (> years 0) (if (> years 0)
(setq years-passed (+ years-passed years)))) (begin
(setq principal
(:compound-interest (years) (+ principal
(if (> years 0) (call static :percent-of-number principal interest-rate)))
(begin (call private :compound-interest (- years 1)))))))
(setq principal
(+ principal
(call static :percent-of-number principal interest-rate)))
(call private :compound-interest (- years 1))))))))
(setq public (setq public
(eval (dlambda
(dlambda (:get-years-passed ()
years-passed)
(:get-years-passed () (:get-principal ()
years-passed) principal)
(:get-principal () (:get-interest-rate ()
principal) interest-rate)
(:get-interest-rate () (:set-interest-rate (new-interest-rate)
interest-rate) (setq interest-rate new-interest-rate))
(:set-interest-rate (new-interest-rate) (:make-contribution (contribution)
(setq interest-rate new-interest-rate)) (setq principal (+ principal contribution)))
(:make-contribution (contribution) (:move-forward-years (years)
(setq principal (+ principal contribution))) (call private :compound-interest years)
(call private :add-years years)))))))
(:move-forward-years (years)
(call private :compound-interest years)
(call private :add-years years))))))))

4
lisp/lang/dlambda.lisp
View File

@ -1,6 +1,6 @@
(load "functions.lisp") (load "functions.lisp")
;; A special function based on the dlambda macro presented in "Let Over Lambda" by Doug Hoyte. ;; This is based on the dlambda macro presented in "Let Over Lambda" by Doug Hoyte.
(let (let
((add-method-clause ((add-method-clause
@ -14,7 +14,7 @@
'arguments 'arguments
'(rest arguments)))))))))) '(rest arguments))))))))))
(define-special dlambda (&rest methods) (defmacro dlambda (&rest methods)
(cons 'lambda (cons 'lambda
(cons '(&rest arguments) (cons '(&rest arguments)
(list (list

82
lisp/object/composition.lisp
View File

@ -3,20 +3,18 @@
(defun counter (initial-count) (defun counter (initial-count)
(let ((count initial-count)) (let ((count initial-count))
(eval (dlambda
(dlambda (:inc ()
(setq count (+ count 1)))
(:inc () (:dec ()
(setq count (+ count 1))) (setq count (- count 1)))
(:dec () (:get ()
(setq count (- count 1))) count)
(:get () (:set (value)
count) (setq count value)))))
(:set (value)
(setq count value))))))
(defun fruit-counter (initial-count) (defun fruit-counter (initial-count)
@ -24,50 +22,48 @@
(banana-counter (counter initial-count)) (banana-counter (counter initial-count))
(coconut-counter (counter initial-count))) (coconut-counter (counter initial-count)))
(eval (dlambda
(dlambda (:inc-apples ()
(call apple-counter :inc))
(:inc-apples () (:dec-apples ()
(call apple-counter :inc)) (call apple-counter :dec))
(:dec-apples () (:get-apples ()
(call apple-counter :dec)) (call apple-counter :get))
(:get-apples () (:set-apples (value)
(call apple-counter :get)) (call apple-counter :set value))
(:set-apples (value) (:inc-bananas ()
(call apple-counter :set value)) (call banana-counter :inc))
(:inc-bananas () (:dec-bananas ()
(call banana-counter :inc)) (call banana-counter :dec))
(:dec-bananas () (:get-bananas ()
(call banana-counter :dec)) (call banana-counter :get))
(:get-bananas () (:set-bananas (value)
(call banana-counter :get)) (call banana-counter :set value))
(:set-bananas (value) (:inc-coconuts ()
(call banana-counter :set value)) (call coconut-counter :inc))
(:inc-coconuts () (:dec-coconuts ()
(call coconut-counter :inc)) (call coconut-counter :dec))
(:dec-coconuts () (:get-coconuts ()
(call coconut-counter :dec)) (call coconut-counter :get))
(:get-coconuts () (:set-coconuts (value)
(call coconut-counter :get)) (call coconut-counter :set value))
(:set-coconuts (value) (t (&rest arguments)
(call coconut-counter :set value)) (list
(list 'apples (call apple-counter :get))
(t (&rest arguments) (list 'bananas (call banana-counter :get))
(list (list 'coconuts (call coconut-counter :get)))))))
(list 'apples (call apple-counter :get))
(list 'bananas (call banana-counter :get))
(list 'coconuts (call coconut-counter :get))))))))
; Create an instance ; Create an instance

40
lisp/object/this.lisp
View File

@ -7,33 +7,31 @@
(setq name "Counter") (setq name "Counter")
(setq this (setq this
(eval (dlambda
(dlambda (:inc ()
(setq count (+ count 1)))
(:inc () (:inc-3 ()
(setq count (+ count 1))) (call this :inc)
(call this :inc)
(call this :inc))
(:inc-3 () (:dec ()
(call this :inc) (setq count (- count 1)))
(call this :inc)
(call this :inc))
(:dec () (:dec-3 ()
(setq count (- count 1))) (call this :dec)
(call this :dec)
(call this :dec))
(:dec-3 () (:get ()
(call this :dec) count)
(call this :dec)
(call this :dec))
(:get () (:set (value)
count) (setq count value))
(:set (value) (t ()
(setq count value)) (cons name count))))))
(t ()
(cons name count)))))))
(let ((instance (counter 0))) (let ((instance (counter 0)))

12
lisp/random/structure.lisp
View File

@ -1,13 +1,11 @@
(load "../lang/dlambda.lisp") (load "../lang/dlambda.lisp")
(load "../lang/functions.lisp") (load "../lang/functions.lisp")
(define-special keys (&rest fields) (defmacro keys (&rest fields)
(eval (list 'let (mapcar 'list fields)
(list 'let (mapcar 'list fields) '(dlambda
'(eval (:get (field) (eval field))
(dlambda (:set (field value) (set field value)))))
(:get (field) (eval field))
(:set (field value) (set field value)))))))
(defun process-data (data) (defun process-data (data)
(let ((one (call data :get 'one)) (let ((one (call data :get 'one))

84
lisp/unit/unit-tester.lisp
View File

@ -6,65 +6,57 @@
public-static) public-static)
(setq private-static (setq private-static
(eval (dlambda
(dlambda (:assertion-failed (comparison operand1 operand2)
(call private-static :print-failure comparison operand1 operand2)
nil)
(:assertion-failed (comparison operand1 operand2) (:print-failure (comparison operand1 operand2)
(call private-static :print-failure comparison operand1 operand2) (print '==================================================)
nil) (print (list comparison 'comparison 'failed))
(print operand1)
(:print-failure (comparison operand1 operand2) (print operand2)
(print '==================================================) (print '--------------------------------------------------))))
(print (list comparison 'comparison 'failed))
(print operand1)
(print operand2)
(print '--------------------------------------------------)))))
(setq public-static (setq public-static
(eval (dlambda
(dlambda (:assert= (expected actual)
(call public-static :assert '= expected actual))
(:assert= (expected actual) (:assert-equal (expected actual)
(call public-static :assert '= expected actual)) (call public-static :assert 'equal expected actual))
(:assert-equal (expected actual) (:assert (comparison operand1 operand2)
(call public-static :assert 'equal expected actual)) (if (call comparison operand1 operand2)
t
(:assert (comparison operand1 operand2) (call private-static :assertion-failed comparison operand1 operand2)))))
(if (call comparison operand1 operand2)
t
(call private-static :assertion-failed comparison operand1 operand2))))))
(defun unit-tester (suite) (defun unit-tester (suite)
(let ((private) (public) (let ((private) (public)
(suite suite)) (suite suite))
(setq private (setq private
(eval (dlambda
(dlambda (:run-suite (suite)
(if suite
(cons
(call private :run-test (car suite))
(call private :run-suite (cdr suite)))))
(:run-suite (suite) (:run-test (test)
(if suite (if (call test)
(cons (call private :indicate-success test)
(call private :run-test (car suite)) (call private :indicate-failure test)))
(call private :run-suite (cdr suite)))))
(:run-test (test) (:indicate-success (test)
(if (call test) (print (cons t test))
(call private :indicate-success test) t)
(call private :indicate-failure test)))
(:indicate-success (test) (:indicate-failure (test)
(print (cons t test)) (print (cons 'f test))
t) nil)))
(:indicate-failure (test)
(print (cons 'f test))
nil))))
(setq public (setq public
(eval (dlambda
(dlambda (:run ()
(apply 'and (call private :run-suite suite))))))))
(:run ()
(apply 'and (call private :run-suite suite)))))))))

6
src/function/LispFunction.java
View File

@ -6,8 +6,12 @@ public abstract class LispFunction {
public abstract SExpression call(Cons argList); public abstract SExpression call(Cons argList);
public boolean evaluateArguments() { public boolean isArgumentListEvaluated() {
return true; return true;
} }
public boolean isMacro() {
return false;
}
} }

10
src/function/LispMacro.java Normal file
View File

@ -0,0 +1,10 @@
package function;
public abstract class LispMacro extends LispSpecialFunction {
@Override
public boolean isMacro() {
return true;
}
}

2
src/function/LispSpecialFunction.java
View File

@ -3,7 +3,7 @@ package function;
public abstract class LispSpecialFunction extends LispFunction { public abstract class LispSpecialFunction extends LispFunction {
@Override @Override
public boolean evaluateArguments() { public boolean isArgumentListEvaluated() {
return false; return false;
} }

16
src/function/UserDefinedMacro.java Normal file
View File

@ -0,0 +1,16 @@
package function;
import sexpression.Cons;
public class UserDefinedMacro extends UserDefinedSpecialFunction {
public UserDefinedMacro(String name, Cons lambdaList, Cons body) {
super(name, lambdaList, body);
}
@Override
public boolean isMacro() {
return true;
}
}

2
src/function/UserDefinedSpecialFunction.java
View File

@ -9,7 +9,7 @@ public class UserDefinedSpecialFunction extends UserDefinedFunction {
} }
@Override @Override
public boolean evaluateArguments() { public boolean isArgumentListEvaluated() {
return false; return false;
} }

91
src/function/builtin/EVAL.java
View File

@ -1,5 +1,7 @@
package function.builtin; package function.builtin;
import static function.builtin.cons.LIST.makeList;
import static function.builtin.special.LAMBDA.*;
import static sexpression.Nil.NIL; import static sexpression.Nil.NIL;
import static sexpression.Symbol.T; import static sexpression.Symbol.T;
import static table.FunctionTable.lookupFunction; import static table.FunctionTable.lookupFunction;
@ -8,14 +10,18 @@ import java.text.MessageFormat;
import error.LispException; import error.LispException;
import function.*; import function.*;
import function.builtin.cons.LIST;
import function.builtin.special.LAMBDA;
import sexpression.*; import sexpression.*;
import table.ExecutionContext; import table.ExecutionContext;
@FunctionNames({ "EVAL" }) @FunctionNames({ "EVAL" })
public class EVAL extends LispFunction { public class EVAL extends LispFunction {
public static SExpression eval(SExpression sExpression) {
Cons argumentList = makeList(sExpression);
return lookupFunction("EVAL").call(argumentList);
}
public static LispFunction lookupFunctionOrLambda(SExpression functionExpression) { public static LispFunction lookupFunctionOrLambda(SExpression functionExpression) {
LispFunction function = lookupFunction(functionExpression.toString()); LispFunction function = lookupFunction(functionExpression.toString());
@ -28,8 +34,8 @@ public class EVAL extends LispFunction {
private static LispFunction createLambdaFunction(SExpression lambdaExpression) { private static LispFunction createLambdaFunction(SExpression lambdaExpression) {
if (lambdaExpression.isFunction()) if (lambdaExpression.isFunction())
return ((LambdaExpression) lambdaExpression).getFunction(); return ((LambdaExpression) lambdaExpression).getFunction();
else if (LAMBDA.isLambdaExpression(lambdaExpression)) else if (isLambdaExpression(lambdaExpression))
return LAMBDA.createFunction((Cons) lambdaExpression); return createFunction((Cons) lambdaExpression);
else else
throw new UndefinedFunctionException(lambdaExpression); throw new UndefinedFunctionException(lambdaExpression);
} }
@ -45,12 +51,6 @@ public class EVAL extends LispFunction {
return ExecutionContext.getInstance().lookupSymbolValue(symbolName); return ExecutionContext.getInstance().lookupSymbolValue(symbolName);
} }
public static SExpression eval(SExpression sExpression) {
Cons argumentList = LIST.makeList(sExpression);
return lookupFunction("EVAL").call(argumentList);
}
private ArgumentValidator argumentValidator; private ArgumentValidator argumentValidator;
public EVAL(String name) { public EVAL(String name) {
@ -60,52 +60,71 @@ public class EVAL extends LispFunction {
public SExpression call(Cons argumentList) { public SExpression call(Cons argumentList) {
argumentValidator.validate(argumentList); argumentValidator.validate(argumentList);
SExpression argument = argumentList.getFirst(); SExpression argument = argumentList.getFirst();
if (argument.isList()) { return evaluateExpression(argument);
if (argument.isCons()) }
return evaluateList((Cons) argument);
return argument; // NIL private SExpression evaluateExpression(SExpression argument) {
} if (argument.isList())
return evaluateList(argument);
if (argument.isSymbol()) { if (argument.isSymbol())
SExpression symbolValue = lookupSymbol(argument.toString()); return evaluateSymbol(argument);
if (symbolValue != null)
return symbolValue;
throw new UndefinedSymbolException(argument);
}
return argument; // NUMBER or STRING return argument; // NUMBER or STRING
} }
private SExpression evaluateList(Cons list) { private SExpression evaluateList(SExpression argument) {
if (argument.isCons())
return evaluateFunction((Cons) argument);
return argument; // NIL
}
private SExpression evaluateFunction(Cons list) {
SExpression functionName = list.getFirst(); SExpression functionName = list.getFirst();
SExpression arguments = list.getRest(); SExpression arguments = list.getRest();
LispFunction function = lookupFunctionOrLambda(functionName); LispFunction function = lookupFunctionOrLambda(functionName);
validateFunctionList(list, functionName);
ArgumentValidator functionListValidator = new ArgumentValidator(functionName.toString()); return callFunction(function, (Cons) arguments);
functionListValidator.validate(list);
Cons argumentList = (Cons) arguments;
if (function.evaluateArguments())
argumentList = evaluateArgList(argumentList);
return function.call(argumentList);
} }
private Cons evaluateArgList(Cons arguments) { private void validateFunctionList(Cons list, SExpression functionName) {
ArgumentValidator functionListValidator = new ArgumentValidator(functionName.toString());
functionListValidator.validate(list);
}
private SExpression callFunction(LispFunction function, Cons argumentList) {
if (function.isArgumentListEvaluated())
argumentList = evaluateArgumentList(argumentList);
SExpression result = function.call(argumentList);
if (function.isMacro())
result = eval(result);
return result;
}
private Cons evaluateArgumentList(Cons arguments) {
if (arguments.isNull()) if (arguments.isNull())
return NIL; return NIL;
SExpression first = eval(arguments.getFirst()); SExpression first = eval(arguments.getFirst());
SExpression rest = arguments.getRest(); SExpression rest = arguments.getRest();
return new Cons(first, evaluateArgList((Cons) rest)); return new Cons(first, evaluateArgumentList((Cons) rest));
}
private SExpression evaluateSymbol(SExpression argument) {
SExpression symbolValue = lookupSymbol(argument.toString());
if (symbolValue != null)
return symbolValue;
throw new UndefinedSymbolException(argument);
} }
public static class UndefinedFunctionException extends LispException { public static class UndefinedFunctionException extends LispException {

18
src/function/builtin/special/DEFMACRO.java Normal file
View File

@ -0,0 +1,18 @@
package function.builtin.special;
import function.*;
import sexpression.*;
@FunctionNames({ "DEFMACRO" })
public class DEFMACRO extends Define {
public DEFMACRO(String name) {
super(name);
}
@Override
protected UserDefinedFunction createFunction(SExpression functionName, Cons lambdaList, Cons functionBody) {
return new UserDefinedMacro(functionName.toString(), lambdaList, functionBody);
}
}

1
src/table/FunctionTable.java
View File

@ -23,6 +23,7 @@ public class FunctionTable {
allBuiltIns.add(COND.class); allBuiltIns.add(COND.class);
allBuiltIns.add(CONS.class); allBuiltIns.add(CONS.class);
allBuiltIns.add(DEFINE_SPECIAL.class); allBuiltIns.add(DEFINE_SPECIAL.class);
allBuiltIns.add(DEFMACRO.class);
allBuiltIns.add(DEFUN.class); allBuiltIns.add(DEFUN.class);
allBuiltIns.add(DIVIDE.class); allBuiltIns.add(DIVIDE.class);
allBuiltIns.add(EQ.class); allBuiltIns.add(EQ.class);

2
test/function/LispFunctionTester.java
View File

@ -18,7 +18,7 @@ public class LispFunctionTester {
} }
}; };
assertTrue(lispFunction.evaluateArguments()); assertTrue(lispFunction.isArgumentListEvaluated());
} }
} }

2
test/function/LispSpecialFunctionTester.java
View File

@ -18,7 +18,7 @@ public class LispSpecialFunctionTester {
} }
}; };
assertFalse(lispFunction.evaluateArguments()); assertFalse(lispFunction.isArgumentListEvaluated());
} }
} }

11
test/function/builtin/special/DEFINE_SPECIALTester.java
View File

@ -60,7 +60,7 @@ public class DEFINE_SPECIALTester {
} }
@Test @Test
public void defineSpecialDoesNotEvaluatesArguments() { public void defineSpecialDoesNotEvaluateArguments() {
evaluateString("(define-special f (x) (car x))"); evaluateString("(define-special f (x) (car x))");
assertSExpressionsMatch(parseString("quote"), evaluateString("(f '(1 2 3))")); assertSExpressionsMatch(parseString("quote"), evaluateString("(f '(1 2 3))"));
} }
@ -174,4 +174,13 @@ public class DEFINE_SPECIALTester {
evaluateString("(f)"); evaluateString("(f)");
} }
@Test
public void resultOfSpecialFunctionIsNotEvaluated() {
evaluateString("(setq x 'grains)");
evaluateString("(define-special f (x) x)");
evaluateString("(f (setq x 'sprouts))");
assertSExpressionsMatch(parseString("grains"), evaluateString("x"));
}
} }

181
test/function/builtin/special/DEFMACROTester.java Normal file
View File

@ -0,0 +1,181 @@
package function.builtin.special;
import static org.junit.Assert.assertTrue;
import static table.FunctionTable.resetFunctionTable;
import static testutil.TestUtilities.*;
import java.io.*;
import org.junit.*;
import environment.RuntimeEnvironment;
import error.ErrorManager;
import function.ArgumentValidator.*;
import function.UserDefinedFunction.IllegalKeywordRestPositionException;
public class DEFMACROTester {
private ByteArrayOutputStream outputStream;
private RuntimeEnvironment environment;
public DEFMACROTester() {
this.environment = RuntimeEnvironment.getInstance();
}
private void assertSomethingPrinted() {
assertTrue(outputStream.toByteArray().length > 0);
}
@Before
public void setUp() {
outputStream = new ByteArrayOutputStream();
environment.reset();
environment.setOutput(new PrintStream(outputStream));
environment.setErrorManager(new ErrorManager());
environment.setWarningOutputDecorator(s -> s);
resetFunctionTable();
}
@After
public void tearDown() {
environment.reset();
resetFunctionTable();
}
@Test
public void defmacro() {
String input = "(defmacro m () t)";
assertSExpressionsMatch(parseString("m"), evaluateString(input));
assertSExpressionsMatch(parseString("t"), evaluateString("(m)"));
}
@Test
public void defmacroWithEmptyBody() {
String input = "(defmacro m ())";
assertSExpressionsMatch(parseString("m"), evaluateString(input));
assertSExpressionsMatch(parseString("()"), evaluateString("(m)"));
}
@Test
public void defmacroDoesNotEvaluateArguments() {
evaluateString("(setq x 'grains)");
evaluateString("(defmacro m (x))");
evaluateString("(m (setq x 'sprouts))");
assertSExpressionsMatch(parseString("grains"), evaluateString("x"));
}
@Test
public void defmacroAdd() {
evaluateString("(defmacro m (x) (+ (eval x) 23))");
assertSExpressionsMatch(parseString("27"), evaluateString("(m (+ 2 2))"));
}
@Test
public void defmacroSetVariable() {
evaluateString("(defmacro m (x) (set x 23))");
evaluateString("(m y)");
assertSExpressionsMatch(parseString("23"), evaluateString("y"));
}
@Test
public void defmacroVariableCapture() {
evaluateString("(setq x 0)");
evaluateString("(defmacro m (x) (set x 23))");
evaluateString("(m x)");
assertSExpressionsMatch(parseString("0"), evaluateString("x"));
}
@Test
public void redefineMacro_DisplaysWarning() {
String input = "(defmacro myMacro () nil)";
evaluateString(input);
evaluateString(input);
assertSomethingPrinted();
}
@Test
public void redefineMacro_ActuallyRedefinesSpecialFunction() {
evaluateString("(defmacro myMacro () nil)");
evaluateString("(defmacro myMacro () T)");
assertSomethingPrinted();
assertSExpressionsMatch(parseString("t"), evaluateString("(myMacro)"));
}
@Test(expected = DottedArgumentListException.class)
public void defmacroWithDottedLambdaList() {
evaluateString("(funcall 'defmacro 'm (cons 'a 'b) ())");
}
@Test(expected = BadArgumentTypeException.class)
public void defmacroWithNonSymbolName() {
evaluateString("(defmacro 1 () ())");
}
@Test(expected = BadArgumentTypeException.class)
public void defmacroWithBadLambdaList() {
evaluateString("(defmacro m a ())");
}
@Test(expected = TooFewArgumentsException.class)
public void defmacroWithTooFewArguments() {
evaluateString("(defmacro m)");
}
@Test(expected = TooFewArgumentsException.class)
public void defmacroAndCallWithTooFewArguments() {
evaluateString("(defmacro m (a b))");
evaluateString("(m a)");
}
@Test(expected = TooManyArgumentsException.class)
public void defmacroAndCallWithTooManyArguments() {
evaluateString("(defmacro m (a b))");
evaluateString("(m a b c)");
}
@Test
public void defmacroWithKeywordRestParameter() {
evaluateString("(defmacro m (&rest x) (car x))");
assertSExpressionsMatch(parseString("1"), evaluateString("(m 1 2 3 4 5)"));
}
@Test
public void defmacroWithNormalAndKeywordRestParameter() {
evaluateString("(defmacro m (a &rest b) (list 'cons a (list 'quote b)))");
assertSExpressionsMatch(parseString("(1 2 3 4 5)"), evaluateString("(m 1 2 3 4 5)"));
}
@Test(expected = IllegalKeywordRestPositionException.class)
public void defmacroWithParametersFollowingKeywordRest() {
evaluateString("(defmacro m (a &rest b c) (cons a b))");
evaluateString("(m 1 2 3)");
}
@Test
public void defmacroWithKeywordRest_CallWithNoArguments() {
evaluateString("(defmacro m (&rest a) (car a))");
assertSExpressionsMatch(parseString("nil"), evaluateString("(m)"));
}
@Test(expected = TooFewArgumentsException.class)
public void defmacroWithNormalAndKeywordRest_CallWithNoArguments() {
evaluateString("(defmacro m (a &rest b) a)");
evaluateString("(m)");
}
@Test
public void macroIsEvaluatedAfterExpansion() {
evaluateString("(setq x 'grains)");
evaluateString("(defmacro m (x) x)");
evaluateString("(m (setq x 'sprouts))");
assertSExpressionsMatch(parseString("sprouts"), evaluateString("x"));
}
}

29
test/function/builtin/special/DEFUNTester.java
View File

@ -99,16 +99,16 @@ public class DEFUNTester {
@Test @Test
public void redefineFunction_ActuallyRedefinesFunction() { public void redefineFunction_ActuallyRedefinesFunction() {
evaluateString("(defun myFunction2 () nil)"); evaluateString("(defun myFunction () nil)");
evaluateString("(defun myFunction2 () T)"); evaluateString("(defun myFunction () T)");
assertSomethingPrinted(); assertSomethingPrinted();
assertSExpressionsMatch(parseString("t"), evaluateString("(myFunction2)")); assertSExpressionsMatch(parseString("t"), evaluateString("(myFunction)"));
} }
@Test(expected = DottedArgumentListException.class) @Test(expected = DottedArgumentListException.class)
public void defunWithDottedLambdaList() { public void defunWithDottedLambdaList() {
evaluateString("(funcall 'defun 'x (cons 'a 'b) ())"); evaluateString("(funcall 'defun 'f (cons 'a 'b) ())");
} }
@Test(expected = BadArgumentTypeException.class) @Test(expected = BadArgumentTypeException.class)
@ -118,24 +118,24 @@ public class DEFUNTester {
@Test(expected = BadArgumentTypeException.class) @Test(expected = BadArgumentTypeException.class)
public void defunWithBadLambdaList() { public void defunWithBadLambdaList() {
evaluateString("(defun x a ())"); evaluateString("(defun f a ())");
} }
@Test(expected = TooFewArgumentsException.class) @Test(expected = TooFewArgumentsException.class)
public void defunWithTooFewArguments() { public void defunWithTooFewArguments() {
evaluateString("(defun x)"); evaluateString("(defun f)");
} }
@Test(expected = TooFewArgumentsException.class) @Test(expected = TooFewArgumentsException.class)
public void defunFunctionAndCallWithTooFewArguments() { public void defunFunctionAndCallWithTooFewArguments() {
evaluateString("(defun x (a b))"); evaluateString("(defun f (a b))");
evaluateString("(x 'a)"); evaluateString("(f 'a)");
} }
@Test(expected = TooManyArgumentsException.class) @Test(expected = TooManyArgumentsException.class)
public void defunFunctionAndCallWithTooManyArguments() { public void defunFunctionAndCallWithTooManyArguments() {
evaluateString("(defun x (a b))"); evaluateString("(defun f (a b))");
evaluateString("(x 'a 'b 'c)"); evaluateString("(f 'a 'b 'c)");
} }
@Test @Test
@ -168,4 +168,13 @@ public class DEFUNTester {
evaluateString("(f)"); evaluateString("(f)");
} }
@Test
public void resultOfFunctionIsNotEvaluated() {
evaluateString("(setq x 'grains)");
evaluateString("(define-special f (x) 'x)");
evaluateString("(f (setq x 'sprouts))");
assertSExpressionsMatch(parseString("grains"), evaluateString("x"));
}
} }