From d1060a8aad2a0396f15c0a68ace7d3c5adf6d295 Mon Sep 17 00:00:00 2001 From: Mike Cifelli Date: Tue, 7 Mar 2017 13:15:40 -0500 Subject: [PATCH] Add aliases for several functions --- lisp/finance/interest-compounder-test.lisp | 36 ++++---- lisp/finance/interest-compounder.lisp | 14 +-- lisp/lang/dlambda.lisp | 29 +++--- src/function/builtin/predicate/ATOM.java | 2 +- src/function/builtin/predicate/EQ.java | 2 +- src/function/builtin/predicate/EQUAL.java | 2 +- src/function/builtin/predicate/LISTP.java | 2 +- src/function/builtin/predicate/NULL.java | 2 +- ...{DEFINE_MACRO.java => DEFINE_SPECIAL.java} | 6 +- src/function/builtin/special/PROGN.java | 2 +- src/table/FunctionTable.java | 2 +- .../builtin/predicate/ATOMTester.java | 5 ++ test/function/builtin/predicate/EQTester.java | 8 ++ .../builtin/predicate/EQUALTester.java | 7 ++ .../builtin/predicate/LISTPTester.java | 5 ++ .../builtin/predicate/NULLTester.java | 5 ++ ...OTester.java => DEFINE_SPECIALTester.java} | 88 +++++++++---------- .../function/builtin/special/PROGNTester.java | 6 ++ 18 files changed, 125 insertions(+), 98 deletions(-) rename src/function/builtin/special/{DEFINE_MACRO.java => DEFINE_SPECIAL.java} (73%) rename test/function/builtin/special/{DEFINE_MACROTester.java => DEFINE_SPECIALTester.java} (56%) diff --git a/lisp/finance/interest-compounder-test.lisp b/lisp/finance/interest-compounder-test.lisp index 7c73145..4cb61c0 100644 --- a/lisp/finance/interest-compounder-test.lisp +++ b/lisp/finance/interest-compounder-test.lisp @@ -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)))))) diff --git a/lisp/finance/interest-compounder.lisp b/lisp/finance/interest-compounder.lisp index d04f82a..d279085 100644 --- a/lisp/finance/interest-compounder.lisp +++ b/lisp/finance/interest-compounder.lisp @@ -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)))))))) diff --git a/lisp/lang/dlambda.lisp b/lisp/lang/dlambda.lisp index 47c1b8f..aafa625 100644 --- a/lisp/lang/dlambda.lisp +++ b/lisp/lang/dlambda.lisp @@ -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))))))) diff --git a/src/function/builtin/predicate/ATOM.java b/src/function/builtin/predicate/ATOM.java index 25e473b..5fa3c5e 100644 --- a/src/function/builtin/predicate/ATOM.java +++ b/src/function/builtin/predicate/ATOM.java @@ -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; diff --git a/src/function/builtin/predicate/EQ.java b/src/function/builtin/predicate/EQ.java index 0a6edab..6b6cf82 100644 --- a/src/function/builtin/predicate/EQ.java +++ b/src/function/builtin/predicate/EQ.java @@ -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; diff --git a/src/function/builtin/predicate/EQUAL.java b/src/function/builtin/predicate/EQUAL.java index 8813ba3..c03d161 100644 --- a/src/function/builtin/predicate/EQUAL.java +++ b/src/function/builtin/predicate/EQUAL.java @@ -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) { diff --git a/src/function/builtin/predicate/LISTP.java b/src/function/builtin/predicate/LISTP.java index 9aa9590..f3c8ff0 100644 --- a/src/function/builtin/predicate/LISTP.java +++ b/src/function/builtin/predicate/LISTP.java @@ -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; diff --git a/src/function/builtin/predicate/NULL.java b/src/function/builtin/predicate/NULL.java index 936e266..5a1d027 100644 --- a/src/function/builtin/predicate/NULL.java +++ b/src/function/builtin/predicate/NULL.java @@ -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; diff --git a/src/function/builtin/special/DEFINE_MACRO.java b/src/function/builtin/special/DEFINE_SPECIAL.java similarity index 73% rename from src/function/builtin/special/DEFINE_MACRO.java rename to src/function/builtin/special/DEFINE_SPECIAL.java index e0580d4..68c9c1b 100644 --- a/src/function/builtin/special/DEFINE_MACRO.java +++ b/src/function/builtin/special/DEFINE_SPECIAL.java @@ -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); } diff --git a/src/function/builtin/special/PROGN.java b/src/function/builtin/special/PROGN.java index 1c8974c..739c195 100644 --- a/src/function/builtin/special/PROGN.java +++ b/src/function/builtin/special/PROGN.java @@ -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; diff --git a/src/table/FunctionTable.java b/src/table/FunctionTable.java index 88cb99f..c1d1579 100644 --- a/src/table/FunctionTable.java +++ b/src/table/FunctionTable.java @@ -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); diff --git a/test/function/builtin/predicate/ATOMTester.java b/test/function/builtin/predicate/ATOMTester.java index 3ab28d4..23e982e 100644 --- a/test/function/builtin/predicate/ATOMTester.java +++ b/test/function/builtin/predicate/ATOMTester.java @@ -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))")); diff --git a/test/function/builtin/predicate/EQTester.java b/test/function/builtin/predicate/EQTester.java index d35a49f..b1daf17 100644 --- a/test/function/builtin/predicate/EQTester.java +++ b/test/function/builtin/predicate/EQTester.java @@ -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)"; diff --git a/test/function/builtin/predicate/EQUALTester.java b/test/function/builtin/predicate/EQUALTester.java index ddd9c58..1dc077d 100644 --- a/test/function/builtin/predicate/EQUALTester.java +++ b/test/function/builtin/predicate/EQUALTester.java @@ -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)"; diff --git a/test/function/builtin/predicate/LISTPTester.java b/test/function/builtin/predicate/LISTPTester.java index 0f760ce..e057c1b 100644 --- a/test/function/builtin/predicate/LISTPTester.java +++ b/test/function/builtin/predicate/LISTPTester.java @@ -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)")); diff --git a/test/function/builtin/predicate/NULLTester.java b/test/function/builtin/predicate/NULLTester.java index 460f073..691419b 100644 --- a/test/function/builtin/predicate/NULLTester.java +++ b/test/function/builtin/predicate/NULLTester.java @@ -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))")); diff --git a/test/function/builtin/special/DEFINE_MACROTester.java b/test/function/builtin/special/DEFINE_SPECIALTester.java similarity index 56% rename from test/function/builtin/special/DEFINE_MACROTester.java rename to test/function/builtin/special/DEFINE_SPECIALTester.java index e8adb18..0ff1dea 100644 --- a/test/function/builtin/special/DEFINE_MACROTester.java +++ b/test/function/builtin/special/DEFINE_SPECIALTester.java @@ -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)"); } diff --git a/test/function/builtin/special/PROGNTester.java b/test/function/builtin/special/PROGNTester.java index ad6c8bb..06316d2 100644 --- a/test/function/builtin/special/PROGNTester.java +++ b/test/function/builtin/special/PROGNTester.java @@ -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)))"));