From 655f49e612f2a73d4383d18d98c427b6d9bd5fc9 Mon Sep 17 00:00:00 2001 From: Mike Cifelli Date: Fri, 10 Mar 2017 15:08:42 -0500 Subject: [PATCH] Add DEFMACRO special function Resolves #16 --- lisp/finance/interest-compounder.lisp | 66 +++---- lisp/lang/dlambda.lisp | 4 +- lisp/object/composition.lisp | 82 ++++---- lisp/object/this.lisp | 40 ++-- lisp/random/structure.lisp | 12 +- lisp/unit/unit-tester.lisp | 84 ++++---- src/function/LispFunction.java | 6 +- src/function/LispMacro.java | 10 + src/function/LispSpecialFunction.java | 2 +- src/function/UserDefinedMacro.java | 16 ++ src/function/UserDefinedSpecialFunction.java | 2 +- src/function/builtin/EVAL.java | 91 +++++---- src/function/builtin/special/DEFMACRO.java | 18 ++ src/table/FunctionTable.java | 1 + test/function/LispFunctionTester.java | 2 +- test/function/LispSpecialFunctionTester.java | 2 +- .../builtin/special/DEFINE_SPECIALTester.java | 11 +- .../builtin/special/DEFMACROTester.java | 181 ++++++++++++++++++ .../function/builtin/special/DEFUNTester.java | 29 ++- 19 files changed, 452 insertions(+), 207 deletions(-) create mode 100644 src/function/LispMacro.java create mode 100644 src/function/UserDefinedMacro.java create mode 100644 src/function/builtin/special/DEFMACRO.java create mode 100644 test/function/builtin/special/DEFMACROTester.java diff --git a/lisp/finance/interest-compounder.lisp b/lisp/finance/interest-compounder.lisp index 414a677..75d70ae 100644 --- a/lisp/finance/interest-compounder.lisp +++ b/lisp/finance/interest-compounder.lisp @@ -3,13 +3,11 @@ (let ((static)) (setq static - (eval - (dlambda - - (:percent-of-number (n percentage) - (if (> percentage 0) - (/ (+ (* n percentage) 50) 100) - (/ (- (* n percentage) 50) 100)))))) + (dlambda + (:percent-of-number (n percentage) + (if (> percentage 0) + (/ (+ (* n percentage) 50) 100) + (/ (- (* n percentage) 50) 100))))) (defun interest-compounder (initial-principal initial-interest-rate) (let ((private) (public) @@ -18,40 +16,36 @@ (years-passed 0)) (setq private - (eval - (dlambda + (dlambda + (:add-years (years) + (if (> years 0) + (setq years-passed (+ years-passed years)))) - (:add-years (years) - (if (> years 0) - (setq years-passed (+ years-passed years)))) - - (:compound-interest (years) - (if (> years 0) - (begin - (setq principal - (+ principal - (call static :percent-of-number principal interest-rate))) - (call private :compound-interest (- years 1)))))))) + (:compound-interest (years) + (if (> years 0) + (begin + (setq principal + (+ principal + (call static :percent-of-number principal interest-rate))) + (call private :compound-interest (- years 1))))))) (setq public - (eval - (dlambda + (dlambda + (:get-years-passed () + years-passed) - (:get-years-passed () - years-passed) + (:get-principal () + principal) - (:get-principal () - principal) + (:get-interest-rate () + interest-rate) - (:get-interest-rate () - interest-rate) + (:set-interest-rate (new-interest-rate) + (setq interest-rate new-interest-rate)) - (:set-interest-rate (new-interest-rate) - (setq interest-rate new-interest-rate)) + (:make-contribution (contribution) + (setq principal (+ principal contribution))) - (:make-contribution (contribution) - (setq principal (+ principal contribution))) - - (:move-forward-years (years) - (call private :compound-interest years) - (call private :add-years years)))))))) + (:move-forward-years (years) + (call private :compound-interest years) + (call private :add-years years))))))) diff --git a/lisp/lang/dlambda.lisp b/lisp/lang/dlambda.lisp index ab8f792..89726dd 100644 --- a/lisp/lang/dlambda.lisp +++ b/lisp/lang/dlambda.lisp @@ -1,6 +1,6 @@ (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 ((add-method-clause @@ -14,7 +14,7 @@ 'arguments '(rest arguments)))))))))) - (define-special dlambda (&rest methods) + (defmacro dlambda (&rest methods) (cons 'lambda (cons '(&rest arguments) (list diff --git a/lisp/object/composition.lisp b/lisp/object/composition.lisp index 2a12bcc..b857f6a 100644 --- a/lisp/object/composition.lisp +++ b/lisp/object/composition.lisp @@ -3,20 +3,18 @@ (defun counter (initial-count) (let ((count initial-count)) - (eval - (dlambda + (dlambda + (:inc () + (setq count (+ count 1))) - (:inc () - (setq count (+ count 1))) + (:dec () + (setq count (- count 1))) - (:dec () - (setq count (- count 1))) + (:get () + count) - (:get () - count) - - (:set (value) - (setq count value)))))) + (:set (value) + (setq count value))))) (defun fruit-counter (initial-count) @@ -24,50 +22,48 @@ (banana-counter (counter initial-count)) (coconut-counter (counter initial-count))) - (eval - (dlambda + (dlambda + (:inc-apples () + (call apple-counter :inc)) - (:inc-apples () - (call apple-counter :inc)) + (:dec-apples () + (call apple-counter :dec)) - (:dec-apples () - (call apple-counter :dec)) + (:get-apples () + (call apple-counter :get)) - (:get-apples () - (call apple-counter :get)) + (:set-apples (value) + (call apple-counter :set value)) - (:set-apples (value) - (call apple-counter :set value)) + (:inc-bananas () + (call banana-counter :inc)) - (:inc-bananas () - (call banana-counter :inc)) + (:dec-bananas () + (call banana-counter :dec)) - (:dec-bananas () - (call banana-counter :dec)) + (:get-bananas () + (call banana-counter :get)) - (:get-bananas () - (call banana-counter :get)) + (:set-bananas (value) + (call banana-counter :set value)) - (:set-bananas (value) - (call banana-counter :set value)) + (:inc-coconuts () + (call coconut-counter :inc)) - (:inc-coconuts () - (call coconut-counter :inc)) + (:dec-coconuts () + (call coconut-counter :dec)) - (:dec-coconuts () - (call coconut-counter :dec)) + (:get-coconuts () + (call coconut-counter :get)) - (:get-coconuts () - (call coconut-counter :get)) + (:set-coconuts (value) + (call coconut-counter :set value)) - (:set-coconuts (value) - (call coconut-counter :set value)) - - (t (&rest arguments) - (list - (list 'apples (call apple-counter :get)) - (list 'bananas (call banana-counter :get)) - (list 'coconuts (call coconut-counter :get)))))))) + (t (&rest arguments) + (list + (list 'apples (call apple-counter :get)) + (list 'bananas (call banana-counter :get)) + (list 'coconuts (call coconut-counter :get))))))) ; Create an instance diff --git a/lisp/object/this.lisp b/lisp/object/this.lisp index 61d22f5..a0d8de0 100644 --- a/lisp/object/this.lisp +++ b/lisp/object/this.lisp @@ -7,33 +7,31 @@ (setq name "Counter") (setq this - (eval - (dlambda + (dlambda + (:inc () + (setq count (+ count 1))) - (:inc () - (setq count (+ count 1))) + (:inc-3 () + (call this :inc) + (call this :inc) + (call this :inc)) - (:inc-3 () - (call this :inc) - (call this :inc) - (call this :inc)) + (:dec () + (setq count (- count 1))) - (:dec () - (setq count (- count 1))) + (:dec-3 () + (call this :dec) + (call this :dec) + (call this :dec)) - (:dec-3 () - (call this :dec) - (call this :dec) - (call this :dec)) + (:get () + count) - (:get () - count) + (:set (value) + (setq count value)) - (:set (value) - (setq count value)) - - (t () - (cons name count))))))) + (t () + (cons name count)))))) (let ((instance (counter 0))) diff --git a/lisp/random/structure.lisp b/lisp/random/structure.lisp index 0ad2850..5c66757 100644 --- a/lisp/random/structure.lisp +++ b/lisp/random/structure.lisp @@ -1,13 +1,11 @@ (load "../lang/dlambda.lisp") (load "../lang/functions.lisp") -(define-special keys (&rest fields) - (eval - (list 'let (mapcar 'list fields) - '(eval - (dlambda - (:get (field) (eval field)) - (:set (field value) (set field value))))))) +(defmacro keys (&rest fields) + (list 'let (mapcar 'list fields) + '(dlambda + (:get (field) (eval field)) + (:set (field value) (set field value))))) (defun process-data (data) (let ((one (call data :get 'one)) diff --git a/lisp/unit/unit-tester.lisp b/lisp/unit/unit-tester.lisp index 7e0b87b..8ae2462 100644 --- a/lisp/unit/unit-tester.lisp +++ b/lisp/unit/unit-tester.lisp @@ -6,65 +6,57 @@ public-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) - (call private-static :print-failure comparison operand1 operand2) - nil) - - (:print-failure (comparison operand1 operand2) - (print '==================================================) - (print (list comparison 'comparison 'failed)) - (print operand1) - (print operand2) - (print '--------------------------------------------------))))) + (:print-failure (comparison operand1 operand2) + (print '==================================================) + (print (list comparison 'comparison 'failed)) + (print operand1) + (print operand2) + (print '--------------------------------------------------)))) (setq public-static - (eval - (dlambda + (dlambda + (:assert= (expected actual) + (call public-static :assert '= expected actual)) - (:assert= (expected actual) - (call public-static :assert '= expected actual)) + (:assert-equal (expected actual) + (call public-static :assert 'equal expected actual)) - (:assert-equal (expected actual) - (call public-static :assert 'equal expected actual)) - - (:assert (comparison operand1 operand2) - (if (call comparison operand1 operand2) - t - (call private-static :assertion-failed comparison operand1 operand2)))))) + (:assert (comparison operand1 operand2) + (if (call comparison operand1 operand2) + t + (call private-static :assertion-failed comparison operand1 operand2))))) (defun unit-tester (suite) (let ((private) (public) (suite suite)) (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) - (if suite - (cons - (call private :run-test (car suite)) - (call private :run-suite (cdr suite))))) + (:run-test (test) + (if (call test) + (call private :indicate-success test) + (call private :indicate-failure test))) - (:run-test (test) - (if (call test) - (call private :indicate-success test) - (call private :indicate-failure test))) + (:indicate-success (test) + (print (cons t test)) + t) - (:indicate-success (test) - (print (cons t test)) - t) - - (:indicate-failure (test) - (print (cons 'f test)) - nil)))) + (:indicate-failure (test) + (print (cons 'f test)) + nil))) (setq public - (eval - (dlambda - - (:run () - (apply 'and (call private :run-suite suite))))))))) + (dlambda + (:run () + (apply 'and (call private :run-suite suite)))))))) diff --git a/src/function/LispFunction.java b/src/function/LispFunction.java index fe6a27f..ecf80e0 100644 --- a/src/function/LispFunction.java +++ b/src/function/LispFunction.java @@ -6,8 +6,12 @@ public abstract class LispFunction { public abstract SExpression call(Cons argList); - public boolean evaluateArguments() { + public boolean isArgumentListEvaluated() { return true; } + + public boolean isMacro() { + return false; + } } diff --git a/src/function/LispMacro.java b/src/function/LispMacro.java new file mode 100644 index 0000000..a90d5bf --- /dev/null +++ b/src/function/LispMacro.java @@ -0,0 +1,10 @@ +package function; + +public abstract class LispMacro extends LispSpecialFunction { + + @Override + public boolean isMacro() { + return true; + } + +} diff --git a/src/function/LispSpecialFunction.java b/src/function/LispSpecialFunction.java index 5bf3c43..c99941a 100644 --- a/src/function/LispSpecialFunction.java +++ b/src/function/LispSpecialFunction.java @@ -3,7 +3,7 @@ package function; public abstract class LispSpecialFunction extends LispFunction { @Override - public boolean evaluateArguments() { + public boolean isArgumentListEvaluated() { return false; } diff --git a/src/function/UserDefinedMacro.java b/src/function/UserDefinedMacro.java new file mode 100644 index 0000000..b59b67d --- /dev/null +++ b/src/function/UserDefinedMacro.java @@ -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; + } + +} diff --git a/src/function/UserDefinedSpecialFunction.java b/src/function/UserDefinedSpecialFunction.java index ea27455..4ce4010 100644 --- a/src/function/UserDefinedSpecialFunction.java +++ b/src/function/UserDefinedSpecialFunction.java @@ -9,7 +9,7 @@ public class UserDefinedSpecialFunction extends UserDefinedFunction { } @Override - public boolean evaluateArguments() { + public boolean isArgumentListEvaluated() { return false; } diff --git a/src/function/builtin/EVAL.java b/src/function/builtin/EVAL.java index b2fbc79..ecde727 100644 --- a/src/function/builtin/EVAL.java +++ b/src/function/builtin/EVAL.java @@ -1,5 +1,7 @@ package function.builtin; +import static function.builtin.cons.LIST.makeList; +import static function.builtin.special.LAMBDA.*; import static sexpression.Nil.NIL; import static sexpression.Symbol.T; import static table.FunctionTable.lookupFunction; @@ -8,14 +10,18 @@ import java.text.MessageFormat; import error.LispException; import function.*; -import function.builtin.cons.LIST; -import function.builtin.special.LAMBDA; import sexpression.*; import table.ExecutionContext; @FunctionNames({ "EVAL" }) 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) { LispFunction function = lookupFunction(functionExpression.toString()); @@ -28,8 +34,8 @@ public class EVAL extends LispFunction { private static LispFunction createLambdaFunction(SExpression lambdaExpression) { if (lambdaExpression.isFunction()) return ((LambdaExpression) lambdaExpression).getFunction(); - else if (LAMBDA.isLambdaExpression(lambdaExpression)) - return LAMBDA.createFunction((Cons) lambdaExpression); + else if (isLambdaExpression(lambdaExpression)) + return createFunction((Cons) lambdaExpression); else throw new UndefinedFunctionException(lambdaExpression); } @@ -45,12 +51,6 @@ public class EVAL extends LispFunction { return ExecutionContext.getInstance().lookupSymbolValue(symbolName); } - public static SExpression eval(SExpression sExpression) { - Cons argumentList = LIST.makeList(sExpression); - - return lookupFunction("EVAL").call(argumentList); - } - private ArgumentValidator argumentValidator; public EVAL(String name) { @@ -60,52 +60,71 @@ public class EVAL extends LispFunction { public SExpression call(Cons argumentList) { argumentValidator.validate(argumentList); - SExpression argument = argumentList.getFirst(); - if (argument.isList()) { - if (argument.isCons()) - return evaluateList((Cons) argument); + return evaluateExpression(argument); + } - return argument; // NIL - } + private SExpression evaluateExpression(SExpression argument) { + if (argument.isList()) + return evaluateList(argument); - if (argument.isSymbol()) { - SExpression symbolValue = lookupSymbol(argument.toString()); - - if (symbolValue != null) - return symbolValue; - - throw new UndefinedSymbolException(argument); - } + if (argument.isSymbol()) + return evaluateSymbol(argument); 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 arguments = list.getRest(); LispFunction function = lookupFunctionOrLambda(functionName); + validateFunctionList(list, functionName); - ArgumentValidator functionListValidator = new ArgumentValidator(functionName.toString()); - functionListValidator.validate(list); - - Cons argumentList = (Cons) arguments; - - if (function.evaluateArguments()) - argumentList = evaluateArgList(argumentList); - - return function.call(argumentList); + return callFunction(function, (Cons) arguments); } - 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()) return NIL; SExpression first = eval(arguments.getFirst()); 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 { diff --git a/src/function/builtin/special/DEFMACRO.java b/src/function/builtin/special/DEFMACRO.java new file mode 100644 index 0000000..20e2738 --- /dev/null +++ b/src/function/builtin/special/DEFMACRO.java @@ -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); + } + +} diff --git a/src/table/FunctionTable.java b/src/table/FunctionTable.java index b5ee66f..b8e46dc 100644 --- a/src/table/FunctionTable.java +++ b/src/table/FunctionTable.java @@ -23,6 +23,7 @@ public class FunctionTable { allBuiltIns.add(COND.class); allBuiltIns.add(CONS.class); allBuiltIns.add(DEFINE_SPECIAL.class); + allBuiltIns.add(DEFMACRO.class); allBuiltIns.add(DEFUN.class); allBuiltIns.add(DIVIDE.class); allBuiltIns.add(EQ.class); diff --git a/test/function/LispFunctionTester.java b/test/function/LispFunctionTester.java index 050cf0c..b71be65 100644 --- a/test/function/LispFunctionTester.java +++ b/test/function/LispFunctionTester.java @@ -18,7 +18,7 @@ public class LispFunctionTester { } }; - assertTrue(lispFunction.evaluateArguments()); + assertTrue(lispFunction.isArgumentListEvaluated()); } } diff --git a/test/function/LispSpecialFunctionTester.java b/test/function/LispSpecialFunctionTester.java index fa40608..6073fc6 100644 --- a/test/function/LispSpecialFunctionTester.java +++ b/test/function/LispSpecialFunctionTester.java @@ -18,7 +18,7 @@ public class LispSpecialFunctionTester { } }; - assertFalse(lispFunction.evaluateArguments()); + assertFalse(lispFunction.isArgumentListEvaluated()); } } diff --git a/test/function/builtin/special/DEFINE_SPECIALTester.java b/test/function/builtin/special/DEFINE_SPECIALTester.java index ae8d809..1114290 100644 --- a/test/function/builtin/special/DEFINE_SPECIALTester.java +++ b/test/function/builtin/special/DEFINE_SPECIALTester.java @@ -60,7 +60,7 @@ public class DEFINE_SPECIALTester { } @Test - public void defineSpecialDoesNotEvaluatesArguments() { + public void defineSpecialDoesNotEvaluateArguments() { evaluateString("(define-special f (x) (car x))"); assertSExpressionsMatch(parseString("quote"), evaluateString("(f '(1 2 3))")); } @@ -174,4 +174,13 @@ public class DEFINE_SPECIALTester { 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")); + } + } diff --git a/test/function/builtin/special/DEFMACROTester.java b/test/function/builtin/special/DEFMACROTester.java new file mode 100644 index 0000000..a1d2cb5 --- /dev/null +++ b/test/function/builtin/special/DEFMACROTester.java @@ -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")); + } + +} diff --git a/test/function/builtin/special/DEFUNTester.java b/test/function/builtin/special/DEFUNTester.java index 142a87c..77bb706 100644 --- a/test/function/builtin/special/DEFUNTester.java +++ b/test/function/builtin/special/DEFUNTester.java @@ -99,16 +99,16 @@ public class DEFUNTester { @Test public void redefineFunction_ActuallyRedefinesFunction() { - evaluateString("(defun myFunction2 () nil)"); - evaluateString("(defun myFunction2 () T)"); + evaluateString("(defun myFunction () nil)"); + evaluateString("(defun myFunction () T)"); assertSomethingPrinted(); - assertSExpressionsMatch(parseString("t"), evaluateString("(myFunction2)")); + assertSExpressionsMatch(parseString("t"), evaluateString("(myFunction)")); } @Test(expected = DottedArgumentListException.class) public void defunWithDottedLambdaList() { - evaluateString("(funcall 'defun 'x (cons 'a 'b) ())"); + evaluateString("(funcall 'defun 'f (cons 'a 'b) ())"); } @Test(expected = BadArgumentTypeException.class) @@ -118,24 +118,24 @@ public class DEFUNTester { @Test(expected = BadArgumentTypeException.class) public void defunWithBadLambdaList() { - evaluateString("(defun x a ())"); + evaluateString("(defun f a ())"); } @Test(expected = TooFewArgumentsException.class) public void defunWithTooFewArguments() { - evaluateString("(defun x)"); + evaluateString("(defun f)"); } @Test(expected = TooFewArgumentsException.class) public void defunFunctionAndCallWithTooFewArguments() { - evaluateString("(defun x (a b))"); - evaluateString("(x 'a)"); + evaluateString("(defun f (a b))"); + evaluateString("(f 'a)"); } @Test(expected = TooManyArgumentsException.class) public void defunFunctionAndCallWithTooManyArguments() { - evaluateString("(defun x (a b))"); - evaluateString("(x 'a 'b 'c)"); + evaluateString("(defun f (a b))"); + evaluateString("(f 'a 'b 'c)"); } @Test @@ -168,4 +168,13 @@ public class DEFUNTester { 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")); + } + }