mike
/
transcendental-lisp
1
1
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Mike Cifelli 2017-03-06 16:52:06 -05:00
parent aa13394548
commit 77a341a1a7
13 changed files with 171 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
fitnesse/FitNesseRoot/LispInterpreter/MultipleMethodObject.wiki
View File

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

2
fitnesse/FitNesseRoot/LispInterpreter/ObjectComposition.wiki
View File

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

17
fitnesse/FitNesseRoot/LispInterpreter/StaticVariable.wiki
View File

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

6
fitnesse/FitNesseRoot/RecentChanges.wiki
View File

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

80
lisp/finance/interest-compounder-test.lisp Normal file
View File

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

39
lisp/finance/interest-compounder.lisp Normal file
View File

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

12
lisp/object/fruit-counter.lisp → lisp/object/composition.lisp
View File

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

6
lisp/object/multiple-methods.lisp Normal file
View File

@ -0,0 +1,6 @@
(defun counter-class ()
(let ((counter 0))
(lambda (msg)
(case msg
((:inc) (setq counter (+ counter 1)))
((:dec) (setq counter (- counter 1)))))))

13
lisp/object/static.lisp Normal file
View File

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

2
src/function/builtin/FUNCALL.java
View File

@ -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;

3
src/function/builtin/special/LET.java
View File

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

7
test/function/builtin/FUNCALLTester.java
View File

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

11
test/function/builtin/special/LETTester.java
View File

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