dlambda was converted for multiple method classes
Added several unit tests, including a failing one for CASE Added an acceptance test for dlambda
This commit is contained in:
parent
64e18fe076
commit
ba203d34b9
|
@ -22,3 +22,74 @@ Test
|
||||||
| check | evaluate | (funcall my-counter :dec) | 2 |
|
| check | evaluate | (funcall my-counter :dec) | 2 |
|
||||||
| check | evaluate | (funcall my-counter :dec) | 1 |
|
| check | evaluate | (funcall my-counter :dec) | 1 |
|
||||||
| check | evaluate | (funcall my-counter :dec) | 0 |
|
| check | evaluate | (funcall my-counter :dec) | 0 |
|
||||||
|
|
||||||
|
|
||||||
|
| script | lisp interpreter fixture |
|
||||||
|
| # | dlambda |
|
||||||
|
| show | evaluate |!-
|
||||||
|
|
||||||
|
(defun map (fn ls)
|
||||||
|
(if (null ls)
|
||||||
|
()
|
||||||
|
(cons (funcall fn (first ls))
|
||||||
|
(map fn (rest ls))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define-macro dlambda (&rest methods)
|
||||||
|
(cons
|
||||||
|
(quote lambda)
|
||||||
|
(cons
|
||||||
|
(quote (&rest arguments))
|
||||||
|
(list
|
||||||
|
(cons
|
||||||
|
(quote case)
|
||||||
|
(cons
|
||||||
|
(quote (first arguments))
|
||||||
|
(map
|
||||||
|
(lambda (method)
|
||||||
|
(cons
|
||||||
|
(first method)
|
||||||
|
(list
|
||||||
|
(cons
|
||||||
|
(quote apply)
|
||||||
|
(cons
|
||||||
|
(cons
|
||||||
|
(quote lambda)
|
||||||
|
(rest method)
|
||||||
|
)
|
||||||
|
(list (quote (rest arguments)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
methods
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(defun apple-counter ()
|
||||||
|
(let ((apple-count 0))
|
||||||
|
(eval
|
||||||
|
(dlambda
|
||||||
|
(:inc () (setf apple-count (+ apple-count 1)))
|
||||||
|
(:dec () (setf apple-count (- apple-count 1)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
-!|
|
||||||
|
| show | evaluate | (setf a (apple-counter)) |
|
||||||
|
| check | evaluate | (funcall a :inc) | 1 |
|
||||||
|
| check | evaluate | (funcall a :inc) | 2 |
|
||||||
|
| check | evaluate | (funcall a :inc) | 3 |
|
||||||
|
| check | evaluate | (funcall a :dec) | 2 |
|
||||||
|
| check | evaluate | (funcall a :dec) | 1 |
|
||||||
|
| check | evaluate | (funcall a :dec) | 0 |
|
||||||
|
| show | evaluate | (funcall a :inc 1) |
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
|LispInterpreter.MultipleMethodClosure||11:04:53 Wed, Mar 01, 2017|
|
|LispInterpreter.MultipleMethodClosure||16:02:22 Wed, Mar 01, 2017|
|
||||||
|LispInterpreter.SetUp||11:04:36 Wed, Mar 01, 2017|
|
|LispInterpreter.SetUp||11:04:36 Wed, Mar 01, 2017|
|
||||||
|LispInterpreter.LexicalClosures||12:10:13 Mon, Feb 27, 2017|
|
|LispInterpreter.LexicalClosures||12:10:13 Mon, Feb 27, 2017|
|
||||||
|LispInterpreter.TestClosure||11:24:27 Mon, Feb 27, 2017|
|
|LispInterpreter.TestClosure||11:24:27 Mon, Feb 27, 2017|
|
||||||
|
|
|
@ -0,0 +1,46 @@
|
||||||
|
(defun map (fn ls)
|
||||||
|
(if (null ls)
|
||||||
|
()
|
||||||
|
(cons (funcall fn (first ls))
|
||||||
|
(map fn (rest ls))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define-macro dlambda (&rest methods)
|
||||||
|
(cons
|
||||||
|
(quote lambda)
|
||||||
|
(cons
|
||||||
|
(quote (&rest arguments))
|
||||||
|
(list
|
||||||
|
(cons
|
||||||
|
(quote case)
|
||||||
|
(cons
|
||||||
|
(quote (first arguments))
|
||||||
|
(map
|
||||||
|
(lambda (method)
|
||||||
|
(cons
|
||||||
|
(first method)
|
||||||
|
(list
|
||||||
|
(cons
|
||||||
|
(quote apply)
|
||||||
|
(cons
|
||||||
|
(cons
|
||||||
|
(quote lambda)
|
||||||
|
(rest method)
|
||||||
|
)
|
||||||
|
(list (quote (rest arguments)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
methods
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
|
@ -116,6 +116,20 @@ public class CASETester {
|
||||||
assertSExpressionsMatch(parseString("orange"), evaluateString(input));
|
assertSExpressionsMatch(parseString("orange"), evaluateString(input));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@Test
|
||||||
|
public void caseWithEmptyList() {
|
||||||
|
String input = "(case () ((()) 'orange))";
|
||||||
|
|
||||||
|
assertSExpressionsMatch(parseString("orange"), evaluateString(input));
|
||||||
|
}
|
||||||
|
|
||||||
|
@Test
|
||||||
|
public void caseWithList() {
|
||||||
|
String input = "(case '(5 4 3) (((1 2) (5 4 3)) 'orange))";
|
||||||
|
|
||||||
|
assertSExpressionsMatch(parseString("orange"), evaluateString(input));
|
||||||
|
}
|
||||||
|
|
||||||
@Test
|
@Test
|
||||||
public void caseWithDefaultClause() {
|
public void caseWithDefaultClause() {
|
||||||
String input = "(case nil (() 'banana) (t 'orange))";
|
String input = "(case nil (() 'banana) (t 'orange))";
|
||||||
|
@ -185,8 +199,13 @@ public class CASETester {
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test(expected = BadArgumentTypeException.class)
|
@Test(expected = BadArgumentTypeException.class)
|
||||||
public void caseWithNilClause() {
|
public void caseWithEmptyClause() {
|
||||||
evaluateString("(case :a ())");
|
evaluateString("(case :a ())");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@Test(expected = BadArgumentTypeException.class)
|
||||||
|
public void caseWithNilClause() {
|
||||||
|
evaluateString("(case :a nil)");
|
||||||
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -72,10 +72,15 @@ public class CONDTester {
|
||||||
}
|
}
|
||||||
|
|
||||||
@Test(expected = BadArgumentTypeException.class)
|
@Test(expected = BadArgumentTypeException.class)
|
||||||
public void condWithNilArgument_ThrowsException() {
|
public void condWithEmptyListArgument_ThrowsException() {
|
||||||
evaluateString("(cond ())");
|
evaluateString("(cond ())");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@Test(expected = BadArgumentTypeException.class)
|
||||||
|
public void condWithNilArgument_ThrowsException() {
|
||||||
|
evaluateString("(cond nil)");
|
||||||
|
}
|
||||||
|
|
||||||
@Test(expected = BadArgumentTypeException.class)
|
@Test(expected = BadArgumentTypeException.class)
|
||||||
public void condWithNonListArgument_ThrowsException() {
|
public void condWithNonListArgument_ThrowsException() {
|
||||||
evaluateString("(cond o)");
|
evaluateString("(cond o)");
|
||||||
|
|
Loading…
Reference in New Issue