Add aliases for several functions
This commit is contained in:
parent
e9fead08c2
commit
d1060a8aad
|
@ -6,64 +6,64 @@
|
||||||
(list
|
(list
|
||||||
|
|
||||||
(defun principal-initialized ()
|
(defun principal-initialized ()
|
||||||
(setf compounder (interest-compounder 1000 0))
|
(setq compounder (interest-compounder 1000 0))
|
||||||
(assert= 1000 (call compounder :get-principal)))
|
(assert= 1000 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun interest-rate-initialized ()
|
(defun interest-rate-initialized ()
|
||||||
(setf compounder (interest-compounder 0 10))
|
(setq compounder (interest-compounder 0 10))
|
||||||
(assert= 10 (call compounder :get-interest-rate)))
|
(assert= 10 (call compounder :get-interest-rate)))
|
||||||
|
|
||||||
(defun many-years-with-no-interest-rate ()
|
(defun many-years-with-no-interest-rate ()
|
||||||
(setf compounder (interest-compounder 1000 0))
|
(setq compounder (interest-compounder 1000 0))
|
||||||
(call compounder :move-forward-years 83)
|
(call compounder :move-forward-years 83)
|
||||||
(assert= 1000 (call compounder :get-principal)))
|
(assert= 1000 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun no-years-with-positive-interest-rate ()
|
(defun no-years-with-positive-interest-rate ()
|
||||||
(setf compounder (interest-compounder 1000 10))
|
(setq compounder (interest-compounder 1000 10))
|
||||||
(assert= 1000 (call compounder :get-principal)))
|
(assert= 1000 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun one-year-with-positive-interest-rate ()
|
(defun one-year-with-positive-interest-rate ()
|
||||||
(setf compounder (interest-compounder 100000 5))
|
(setq compounder (interest-compounder 100000 5))
|
||||||
(call compounder :move-forward-years 1)
|
(call compounder :move-forward-years 1)
|
||||||
(assert= 105000 (call compounder :get-principal)))
|
(assert= 105000 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun two-years-with-positive-interest-rate ()
|
(defun two-years-with-positive-interest-rate ()
|
||||||
(setf compounder (interest-compounder 100000 5))
|
(setq compounder (interest-compounder 100000 5))
|
||||||
(call compounder :move-forward-years 2)
|
(call compounder :move-forward-years 2)
|
||||||
(assert= 110250 (call compounder :get-principal)))
|
(assert= 110250 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun three-years-with-positive-interest-rate ()
|
(defun three-years-with-positive-interest-rate ()
|
||||||
(setf compounder (interest-compounder 100000 5))
|
(setq compounder (interest-compounder 100000 5))
|
||||||
(call compounder :move-forward-years 3)
|
(call compounder :move-forward-years 3)
|
||||||
(assert= 115763 (call compounder :get-principal)))
|
(assert= 115763 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun four-years-with-positive-interest-rate ()
|
(defun four-years-with-positive-interest-rate ()
|
||||||
(setf compounder (interest-compounder 100000 5))
|
(setq compounder (interest-compounder 100000 5))
|
||||||
(call compounder :move-forward-years 4)
|
(call compounder :move-forward-years 4)
|
||||||
(assert= 121551 (call compounder :get-principal)))
|
(assert= 121551 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun one-year-with-negative-interest-rate ()
|
(defun one-year-with-negative-interest-rate ()
|
||||||
(setf compounder (interest-compounder 100000 -5))
|
(setq compounder (interest-compounder 100000 -5))
|
||||||
(call compounder :move-forward-years 1)
|
(call compounder :move-forward-years 1)
|
||||||
(assert= 95000 (call compounder :get-principal)))
|
(assert= 95000 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun two-years-with-negative-interest-rate ()
|
(defun two-years-with-negative-interest-rate ()
|
||||||
(setf compounder (interest-compounder 100000 -5))
|
(setq compounder (interest-compounder 100000 -5))
|
||||||
(call compounder :move-forward-years 2)
|
(call compounder :move-forward-years 2)
|
||||||
(assert= 90250 (call compounder :get-principal)))
|
(assert= 90250 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun three-years-with-negative-interest-rate ()
|
(defun three-years-with-negative-interest-rate ()
|
||||||
(setf compounder (interest-compounder 100000 -5))
|
(setq compounder (interest-compounder 100000 -5))
|
||||||
(call compounder :move-forward-years 3)
|
(call compounder :move-forward-years 3)
|
||||||
(assert= 85737 (call compounder :get-principal)))
|
(assert= 85737 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun four-years-with-negative-interest-rate ()
|
(defun four-years-with-negative-interest-rate ()
|
||||||
(setf compounder (interest-compounder 100000 -5))
|
(setq compounder (interest-compounder 100000 -5))
|
||||||
(call compounder :move-forward-years 4)
|
(call compounder :move-forward-years 4)
|
||||||
(assert= 81450 (call compounder :get-principal)))
|
(assert= 81450 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun negative-number-of-years-does-nothing ()
|
(defun negative-number-of-years-does-nothing ()
|
||||||
(setf compounder (interest-compounder 100000 5))
|
(setq compounder (interest-compounder 100000 5))
|
||||||
(call compounder :move-forward-years -4)
|
(call compounder :move-forward-years -4)
|
||||||
(assert= 100000 (call compounder :get-principal))
|
(assert= 100000 (call compounder :get-principal))
|
||||||
(call compounder :move-forward-years 1)
|
(call compounder :move-forward-years 1)
|
||||||
|
@ -71,7 +71,7 @@
|
||||||
(assert= 105000 (call compounder :get-principal)))
|
(assert= 105000 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun zero-number-of-years-does-nothing ()
|
(defun zero-number-of-years-does-nothing ()
|
||||||
(setf compounder (interest-compounder 100000 5))
|
(setq compounder (interest-compounder 100000 5))
|
||||||
(call compounder :move-forward-years 0)
|
(call compounder :move-forward-years 0)
|
||||||
(assert= 100000 (call compounder :get-principal))
|
(assert= 100000 (call compounder :get-principal))
|
||||||
(call compounder :move-forward-years 1)
|
(call compounder :move-forward-years 1)
|
||||||
|
@ -79,25 +79,25 @@
|
||||||
(assert= 105000 (call compounder :get-principal)))
|
(assert= 105000 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun variable-interest-rate ()
|
(defun variable-interest-rate ()
|
||||||
(setf compounder (interest-compounder 100000 5))
|
(setq compounder (interest-compounder 100000 5))
|
||||||
(call compounder :move-forward-years 2)
|
(call compounder :move-forward-years 2)
|
||||||
(call compounder :set-interest-rate 10)
|
(call compounder :set-interest-rate 10)
|
||||||
(call compounder :move-forward-years 2)
|
(call compounder :move-forward-years 2)
|
||||||
(assert= 133403 (call compounder :get-principal)))
|
(assert= 133403 (call compounder :get-principal)))
|
||||||
|
|
||||||
(defun years-are-updated ()
|
(defun years-are-updated ()
|
||||||
(setf compounder (interest-compounder 100000 5))
|
(setq compounder (interest-compounder 100000 5))
|
||||||
(call compounder :move-forward-years 27)
|
(call compounder :move-forward-years 27)
|
||||||
(assert= 27 (call compounder :get-years-passed)))
|
(assert= 27 (call compounder :get-years-passed)))
|
||||||
|
|
||||||
(defun negative-number-of-years-does-not-update-years ()
|
(defun negative-number-of-years-does-not-update-years ()
|
||||||
(setf compounder (interest-compounder 100000 5))
|
(setq compounder (interest-compounder 100000 5))
|
||||||
(call compounder :move-forward-years 27)
|
(call compounder :move-forward-years 27)
|
||||||
(call compounder :move-forward-years -2)
|
(call compounder :move-forward-years -2)
|
||||||
(assert= 27 (call compounder :get-years-passed)))
|
(assert= 27 (call compounder :get-years-passed)))
|
||||||
|
|
||||||
(defun zero-number-of-years-does-not-update-years ()
|
(defun zero-number-of-years-does-not-update-years ()
|
||||||
(setf compounder (interest-compounder 100000 5))
|
(setq compounder (interest-compounder 100000 5))
|
||||||
(call compounder :move-forward-years 27)
|
(call compounder :move-forward-years 27)
|
||||||
(call compounder :move-forward-years 0)
|
(call compounder :move-forward-years 0)
|
||||||
(assert= 27 (call compounder :get-years-passed))))))
|
(assert= 27 (call compounder :get-years-passed))))))
|
||||||
|
|
|
@ -6,13 +6,13 @@
|
||||||
(interest-rate initial-interest-rate)
|
(interest-rate initial-interest-rate)
|
||||||
(years-passed 0))
|
(years-passed 0))
|
||||||
|
|
||||||
(setf private
|
(setq private
|
||||||
(eval
|
(eval
|
||||||
(dlambda
|
(dlambda
|
||||||
|
|
||||||
(:add-years (years)
|
(:add-years (years)
|
||||||
(if (> years 0)
|
(if (> years 0)
|
||||||
(setf years-passed (+ years-passed years))))
|
(setq years-passed (+ years-passed years))))
|
||||||
|
|
||||||
(:percent-of-number (n percentage)
|
(:percent-of-number (n percentage)
|
||||||
(if (> percentage 0)
|
(if (> percentage 0)
|
||||||
|
@ -21,13 +21,13 @@
|
||||||
|
|
||||||
(:compound-interest (years)
|
(:compound-interest (years)
|
||||||
(if (> years 0)
|
(if (> years 0)
|
||||||
(progn
|
(begin
|
||||||
(setf principal
|
(setq principal
|
||||||
(+ principal
|
(+ principal
|
||||||
(call private :percent-of-number principal interest-rate)))
|
(call private :percent-of-number principal interest-rate)))
|
||||||
(call private :compound-interest (- years 1))))))))
|
(call private :compound-interest (- years 1))))))))
|
||||||
|
|
||||||
(setf public
|
(setq public
|
||||||
(eval
|
(eval
|
||||||
(dlambda
|
(dlambda
|
||||||
|
|
||||||
|
@ -41,9 +41,9 @@
|
||||||
interest-rate)
|
interest-rate)
|
||||||
|
|
||||||
(:set-interest-rate (new-interest-rate)
|
(:set-interest-rate (new-interest-rate)
|
||||||
(setf interest-rate new-interest-rate))
|
(setq interest-rate new-interest-rate))
|
||||||
|
|
||||||
(:move-forward-years (years)
|
(:move-forward-years (years)
|
||||||
(progn
|
(begin
|
||||||
(call private :add-years years)
|
(call private :add-years years)
|
||||||
(call private :compound-interest years))))))))
|
(call private :compound-interest years))))))))
|
||||||
|
|
|
@ -1,28 +1,19 @@
|
||||||
(load "functions.lisp")
|
(load "functions.lisp")
|
||||||
|
|
||||||
(define-macro dlambda (&rest methods)
|
(define-special dlambda (&rest methods)
|
||||||
(cons
|
(cons 'lambda
|
||||||
(quote lambda)
|
(cons '(&rest arguments)
|
||||||
(cons
|
|
||||||
(quote (&rest arguments))
|
|
||||||
(list
|
(list
|
||||||
(cons
|
(cons 'case
|
||||||
(quote case)
|
(cons '(first arguments)
|
||||||
(cons
|
|
||||||
(quote (first arguments))
|
|
||||||
(mapcar
|
(mapcar
|
||||||
(lambda (method)
|
(lambda (method)
|
||||||
(cons
|
(cons (first method)
|
||||||
(first method)
|
|
||||||
(list
|
(list
|
||||||
(cons
|
(cons 'apply
|
||||||
(quote apply)
|
(cons (cons 'lambda (rest method))
|
||||||
(cons
|
|
||||||
(cons
|
|
||||||
(quote lambda)
|
|
||||||
(rest method))
|
|
||||||
(list
|
(list
|
||||||
(if (equal t (car method))
|
(if (equal t (car method))
|
||||||
(quote arguments)
|
'arguments
|
||||||
(quote (rest arguments)))))))))
|
'(rest arguments))))))))
|
||||||
methods)))))))
|
methods)))))))
|
||||||
|
|
|
@ -6,7 +6,7 @@ import static sexpression.Symbol.T;
|
||||||
import function.*;
|
import function.*;
|
||||||
import sexpression.*;
|
import sexpression.*;
|
||||||
|
|
||||||
@FunctionNames({ "ATOM" })
|
@FunctionNames({ "ATOM", "ATOM?" })
|
||||||
public class ATOM extends LispFunction {
|
public class ATOM extends LispFunction {
|
||||||
|
|
||||||
private ArgumentValidator argumentValidator;
|
private ArgumentValidator argumentValidator;
|
||||||
|
|
|
@ -6,7 +6,7 @@ import static sexpression.Symbol.T;
|
||||||
import function.*;
|
import function.*;
|
||||||
import sexpression.*;
|
import sexpression.*;
|
||||||
|
|
||||||
@FunctionNames({ "EQ" })
|
@FunctionNames({ "EQ", "EQ?" })
|
||||||
public class EQ extends LispFunction {
|
public class EQ extends LispFunction {
|
||||||
|
|
||||||
private ArgumentValidator argumentValidator;
|
private ArgumentValidator argumentValidator;
|
||||||
|
|
|
@ -6,7 +6,7 @@ import static sexpression.Symbol.T;
|
||||||
import function.*;
|
import function.*;
|
||||||
import sexpression.*;
|
import sexpression.*;
|
||||||
|
|
||||||
@FunctionNames({ "EQUAL" })
|
@FunctionNames({ "EQUAL", "EQUAL?" })
|
||||||
public class EQUAL extends LispFunction {
|
public class EQUAL extends LispFunction {
|
||||||
|
|
||||||
public static boolean isEqual(SExpression firstArgument, SExpression secondArgument) {
|
public static boolean isEqual(SExpression firstArgument, SExpression secondArgument) {
|
||||||
|
|
|
@ -6,7 +6,7 @@ import static sexpression.Symbol.T;
|
||||||
import function.*;
|
import function.*;
|
||||||
import sexpression.*;
|
import sexpression.*;
|
||||||
|
|
||||||
@FunctionNames({ "LISTP" })
|
@FunctionNames({ "LISTP", "LIST?" })
|
||||||
public class LISTP extends LispFunction {
|
public class LISTP extends LispFunction {
|
||||||
|
|
||||||
private ArgumentValidator argumentValidator;
|
private ArgumentValidator argumentValidator;
|
||||||
|
|
|
@ -6,7 +6,7 @@ import static sexpression.Symbol.T;
|
||||||
import function.*;
|
import function.*;
|
||||||
import sexpression.*;
|
import sexpression.*;
|
||||||
|
|
||||||
@FunctionNames({ "NULL" })
|
@FunctionNames({ "NULL", "NULL?" })
|
||||||
public class NULL extends LispFunction {
|
public class NULL extends LispFunction {
|
||||||
|
|
||||||
private ArgumentValidator argumentValidator;
|
private ArgumentValidator argumentValidator;
|
||||||
|
|
|
@ -3,10 +3,10 @@ package function.builtin.special;
|
||||||
import function.*;
|
import function.*;
|
||||||
import sexpression.*;
|
import sexpression.*;
|
||||||
|
|
||||||
@FunctionNames({ "DEFINE-MACRO" })
|
@FunctionNames({ "DEFINE-SPECIAL" })
|
||||||
public class DEFINE_MACRO extends Define {
|
public class DEFINE_SPECIAL extends Define {
|
||||||
|
|
||||||
public DEFINE_MACRO(String name) {
|
public DEFINE_SPECIAL(String name) {
|
||||||
super(name);
|
super(name);
|
||||||
}
|
}
|
||||||
|
|
|
@ -6,7 +6,7 @@ import static sexpression.Nil.NIL;
|
||||||
import function.*;
|
import function.*;
|
||||||
import sexpression.*;
|
import sexpression.*;
|
||||||
|
|
||||||
@FunctionNames({ "PROGN" })
|
@FunctionNames({ "PROGN", "BEGIN" })
|
||||||
public class PROGN extends LispSpecialFunction {
|
public class PROGN extends LispSpecialFunction {
|
||||||
|
|
||||||
private ArgumentValidator argumentValidator;
|
private ArgumentValidator argumentValidator;
|
||||||
|
|
|
@ -22,7 +22,7 @@ public class FunctionTable {
|
||||||
allBuiltIns.add(CASE.class);
|
allBuiltIns.add(CASE.class);
|
||||||
allBuiltIns.add(COND.class);
|
allBuiltIns.add(COND.class);
|
||||||
allBuiltIns.add(CONS.class);
|
allBuiltIns.add(CONS.class);
|
||||||
allBuiltIns.add(DEFINE_MACRO.class);
|
allBuiltIns.add(DEFINE_SPECIAL.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);
|
||||||
|
|
|
@ -14,6 +14,11 @@ public class ATOMTester {
|
||||||
assertT(evaluateString("(atom 'a)"));
|
assertT(evaluateString("(atom 'a)"));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@Test
|
||||||
|
public void atomIsAtomWithAlias() {
|
||||||
|
assertT(evaluateString("(atom? 'a)"));
|
||||||
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void listIsNotAtom() {
|
public void listIsNotAtom() {
|
||||||
assertNil(evaluateString("(atom '(1 2 3))"));
|
assertNil(evaluateString("(atom '(1 2 3))"));
|
||||||
|
|
|
@ -16,6 +16,14 @@ public class EQTester {
|
||||||
assertT(evaluateString(input));
|
assertT(evaluateString(input));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@Test
|
||||||
|
public void eqWithEqualAtomsAndAlias() {
|
||||||
|
String input = "(eq? 1 1)";
|
||||||
|
|
||||||
|
assertT(evaluateString(input));
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void eqWithUnequalAtoms() {
|
public void eqWithUnequalAtoms() {
|
||||||
String input = "(eq 1 2)";
|
String input = "(eq 1 2)";
|
||||||
|
|
|
@ -16,6 +16,13 @@ public class EQUALTester {
|
||||||
assertT(evaluateString(input));
|
assertT(evaluateString(input));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@Test
|
||||||
|
public void equalWithTwoEqualAtomsAndAlias() {
|
||||||
|
String input = "(equal? 'a 'a)";
|
||||||
|
|
||||||
|
assertT(evaluateString(input));
|
||||||
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void equalWithTwoUnequalAtoms() {
|
public void equalWithTwoUnequalAtoms() {
|
||||||
String input = "(equal 'a 'b)";
|
String input = "(equal 'a 'b)";
|
||||||
|
|
|
@ -14,6 +14,11 @@ public class LISTPTester {
|
||||||
assertT(evaluateString("(listp '(1))"));
|
assertT(evaluateString("(listp '(1))"));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@Test
|
||||||
|
public void listpWithListAndAlias() {
|
||||||
|
assertT(evaluateString("(list? '(1))"));
|
||||||
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void listpWithNonList() {
|
public void listpWithNonList() {
|
||||||
assertNil(evaluateString("(listp 1)"));
|
assertNil(evaluateString("(listp 1)"));
|
||||||
|
|
|
@ -14,6 +14,11 @@ public class NULLTester {
|
||||||
assertT(evaluateString("(null ())"));
|
assertT(evaluateString("(null ())"));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@Test
|
||||||
|
public void nilIsNullWithAlias() {
|
||||||
|
assertT(evaluateString("(null? ())"));
|
||||||
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void listIsNotNull() {
|
public void listIsNotNull() {
|
||||||
assertNil(evaluateString("(null '(1))"));
|
assertNil(evaluateString("(null '(1))"));
|
||||||
|
|
|
@ -13,12 +13,12 @@ import error.ErrorManager;
|
||||||
import function.ArgumentValidator.*;
|
import function.ArgumentValidator.*;
|
||||||
import function.UserDefinedFunction.IllegalKeywordRestPositionException;
|
import function.UserDefinedFunction.IllegalKeywordRestPositionException;
|
||||||
|
|
||||||
public class DEFINE_MACROTester {
|
public class DEFINE_SPECIALTester {
|
||||||
|
|
||||||
private ByteArrayOutputStream outputStream;
|
private ByteArrayOutputStream outputStream;
|
||||||
private RuntimeEnvironment environment;
|
private RuntimeEnvironment environment;
|
||||||
|
|
||||||
public DEFINE_MACROTester() {
|
public DEFINE_SPECIALTester() {
|
||||||
this.environment = RuntimeEnvironment.getInstance();
|
this.environment = RuntimeEnvironment.getInstance();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -44,59 +44,59 @@ public class DEFINE_MACROTester {
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void defineMacro() {
|
public void defineSpecial() {
|
||||||
String input = "(define-macro f () t)";
|
String input = "(define-special f () t)";
|
||||||
|
|
||||||
assertSExpressionsMatch(parseString("f"), evaluateString(input));
|
assertSExpressionsMatch(parseString("f"), evaluateString(input));
|
||||||
assertSExpressionsMatch(parseString("t"), evaluateString("(f)"));
|
assertSExpressionsMatch(parseString("t"), evaluateString("(f)"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void defineMacroWithEmptyBody() {
|
public void defineSpecialWithEmptyBody() {
|
||||||
String input = "(define-macro f ())";
|
String input = "(define-special f ())";
|
||||||
|
|
||||||
assertSExpressionsMatch(parseString("f"), evaluateString(input));
|
assertSExpressionsMatch(parseString("f"), evaluateString(input));
|
||||||
assertSExpressionsMatch(parseString("()"), evaluateString("(f)"));
|
assertSExpressionsMatch(parseString("()"), evaluateString("(f)"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void defineMacroDoesNotEvaluatesArguments() {
|
public void defineSpecialDoesNotEvaluatesArguments() {
|
||||||
evaluateString("(define-macro 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))"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void defineMacroAdd() {
|
public void defineSpecialAdd() {
|
||||||
evaluateString("(define-macro f (x) (+ (eval x) 23))");
|
evaluateString("(define-special f (x) (+ (eval x) 23))");
|
||||||
assertSExpressionsMatch(parseString("27"), evaluateString("(f (+ 2 2))"));
|
assertSExpressionsMatch(parseString("27"), evaluateString("(f (+ 2 2))"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void defineMacroSetVariable() {
|
public void defineSpecialSetVariable() {
|
||||||
evaluateString("(define-macro f (x) (set x 23))");
|
evaluateString("(define-special f (x) (set x 23))");
|
||||||
evaluateString("(f y)");
|
evaluateString("(f y)");
|
||||||
assertSExpressionsMatch(parseString("23"), evaluateString("y"));
|
assertSExpressionsMatch(parseString("23"), evaluateString("y"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void defineMacroVariableCapture() {
|
public void defineSpecialVariableCapture() {
|
||||||
evaluateString("(setf x 0)");
|
evaluateString("(setf x 0)");
|
||||||
evaluateString("(define-macro f (x) (set x 23))");
|
evaluateString("(define-special f (x) (set x 23))");
|
||||||
evaluateString("(f x)");
|
evaluateString("(f x)");
|
||||||
assertSExpressionsMatch(parseString("0"), evaluateString("x"));
|
assertSExpressionsMatch(parseString("0"), evaluateString("x"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void defineMacroAvoidVariableCaptureConvention() {
|
public void defineSpecialAvoidVariableCaptureConvention() {
|
||||||
evaluateString("(setf x 0)");
|
evaluateString("(setf x 0)");
|
||||||
evaluateString("(define-macro f (-x-) (set -x- 23))");
|
evaluateString("(define-special f (-x-) (set -x- 23))");
|
||||||
evaluateString("(f x)");
|
evaluateString("(f x)");
|
||||||
assertSExpressionsMatch(parseString("23"), evaluateString("x"));
|
assertSExpressionsMatch(parseString("23"), evaluateString("x"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void redefineMacro_DisplaysWarning() {
|
public void redefineSpecial_DisplaysWarning() {
|
||||||
String input = "(define-macro myFunction () nil)";
|
String input = "(define-special myFunction () nil)";
|
||||||
evaluateString(input);
|
evaluateString(input);
|
||||||
evaluateString(input);
|
evaluateString(input);
|
||||||
|
|
||||||
|
@ -104,73 +104,73 @@ public class DEFINE_MACROTester {
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void redefineMacro_ActuallyRedefinesMacro() {
|
public void redefineSpecial_ActuallyRedefinesSpecialFunction() {
|
||||||
evaluateString("(define-macro myMacro () nil)");
|
evaluateString("(define-special mySpecialFunction () nil)");
|
||||||
evaluateString("(define-macro myMacro () T)");
|
evaluateString("(define-special mySpecialFunction () T)");
|
||||||
|
|
||||||
assertSomethingPrinted();
|
assertSomethingPrinted();
|
||||||
assertSExpressionsMatch(parseString("t"), evaluateString("(myMacro)"));
|
assertSExpressionsMatch(parseString("t"), evaluateString("(mySpecialFunction)"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test(expected = DottedArgumentListException.class)
|
@Test(expected = DottedArgumentListException.class)
|
||||||
public void defineMacroWithDottedLambdaList() {
|
public void defineSpecialWithDottedLambdaList() {
|
||||||
evaluateString("(funcall 'define-macro 'x (cons 'a 'b) ())");
|
evaluateString("(funcall 'define-special 'x (cons 'a 'b) ())");
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test(expected = BadArgumentTypeException.class)
|
@Test(expected = BadArgumentTypeException.class)
|
||||||
public void defineMacroWithNonSymbolName() {
|
public void defineSpecialWithNonSymbolName() {
|
||||||
evaluateString("(define-macro 1 () ())");
|
evaluateString("(define-special 1 () ())");
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test(expected = BadArgumentTypeException.class)
|
@Test(expected = BadArgumentTypeException.class)
|
||||||
public void defineMacroWithBadLambdaList() {
|
public void defineSpecialWithBadLambdaList() {
|
||||||
evaluateString("(define-macro x a ())");
|
evaluateString("(define-special x a ())");
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test(expected = TooFewArgumentsException.class)
|
@Test(expected = TooFewArgumentsException.class)
|
||||||
public void defineMacroWithTooFewArguments() {
|
public void defineSpecialWithTooFewArguments() {
|
||||||
evaluateString("(define-macro x)");
|
evaluateString("(define-special x)");
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test(expected = TooFewArgumentsException.class)
|
@Test(expected = TooFewArgumentsException.class)
|
||||||
public void defineMacroAndCallWithTooFewArguments() {
|
public void defineSpecialAndCallWithTooFewArguments() {
|
||||||
evaluateString("(define-macro x (a b))");
|
evaluateString("(define-special x (a b))");
|
||||||
evaluateString("(x a)");
|
evaluateString("(x a)");
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test(expected = TooManyArgumentsException.class)
|
@Test(expected = TooManyArgumentsException.class)
|
||||||
public void defineMacroAndCallWithTooManyArguments() {
|
public void defineSpecialAndCallWithTooManyArguments() {
|
||||||
evaluateString("(define-macro x (a b))");
|
evaluateString("(define-special x (a b))");
|
||||||
evaluateString("(x a b c)");
|
evaluateString("(x a b c)");
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void defineMacroWithKeywordRestParameter() {
|
public void defineSpecialWithKeywordRestParameter() {
|
||||||
evaluateString("(define-macro f (&rest x) (car x))");
|
evaluateString("(define-special f (&rest x) (car x))");
|
||||||
assertSExpressionsMatch(parseString("1"), evaluateString("(f 1 2 3 4 5)"));
|
assertSExpressionsMatch(parseString("1"), evaluateString("(f 1 2 3 4 5)"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void defineMacroWithNormalAndKeywordRestParameter() {
|
public void defineSpecialWithNormalAndKeywordRestParameter() {
|
||||||
evaluateString("(define-macro f (a &rest b) (cons a b))");
|
evaluateString("(define-special f (a &rest b) (cons a b))");
|
||||||
assertSExpressionsMatch(parseString("(1 2 3 4 5)"), evaluateString("(f 1 2 3 4 5)"));
|
assertSExpressionsMatch(parseString("(1 2 3 4 5)"), evaluateString("(f 1 2 3 4 5)"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test(expected = IllegalKeywordRestPositionException.class)
|
@Test(expected = IllegalKeywordRestPositionException.class)
|
||||||
public void defineMacroWithParametersFollowingKeywordRest() {
|
public void defineSpecialWithParametersFollowingKeywordRest() {
|
||||||
evaluateString("(define-macro f (a &rest b c) (cons a b))");
|
evaluateString("(define-special f (a &rest b c) (cons a b))");
|
||||||
evaluateString("(f 1 2 3)");
|
evaluateString("(f 1 2 3)");
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void defineMacroWithKeywordRest_CallWithNoArguments() {
|
public void defineSpecialWithKeywordRest_CallWithNoArguments() {
|
||||||
evaluateString("(define-macro f (&rest a) (car a))");
|
evaluateString("(define-special f (&rest a) (car a))");
|
||||||
assertSExpressionsMatch(parseString("nil"), evaluateString("(f)"));
|
assertSExpressionsMatch(parseString("nil"), evaluateString("(f)"));
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test(expected = TooFewArgumentsException.class)
|
@Test(expected = TooFewArgumentsException.class)
|
||||||
public void defineMacroWithNormalAndKeywordRest_CallWithNoArguments() {
|
public void defineSpecialWithNormalAndKeywordRest_CallWithNoArguments() {
|
||||||
evaluateString("(define-macro f (a &rest b) a)");
|
evaluateString("(define-special f (a &rest b) a)");
|
||||||
evaluateString("(f)");
|
evaluateString("(f)");
|
||||||
}
|
}
|
||||||
|
|
|
@ -22,6 +22,12 @@ public class PROGNTester {
|
||||||
assertSExpressionsMatch(parseString("5"), evaluateString("(progn 1 2 3 4 5)"));
|
assertSExpressionsMatch(parseString("5"), evaluateString("(progn 1 2 3 4 5)"));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@Test
|
||||||
|
public void beginWithSeveralArguments() {
|
||||||
|
assertSExpressionsMatch(parseString("5"), evaluateString("(begin 1 2 3 4 5)"));
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void prognEvaluatesArgument() {
|
public void prognEvaluatesArgument() {
|
||||||
assertSExpressionsMatch(parseString("1"), evaluateString("(progn (car '(1 2 3)))"));
|
assertSExpressionsMatch(parseString("1"), evaluateString("(progn (car '(1 2 3)))"));
|
||||||
|
|
Loading…
Reference in New Issue