Add more advanced lisp objects

Added a class to compute compound interest.

An alias for FUNCALL has been added: CALL

Refactored some acceptance tests to load code from files.

fitnesse/FitNesseRoot/LispInterpreter/MultipleMethodObject.wiki

@@ -4,18 +4,7 @@ Test
 An object with multiple methods.
 
 | script                | lisp interpreter fixture |
-| show | evaluate text |!-
+| show  | evaluate text | (load "lisp/object/multiple-methods.lisp") |
-
-(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 |

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 |

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 | !-
+| show   | evaluate text | (load "lisp/object/static.lisp")  |
-
-(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 | (setq my-counter (counter-class)) |
 | check  | evaluate text | (funcall my-counter)              | 1 |
 | check  | evaluate text | (funcall my-counter)              | 2 |

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|

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))))))

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)))))))

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))

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)))))))

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)))))))

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;

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();

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))";

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)