Add aliases for several functions

This commit is contained in:
Mike Cifelli 2017-03-07 13:15:40 -05:00
parent e9fead08c2
commit d1060a8aad
18 changed files with 125 additions and 98 deletions

View File

@ -6,64 +6,64 @@
(list
(defun principal-initialized ()
(setf compounder (interest-compounder 1000 0))
(setq compounder (interest-compounder 1000 0))
(assert= 1000 (call compounder :get-principal)))
(defun interest-rate-initialized ()
(setf compounder (interest-compounder 0 10))
(setq compounder (interest-compounder 0 10))
(assert= 10 (call compounder :get-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)
(assert= 1000 (call compounder :get-principal)))
(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)))
(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)
(assert= 105000 (call compounder :get-principal)))
(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)
(assert= 110250 (call compounder :get-principal)))
(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)
(assert= 115763 (call compounder :get-principal)))
(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)
(assert= 121551 (call compounder :get-principal)))
(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)
(assert= 95000 (call compounder :get-principal)))
(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)
(assert= 90250 (call compounder :get-principal)))
(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)
(assert= 85737 (call compounder :get-principal)))
(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)
(assert= 81450 (call compounder :get-principal)))
(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)
(assert= 100000 (call compounder :get-principal))
(call compounder :move-forward-years 1)
@ -71,7 +71,7 @@
(assert= 105000 (call compounder :get-principal)))
(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)
(assert= 100000 (call compounder :get-principal))
(call compounder :move-forward-years 1)
@ -79,25 +79,25 @@
(assert= 105000 (call compounder :get-principal)))
(defun variable-interest-rate ()
(setf compounder (interest-compounder 100000 5))
(setq compounder (interest-compounder 100000 5))
(call compounder :move-forward-years 2)
(call compounder :set-interest-rate 10)
(call compounder :move-forward-years 2)
(assert= 133403 (call compounder :get-principal)))
(defun years-are-updated ()
(setf compounder (interest-compounder 100000 5))
(setq compounder (interest-compounder 100000 5))
(call compounder :move-forward-years 27)
(assert= 27 (call compounder :get-years-passed)))
(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 -2)
(assert= 27 (call compounder :get-years-passed)))
(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 0)
(assert= 27 (call compounder :get-years-passed))))))

View File

@ -6,13 +6,13 @@
(interest-rate initial-interest-rate)
(years-passed 0))
(setf private
(setq private
(eval
(dlambda
(:add-years (years)
(if (> years 0)
(setf years-passed (+ years-passed years))))
(setq years-passed (+ years-passed years))))
(:percent-of-number (n percentage)
(if (> percentage 0)
@ -21,13 +21,13 @@
(:compound-interest (years)
(if (> years 0)
(progn
(setf principal
(begin
(setq principal
(+ principal
(call private :percent-of-number principal interest-rate)))
(call private :compound-interest (- years 1))))))))
(setf public
(setq public
(eval
(dlambda
@ -41,9 +41,9 @@
interest-rate)
(:set-interest-rate (new-interest-rate)
(setf interest-rate new-interest-rate))
(setq interest-rate new-interest-rate))
(:move-forward-years (years)
(progn
(begin
(call private :add-years years)
(call private :compound-interest years))))))))

View File

@ -1,28 +1,19 @@
(load "functions.lisp")
(define-macro dlambda (&rest methods)
(cons
(quote lambda)
(cons
(quote (&rest arguments))
(define-special dlambda (&rest methods)
(cons 'lambda
(cons '(&rest arguments)
(list
(cons
(quote case)
(cons
(quote (first arguments))
(cons 'case
(cons '(first arguments)
(mapcar
(lambda (method)
(cons
(first method)
(cons (first method)
(list
(cons
(quote apply)
(cons
(cons
(quote lambda)
(rest method))
(cons 'apply
(cons (cons 'lambda (rest method))
(list
(if (equal t (car method))
(quote arguments)
(quote (rest arguments)))))))))
'arguments
'(rest arguments))))))))
methods)))))))

View File

@ -6,7 +6,7 @@ import static sexpression.Symbol.T;
import function.*;
import sexpression.*;
@FunctionNames({ "ATOM" })
@FunctionNames({ "ATOM", "ATOM?" })
public class ATOM extends LispFunction {
private ArgumentValidator argumentValidator;

View File

@ -6,7 +6,7 @@ import static sexpression.Symbol.T;
import function.*;
import sexpression.*;
@FunctionNames({ "EQ" })
@FunctionNames({ "EQ", "EQ?" })
public class EQ extends LispFunction {
private ArgumentValidator argumentValidator;

View File

@ -6,7 +6,7 @@ import static sexpression.Symbol.T;
import function.*;
import sexpression.*;
@FunctionNames({ "EQUAL" })
@FunctionNames({ "EQUAL", "EQUAL?" })
public class EQUAL extends LispFunction {
public static boolean isEqual(SExpression firstArgument, SExpression secondArgument) {

View File

@ -6,7 +6,7 @@ import static sexpression.Symbol.T;
import function.*;
import sexpression.*;
@FunctionNames({ "LISTP" })
@FunctionNames({ "LISTP", "LIST?" })
public class LISTP extends LispFunction {
private ArgumentValidator argumentValidator;

View File

@ -6,7 +6,7 @@ import static sexpression.Symbol.T;
import function.*;
import sexpression.*;
@FunctionNames({ "NULL" })
@FunctionNames({ "NULL", "NULL?" })
public class NULL extends LispFunction {
private ArgumentValidator argumentValidator;

View File

@ -3,10 +3,10 @@ package function.builtin.special;
import function.*;
import sexpression.*;
@FunctionNames({ "DEFINE-MACRO" })
public class DEFINE_MACRO extends Define {
@FunctionNames({ "DEFINE-SPECIAL" })
public class DEFINE_SPECIAL extends Define {
public DEFINE_MACRO(String name) {
public DEFINE_SPECIAL(String name) {
super(name);
}

View File

@ -6,7 +6,7 @@ import static sexpression.Nil.NIL;
import function.*;
import sexpression.*;
@FunctionNames({ "PROGN" })
@FunctionNames({ "PROGN", "BEGIN" })
public class PROGN extends LispSpecialFunction {
private ArgumentValidator argumentValidator;

View File

@ -22,7 +22,7 @@ public class FunctionTable {
allBuiltIns.add(CASE.class);
allBuiltIns.add(COND.class);
allBuiltIns.add(CONS.class);
allBuiltIns.add(DEFINE_MACRO.class);
allBuiltIns.add(DEFINE_SPECIAL.class);
allBuiltIns.add(DEFUN.class);
allBuiltIns.add(DIVIDE.class);
allBuiltIns.add(EQ.class);

View File

@ -14,6 +14,11 @@ public class ATOMTester {
assertT(evaluateString("(atom 'a)"));
}
@Test
public void atomIsAtomWithAlias() {
assertT(evaluateString("(atom? 'a)"));
}
@Test
public void listIsNotAtom() {
assertNil(evaluateString("(atom '(1 2 3))"));

View File

@ -16,6 +16,14 @@ public class EQTester {
assertT(evaluateString(input));
}
@Test
public void eqWithEqualAtomsAndAlias() {
String input = "(eq? 1 1)";
assertT(evaluateString(input));
}
@Test
public void eqWithUnequalAtoms() {
String input = "(eq 1 2)";

View File

@ -16,6 +16,13 @@ public class EQUALTester {
assertT(evaluateString(input));
}
@Test
public void equalWithTwoEqualAtomsAndAlias() {
String input = "(equal? 'a 'a)";
assertT(evaluateString(input));
}
@Test
public void equalWithTwoUnequalAtoms() {
String input = "(equal 'a 'b)";

View File

@ -14,6 +14,11 @@ public class LISTPTester {
assertT(evaluateString("(listp '(1))"));
}
@Test
public void listpWithListAndAlias() {
assertT(evaluateString("(list? '(1))"));
}
@Test
public void listpWithNonList() {
assertNil(evaluateString("(listp 1)"));

View File

@ -14,6 +14,11 @@ public class NULLTester {
assertT(evaluateString("(null ())"));
}
@Test
public void nilIsNullWithAlias() {
assertT(evaluateString("(null? ())"));
}
@Test
public void listIsNotNull() {
assertNil(evaluateString("(null '(1))"));

View File

@ -13,12 +13,12 @@ import error.ErrorManager;
import function.ArgumentValidator.*;
import function.UserDefinedFunction.IllegalKeywordRestPositionException;
public class DEFINE_MACROTester {
public class DEFINE_SPECIALTester {
private ByteArrayOutputStream outputStream;
private RuntimeEnvironment environment;
public DEFINE_MACROTester() {
public DEFINE_SPECIALTester() {
this.environment = RuntimeEnvironment.getInstance();
}
@ -44,59 +44,59 @@ public class DEFINE_MACROTester {
}
@Test
public void defineMacro() {
String input = "(define-macro f () t)";
public void defineSpecial() {
String input = "(define-special f () t)";
assertSExpressionsMatch(parseString("f"), evaluateString(input));
assertSExpressionsMatch(parseString("t"), evaluateString("(f)"));
}
@Test
public void defineMacroWithEmptyBody() {
String input = "(define-macro f ())";
public void defineSpecialWithEmptyBody() {
String input = "(define-special f ())";
assertSExpressionsMatch(parseString("f"), evaluateString(input));
assertSExpressionsMatch(parseString("()"), evaluateString("(f)"));
}
@Test
public void defineMacroDoesNotEvaluatesArguments() {
evaluateString("(define-macro f (x) (car x))");
public void defineSpecialDoesNotEvaluatesArguments() {
evaluateString("(define-special f (x) (car x))");
assertSExpressionsMatch(parseString("quote"), evaluateString("(f '(1 2 3))"));
}
@Test
public void defineMacroAdd() {
evaluateString("(define-macro f (x) (+ (eval x) 23))");
public void defineSpecialAdd() {
evaluateString("(define-special f (x) (+ (eval x) 23))");
assertSExpressionsMatch(parseString("27"), evaluateString("(f (+ 2 2))"));
}
@Test
public void defineMacroSetVariable() {
evaluateString("(define-macro f (x) (set x 23))");
public void defineSpecialSetVariable() {
evaluateString("(define-special f (x) (set x 23))");
evaluateString("(f y)");
assertSExpressionsMatch(parseString("23"), evaluateString("y"));
}
@Test
public void defineMacroVariableCapture() {
public void defineSpecialVariableCapture() {
evaluateString("(setf x 0)");
evaluateString("(define-macro f (x) (set x 23))");
evaluateString("(define-special f (x) (set x 23))");
evaluateString("(f x)");
assertSExpressionsMatch(parseString("0"), evaluateString("x"));
}
@Test
public void defineMacroAvoidVariableCaptureConvention() {
public void defineSpecialAvoidVariableCaptureConvention() {
evaluateString("(setf x 0)");
evaluateString("(define-macro f (-x-) (set -x- 23))");
evaluateString("(define-special f (-x-) (set -x- 23))");
evaluateString("(f x)");
assertSExpressionsMatch(parseString("23"), evaluateString("x"));
}
@Test
public void redefineMacro_DisplaysWarning() {
String input = "(define-macro myFunction () nil)";
public void redefineSpecial_DisplaysWarning() {
String input = "(define-special myFunction () nil)";
evaluateString(input);
evaluateString(input);
@ -104,73 +104,73 @@ public class DEFINE_MACROTester {
}
@Test
public void redefineMacro_ActuallyRedefinesMacro() {
evaluateString("(define-macro myMacro () nil)");
evaluateString("(define-macro myMacro () T)");
public void redefineSpecial_ActuallyRedefinesSpecialFunction() {
evaluateString("(define-special mySpecialFunction () nil)");
evaluateString("(define-special mySpecialFunction () T)");
assertSomethingPrinted();
assertSExpressionsMatch(parseString("t"), evaluateString("(myMacro)"));
assertSExpressionsMatch(parseString("t"), evaluateString("(mySpecialFunction)"));
}
@Test(expected = DottedArgumentListException.class)
public void defineMacroWithDottedLambdaList() {
evaluateString("(funcall 'define-macro 'x (cons 'a 'b) ())");
public void defineSpecialWithDottedLambdaList() {
evaluateString("(funcall 'define-special 'x (cons 'a 'b) ())");
}
@Test(expected = BadArgumentTypeException.class)
public void defineMacroWithNonSymbolName() {
evaluateString("(define-macro 1 () ())");
public void defineSpecialWithNonSymbolName() {
evaluateString("(define-special 1 () ())");
}
@Test(expected = BadArgumentTypeException.class)
public void defineMacroWithBadLambdaList() {
evaluateString("(define-macro x a ())");
public void defineSpecialWithBadLambdaList() {
evaluateString("(define-special x a ())");
}
@Test(expected = TooFewArgumentsException.class)
public void defineMacroWithTooFewArguments() {
evaluateString("(define-macro x)");
public void defineSpecialWithTooFewArguments() {
evaluateString("(define-special x)");
}
@Test(expected = TooFewArgumentsException.class)
public void defineMacroAndCallWithTooFewArguments() {
evaluateString("(define-macro x (a b))");
public void defineSpecialAndCallWithTooFewArguments() {
evaluateString("(define-special x (a b))");
evaluateString("(x a)");
}
@Test(expected = TooManyArgumentsException.class)
public void defineMacroAndCallWithTooManyArguments() {
evaluateString("(define-macro x (a b))");
public void defineSpecialAndCallWithTooManyArguments() {
evaluateString("(define-special x (a b))");
evaluateString("(x a b c)");
}
@Test
public void defineMacroWithKeywordRestParameter() {
evaluateString("(define-macro f (&rest x) (car x))");
public void defineSpecialWithKeywordRestParameter() {
evaluateString("(define-special f (&rest x) (car x))");
assertSExpressionsMatch(parseString("1"), evaluateString("(f 1 2 3 4 5)"));
}
@Test
public void defineMacroWithNormalAndKeywordRestParameter() {
evaluateString("(define-macro f (a &rest b) (cons a b))");
public void defineSpecialWithNormalAndKeywordRestParameter() {
evaluateString("(define-special f (a &rest b) (cons a b))");
assertSExpressionsMatch(parseString("(1 2 3 4 5)"), evaluateString("(f 1 2 3 4 5)"));
}
@Test(expected = IllegalKeywordRestPositionException.class)
public void defineMacroWithParametersFollowingKeywordRest() {
evaluateString("(define-macro f (a &rest b c) (cons a b))");
public void defineSpecialWithParametersFollowingKeywordRest() {
evaluateString("(define-special f (a &rest b c) (cons a b))");
evaluateString("(f 1 2 3)");
}
@Test
public void defineMacroWithKeywordRest_CallWithNoArguments() {
evaluateString("(define-macro f (&rest a) (car a))");
public void defineSpecialWithKeywordRest_CallWithNoArguments() {
evaluateString("(define-special f (&rest a) (car a))");
assertSExpressionsMatch(parseString("nil"), evaluateString("(f)"));
}
@Test(expected = TooFewArgumentsException.class)
public void defineMacroWithNormalAndKeywordRest_CallWithNoArguments() {
evaluateString("(define-macro f (a &rest b) a)");
public void defineSpecialWithNormalAndKeywordRest_CallWithNoArguments() {
evaluateString("(define-special f (a &rest b) a)");
evaluateString("(f)");
}

View File

@ -22,6 +22,12 @@ public class PROGNTester {
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
public void prognEvaluatesArgument() {
assertSExpressionsMatch(parseString("1"), evaluateString("(progn (car '(1 2 3)))"));