Resolves #6 - PROGN Special Function (Form)
This commit is contained in:
parent
5129f6c17b
commit
50a3f3be67
|
@ -1,19 +1,18 @@
|
|||
(defun decrement (n) (- n 1))
|
||||
|
||||
(defun percent (n percent)
|
||||
(cond
|
||||
((> percent 0) (/ (+ (* n percent) 50) 100))
|
||||
(T (/ (- (* n percent) 50) 100))
|
||||
(if (> percent 0)
|
||||
(/ (+ (* n percent) 50) 100)
|
||||
(/ (- (* n percent) 50) 100)
|
||||
)
|
||||
)
|
||||
|
||||
(defun compound-interest (principal rate years)
|
||||
(cond
|
||||
((= years 0) principal)
|
||||
(T (compound-interest (+ principal (percent principal rate))
|
||||
rate
|
||||
(decrement years)
|
||||
)
|
||||
(if (= years 0)
|
||||
principal
|
||||
(compound-interest (+ principal (percent principal rate))
|
||||
rate
|
||||
(decrement years)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
|
|
@ -1,11 +1,11 @@
|
|||
(let ((*first-payday-day* 6)
|
||||
(*leap-year* 0)
|
||||
(*days-in-year* 365)
|
||||
(*two-weeks* 14))
|
||||
(let ((first-payday-day 6)
|
||||
(leap-year 0)
|
||||
(days-in-year 365)
|
||||
(two-weeks 14))
|
||||
|
||||
(+ 1
|
||||
(/ (- (+ *days-in-year*
|
||||
*leap-year*)
|
||||
*first-payday-day*)
|
||||
*two-weeks*))
|
||||
(/ (- (+ days-in-year
|
||||
leap-year)
|
||||
first-payday-day)
|
||||
two-weeks))
|
||||
)
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
(defun problem (n) (cond ((< n 1) nil) (T (cons n (problem (- n 1))))))
|
||||
(defun problem (n)
|
||||
(if (< n 1) nil
|
||||
(cons n (problem (- n 1)))
|
||||
)
|
||||
)
|
||||
|
||||
(setf y (problem 20))
|
||||
(setf x (problem 20000))
|
||||
|
||||
|
|
|
@ -1,13 +1,15 @@
|
|||
(defun run-unit-test (unit-test)
|
||||
(cond
|
||||
((funcall unit-test) (print (cons T unit-test)) T)
|
||||
(T (print (cons 'F unit-test)) NIL)
|
||||
(if (funcall unit-test)
|
||||
(progn (print (cons t unit-test)) t)
|
||||
(progn (print (cons 'F unit-test)) nil)
|
||||
)
|
||||
)
|
||||
|
||||
(defun run-test-suite (test-suite)
|
||||
(cond
|
||||
(test-suite (cons (run-unit-test (car test-suite)) (run-test-suite (cdr test-suite))))
|
||||
(if test-suite
|
||||
(cons (run-unit-test (car test-suite))
|
||||
(run-test-suite (cdr test-suite))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
@ -16,8 +18,8 @@
|
|||
)
|
||||
|
||||
(defun assert= (expected actual)
|
||||
(cond
|
||||
((= expected actual) T)
|
||||
(T (print (list expected 'is 'not actual)) nil)
|
||||
(if (= expected actual)
|
||||
t
|
||||
(progn (print (list expected 'is 'not actual)) nil)
|
||||
)
|
||||
)
|
||||
|
|
|
@ -0,0 +1,33 @@
|
|||
package function.builtin.special;
|
||||
|
||||
import static function.builtin.EVAL.eval;
|
||||
|
||||
import function.*;
|
||||
import sexpression.*;
|
||||
|
||||
@FunctionNames({ "PROGN" })
|
||||
public class PROGN extends LispSpecialFunction {
|
||||
|
||||
private ArgumentValidator argumentValidator;
|
||||
|
||||
public PROGN() {
|
||||
this.argumentValidator = new ArgumentValidator("PROGN");
|
||||
}
|
||||
|
||||
public SExpression call(Cons argumentList) {
|
||||
argumentValidator.validate(argumentList);
|
||||
|
||||
return callTailRecursive(argumentList, Nil.getInstance());
|
||||
}
|
||||
|
||||
private SExpression callTailRecursive(Cons argumentList, SExpression lastValue) {
|
||||
SExpression currentValue = eval(argumentList.getFirst());
|
||||
Cons remainingValues = (Cons) argumentList.getRest();
|
||||
|
||||
if (argumentList.isNull())
|
||||
return lastValue;
|
||||
|
||||
return callTailRecursive(remainingValues, currentValue);
|
||||
}
|
||||
|
||||
}
|
|
@ -66,6 +66,7 @@ public class FunctionTable {
|
|||
allBuiltIns.add(OR.class);
|
||||
allBuiltIns.add(PLUS.class);
|
||||
allBuiltIns.add(PRINT.class);
|
||||
allBuiltIns.add(PROGN.class);
|
||||
allBuiltIns.add(QUOTE.class);
|
||||
allBuiltIns.add(REST.class);
|
||||
allBuiltIns.add(SET.class);
|
||||
|
|
|
@ -0,0 +1,35 @@
|
|||
package function.builtin.special;
|
||||
|
||||
import static testutil.TestUtilities.*;
|
||||
import static testutil.TypeAssertions.assertNil;
|
||||
|
||||
import org.junit.Test;
|
||||
|
||||
public class PROGNTester {
|
||||
|
||||
@Test
|
||||
public void prognWithNoArguments() {
|
||||
assertNil(evaluateString("(progn)"));
|
||||
}
|
||||
|
||||
@Test
|
||||
public void prognWithOneArgument() {
|
||||
assertSExpressionsMatch(parseString("1"), evaluateString("(progn 1)"));
|
||||
}
|
||||
|
||||
@Test
|
||||
public void prognWithSeveralArguments() {
|
||||
assertSExpressionsMatch(parseString("5"), evaluateString("(progn 1 2 3 4 5)"));
|
||||
}
|
||||
|
||||
@Test
|
||||
public void prognEvaluatesArgument() {
|
||||
assertSExpressionsMatch(parseString("1"), evaluateString("(progn (car '(1 2 3)))"));
|
||||
}
|
||||
|
||||
@Test
|
||||
public void prognWithDifferentArgumentTypes() {
|
||||
assertSExpressionsMatch(parseString("pear"), evaluateString("(progn t nil '(1 2) 'pear)"));
|
||||
}
|
||||
|
||||
}
|
Loading…
Reference in New Issue