diff --git a/fitnesse/FitNesseRoot/LispInterpreter/MultipleMethodObject.wiki b/fitnesse/FitNesseRoot/LispInterpreter/MultipleMethodObject.wiki index 7354ef0..f6387c4 100644 --- a/fitnesse/FitNesseRoot/LispInterpreter/MultipleMethodObject.wiki +++ b/fitnesse/FitNesseRoot/LispInterpreter/MultipleMethodObject.wiki @@ -3,23 +3,12 @@ Test --- An object with multiple methods. -| script | lisp interpreter fixture | -| show | evaluate text |!- - -(defun counter-class () - (let ((counter 0)) - (lambda (msg) - (case msg - ((:inc) - (setq counter (+ counter 1))) - ((:dec) - (setq counter (- counter 1))))))) - - -!| -| show | evaluate text | (setq my-counter (counter-class)) | -| check | evaluate text | (funcall my-counter :inc) | 1 | -| check | evaluate text | (funcall my-counter :inc) | 2 | -| check | evaluate text | (funcall my-counter :inc) | 3 | -| check | evaluate text | (funcall my-counter :dec) | 2 | -| check | evaluate text | (funcall my-counter :dec) | 1 | -| check | evaluate text | (funcall my-counter :dec) | 0 | +| script | lisp interpreter fixture | +| show | evaluate text | (load "lisp/object/multiple-methods.lisp") | +| show | evaluate text | (setq my-counter (counter-class)) | +| check | evaluate text | (funcall my-counter :inc) | 1 | +| check | evaluate text | (funcall my-counter :inc) | 2 | +| check | evaluate text | (funcall my-counter :inc) | 3 | +| check | evaluate text | (funcall my-counter :dec) | 2 | +| check | evaluate text | (funcall my-counter :dec) | 1 | +| check | evaluate text | (funcall my-counter :dec) | 0 | diff --git a/fitnesse/FitNesseRoot/LispInterpreter/ObjectComposition.wiki b/fitnesse/FitNesseRoot/LispInterpreter/ObjectComposition.wiki index 790fc3c..d60f782 100644 --- a/fitnesse/FitNesseRoot/LispInterpreter/ObjectComposition.wiki +++ b/fitnesse/FitNesseRoot/LispInterpreter/ObjectComposition.wiki @@ -4,7 +4,7 @@ Test Shows object composition, a default method, and two different ways of referencing objects. | script | lisp interpreter fixture | -| check | evaluate text | (load "lisp/object/fruit-counter.lisp") | T | +| check | evaluate text | (load "lisp/object/composition.lisp") | T | | check | evaluate text | (my-fruits :inc-apples) | 1 | | check | evaluate text | (my-fruits :inc-apples) | 2 | | check | evaluate text | (funcall my-fruits2 :dec-bananas) | 9999 | diff --git a/fitnesse/FitNesseRoot/LispInterpreter/StaticVariable.wiki b/fitnesse/FitNesseRoot/LispInterpreter/StaticVariable.wiki index c1efdf2..5a50126 100644 --- a/fitnesse/FitNesseRoot/LispInterpreter/StaticVariable.wiki +++ b/fitnesse/FitNesseRoot/LispInterpreter/StaticVariable.wiki @@ -5,22 +5,7 @@ Shows the usage of a static variable. ''"Let Over Lambda Over Let Over Lambda"'' | script | lisp interpreter fixture | -| show | evaluate text | !- - -(let ((direction 'up)) - (defun toggle-counter-direction () - (setq direction - (if (eq direction 'up) - 'down - 'up))) - -(defun counter-class () - (let ((counter 0)) - (lambda () - (if (eq direction 'up) - (setq counter (+ counter 1)) - (setq counter (- counter 1))))))) - -!| +| show | evaluate text | (load "lisp/object/static.lisp") | | show | evaluate text | (setq my-counter (counter-class)) | | check | evaluate text | (funcall my-counter) | 1 | | check | evaluate text | (funcall my-counter) | 2 | diff --git a/fitnesse/FitNesseRoot/RecentChanges.wiki b/fitnesse/FitNesseRoot/RecentChanges.wiki index cb09c74..f1fdeb3 100644 --- a/fitnesse/FitNesseRoot/RecentChanges.wiki +++ b/fitnesse/FitNesseRoot/RecentChanges.wiki @@ -1,7 +1,7 @@ +|LispInterpreter.MultipleMethodObject||16:50:19 Mon, Mar 06, 2017| +|LispInterpreter.ObjectComposition||16:35:10 Mon, Mar 06, 2017| +|LispInterpreter.StaticVariable||16:33:23 Mon, Mar 06, 2017| |LispInterpreter.LexicalClosures||12:38:02 Mon, Mar 06, 2017| -|LispInterpreter.ObjectComposition||12:30:58 Mon, Mar 06, 2017| -|LispInterpreter.StaticVariable||12:30:28 Mon, Mar 06, 2017| -|LispInterpreter.MultipleMethodObject||12:28:58 Mon, Mar 06, 2017| |LispInterpreter.SuiteSetUp||12:20:29 Mon, Mar 06, 2017| |LispInterpreter.SuiteTearDown||12:17:37 Mon, Mar 06, 2017| |LispInterpreter.SetUp||12:17:15 Mon, Mar 06, 2017| diff --git a/lisp/finance/interest-compounder-test.lisp b/lisp/finance/interest-compounder-test.lisp new file mode 100644 index 0000000..aad6e27 --- /dev/null +++ b/lisp/finance/interest-compounder-test.lisp @@ -0,0 +1,80 @@ +(load "../unit/unit-test.lisp") +(load "interest-compounder.lisp") + +(unit + (let ((compounder)) + (list + + (defun principal-initialized () + (setf compounder (interest-compounder 1000 0)) + (assert= 1000 (funcall compounder :get-principal))) + + (defun interest-rate-initialized () + (setf compounder (interest-compounder 0 10)) + (assert= 10 (funcall compounder :get-interest-rate))) + + (defun many-years-with-no-interest-rate () + (setf compounder (interest-compounder 1000 0)) + (funcall compounder :move-forward-years 83) + (assert= 1000 (funcall compounder :get-principal))) + + (defun no-years-with-positive-interest-rate () + (setf compounder (interest-compounder 1000 10)) + (assert= 1000 (funcall compounder :get-principal))) + + (defun one-year-with-positive-interest-rate () + (setf compounder (interest-compounder 100000 5)) + (funcall compounder :move-forward-one-year) + (assert= 105000 (funcall compounder :get-principal))) + + (defun two-years-with-positive-interest-rate () + (setf compounder (interest-compounder 100000 5)) + (funcall compounder :move-forward-one-year) + (funcall compounder :move-forward-one-year) + (assert= 110250 (funcall compounder :get-principal))) + + (defun three-years-with-positive-interest-rate () + (setf compounder (interest-compounder 100000 5)) + (funcall compounder :move-forward-years 3) + (assert= 115763 (funcall compounder :get-principal))) + + (defun four-years-with-positive-interest-rate () + (setf compounder (interest-compounder 100000 5)) + (funcall compounder :move-forward-years 4) + (assert= 121551 (funcall compounder :get-principal))) + + (defun one-year-with-negative-interest-rate () + (setf compounder (interest-compounder 100000 -5)) + (funcall compounder :move-forward-years 1) + (assert= 95000 (funcall compounder :get-principal))) + + (defun two-years-with-negative-interest-rate () + (setf compounder (interest-compounder 100000 -5)) + (funcall compounder :move-forward-years 2) + (assert= 90250 (funcall compounder :get-principal))) + + (defun three-years-with-negative-interest-rate () + (setf compounder (interest-compounder 100000 -5)) + (funcall compounder :move-forward-years 3) + (assert= 85737 (funcall compounder :get-principal))) + + (defun four-years-with-negative-interest-rate () + (setf compounder (interest-compounder 100000 -5)) + (funcall compounder :move-forward-years 4) + (assert= 81450 (funcall compounder :get-principal))) + + (defun negative-number-of-years-does-nothing () + (setf compounder (interest-compounder 100000 5)) + (funcall compounder :move-forward-years -4) + (assert= 100000 (funcall compounder :get-principal)) + (funcall compounder :move-forward-years 1) + (funcall compounder :move-forward-years -4) + (assert= 105000 (funcall compounder :get-principal))) + + (defun zero-number-of-years-does-nothing () + (setf compounder (interest-compounder 100000 5)) + (funcall compounder :move-forward-years 0) + (assert= 100000 (funcall compounder :get-principal)) + (funcall compounder :move-forward-years 1) + (funcall compounder :move-forward-years 0) + (assert= 105000 (funcall compounder :get-principal)))))) diff --git a/lisp/finance/interest-compounder.lisp b/lisp/finance/interest-compounder.lisp new file mode 100644 index 0000000..932fb52 --- /dev/null +++ b/lisp/finance/interest-compounder.lisp @@ -0,0 +1,39 @@ +(load "../lang/dlambda.lisp") + +(defun interest-compounder (initial-principal initial-interest-rate) + (let ((private) (public) + (principal initial-principal) + (interest-rate initial-interest-rate)) + + (setf private + (eval + (dlambda + + (:percent-of-number (n percentage) + (if (> percentage 0) + (/ (+ (* n percentage) 50) 100) + (/ (- (* n percentage) 50) 100))) + + (:compound-interest (years) + (if (> years 0) + (progn + (setf principal + (+ principal + (call private :percent-of-number principal interest-rate))) + (call private :compound-interest (- years 1)))))))) + + (setf public + (eval + (dlambda + + (:get-principal () + principal) + + (:get-interest-rate () + interest-rate) + + (:move-forward-one-year () + (call private :compound-interest 1)) + + (:move-forward-years (years) + (call private :compound-interest years))))))) diff --git a/lisp/object/fruit-counter.lisp b/lisp/object/composition.lisp similarity index 99% rename from lisp/object/fruit-counter.lisp rename to lisp/object/composition.lisp index 11eea5e..22c0f89 100644 --- a/lisp/object/fruit-counter.lisp +++ b/lisp/object/composition.lisp @@ -30,51 +30,39 @@ (:inc-apples () (funcall apple-counter :inc)) - (:dec-apples () (funcall apple-counter :dec)) - (:get-apples () (funcall apple-counter :get)) - (:set-apples (value) (funcall apple-counter :set value)) - (:inc-bananas () (funcall banana-counter :inc)) - (:dec-bananas () (funcall banana-counter :dec)) - (:get-bananas () (funcall banana-counter :get)) - (:set-bananas (value) (funcall banana-counter :set value)) - (:inc-coconuts () (funcall coconut-counter :inc)) - (:dec-coconuts () (funcall coconut-counter :dec)) - (:get-coconuts () (funcall coconut-counter :get)) - (:set-coconuts (value) (funcall coconut-counter :set value)) - (t (&rest arguments) (list (list 'apples (funcall apple-counter :get)) diff --git a/lisp/object/multiple-methods.lisp b/lisp/object/multiple-methods.lisp new file mode 100644 index 0000000..23d2aa6 --- /dev/null +++ b/lisp/object/multiple-methods.lisp @@ -0,0 +1,6 @@ +(defun counter-class () + (let ((counter 0)) + (lambda (msg) + (case msg + ((:inc) (setq counter (+ counter 1))) + ((:dec) (setq counter (- counter 1))))))) diff --git a/lisp/object/static.lisp b/lisp/object/static.lisp new file mode 100644 index 0000000..831f0cb --- /dev/null +++ b/lisp/object/static.lisp @@ -0,0 +1,13 @@ +(let ((direction 'up)) + (defun toggle-counter-direction () + (setq direction + (if (eq direction 'up) + 'down + 'up))) + + (defun counter-class () + (let ((counter 0)) + (lambda () + (if (eq direction 'up) + (setq counter (+ counter 1)) + (setq counter (- counter 1))))))) diff --git a/src/function/builtin/FUNCALL.java b/src/function/builtin/FUNCALL.java index 6cb64c6..77cf373 100644 --- a/src/function/builtin/FUNCALL.java +++ b/src/function/builtin/FUNCALL.java @@ -6,7 +6,7 @@ import static function.builtin.cons.LIST.makeList; import function.*; import sexpression.*; -@FunctionNames({ "FUNCALL" }) +@FunctionNames({ "FUNCALL", "CALL" }) public class FUNCALL extends LispFunction { private ArgumentValidator argumentValidator; diff --git a/src/function/builtin/special/LET.java b/src/function/builtin/special/LET.java index db8a5a4..0af0920 100644 --- a/src/function/builtin/special/LET.java +++ b/src/function/builtin/special/LET.java @@ -24,7 +24,8 @@ public class LET extends LispSpecialFunction { this.variableDefinitionListValidator.setEveryArgumentExpectedType(Cons.class); this.pairValidator = new ArgumentValidator("LET|pair|"); - this.pairValidator.setExactNumberOfArguments(2); + this.pairValidator.setMinimumNumberOfArguments(1); + this.pairValidator.setMaximumNumberOfArguments(2); this.pairValidator.setFirstArgumentExpectedType(Symbol.class); this.executionContext = ExecutionContext.getInstance(); diff --git a/test/function/builtin/FUNCALLTester.java b/test/function/builtin/FUNCALLTester.java index 33ae61b..8d7e19f 100644 --- a/test/function/builtin/FUNCALLTester.java +++ b/test/function/builtin/FUNCALLTester.java @@ -26,6 +26,13 @@ public class FUNCALLTester { assertSExpressionsMatch(parseString("6"), evaluateString(input)); } + @Test + public void callWithNumbers() { + String input = "(call '+ 1 2 3)"; + + assertSExpressionsMatch(parseString("6"), evaluateString(input)); + } + @Test public void funcallWithUserDefinedFunction() { String defineUserFunction = "(defun x (n m) (+ n m))"; diff --git a/test/function/builtin/special/LETTester.java b/test/function/builtin/special/LETTester.java index 2cce131..8cb2d7a 100644 --- a/test/function/builtin/special/LETTester.java +++ b/test/function/builtin/special/LETTester.java @@ -7,7 +7,7 @@ import org.junit.*; import function.ArgumentValidator.*; import function.builtin.EVAL.UndefinedSymbolException; -import sexpression.LispNumber; +import sexpression.*; import table.ExecutionContext; public class LETTester { @@ -42,6 +42,13 @@ public class LETTester { assertSExpressionsMatch(NIL, evaluateString(input)); } + @Test + public void letWithSymbolsOnly_SetsValuesToNil() { + String input = "(let ((x) (y)) (list x y))"; + + assertSExpressionsMatch(new Cons(NIL, new Cons(NIL, NIL)), evaluateString(input)); + } + @Test public void letWithSetf_DoesNotAlterGlobalVariable() { String before = "(setf x 22)"; @@ -122,7 +129,7 @@ public class LETTester { @Test(expected = TooFewArgumentsException.class) public void letWithTooFewItemsInPair() { - evaluateString("(let ((a)))"); + evaluateString("(let (()))"); } @Test(expected = TooManyArgumentsException.class)