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 decrement (n) (- n 1))
|
||||||
|
|
||||||
(defun percent (n percent)
|
(defun percent (n percent)
|
||||||
(cond
|
(if (> percent 0)
|
||||||
((> percent 0) (/ (+ (* n percent) 50) 100))
|
(/ (+ (* n percent) 50) 100)
|
||||||
(T (/ (- (* n percent) 50) 100))
|
(/ (- (* n percent) 50) 100)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
(defun compound-interest (principal rate years)
|
(defun compound-interest (principal rate years)
|
||||||
(cond
|
(if (= years 0)
|
||||||
((= years 0) principal)
|
principal
|
||||||
(T (compound-interest (+ principal (percent principal rate))
|
(compound-interest (+ principal (percent principal rate))
|
||||||
rate
|
rate
|
||||||
(decrement years)
|
(decrement years)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
|
||||||
|
|
|
@ -1,11 +1,11 @@
|
||||||
(let ((*first-payday-day* 6)
|
(let ((first-payday-day 6)
|
||||||
(*leap-year* 0)
|
(leap-year 0)
|
||||||
(*days-in-year* 365)
|
(days-in-year 365)
|
||||||
(*two-weeks* 14))
|
(two-weeks 14))
|
||||||
|
|
||||||
(+ 1
|
(+ 1
|
||||||
(/ (- (+ *days-in-year*
|
(/ (- (+ days-in-year
|
||||||
*leap-year*)
|
leap-year)
|
||||||
*first-payday-day*)
|
first-payday-day)
|
||||||
*two-weeks*))
|
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))
|
(setf x (problem 20000))
|
||||||
|
|
||||||
|
|
|
@ -1,13 +1,15 @@
|
||||||
(defun run-unit-test (unit-test)
|
(defun run-unit-test (unit-test)
|
||||||
(cond
|
(if (funcall unit-test)
|
||||||
((funcall unit-test) (print (cons T unit-test)) T)
|
(progn (print (cons t unit-test)) t)
|
||||||
(T (print (cons 'F unit-test)) NIL)
|
(progn (print (cons 'F unit-test)) nil)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
(defun run-test-suite (test-suite)
|
(defun run-test-suite (test-suite)
|
||||||
(cond
|
(if test-suite
|
||||||
(test-suite (cons (run-unit-test (car test-suite)) (run-test-suite (cdr test-suite))))
|
(cons (run-unit-test (car test-suite))
|
||||||
|
(run-test-suite (cdr test-suite))
|
||||||
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -16,8 +18,8 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
(defun assert= (expected actual)
|
(defun assert= (expected actual)
|
||||||
(cond
|
(if (= expected actual)
|
||||||
((= expected actual) T)
|
t
|
||||||
(T (print (list expected 'is 'not actual)) nil)
|
(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(OR.class);
|
||||||
allBuiltIns.add(PLUS.class);
|
allBuiltIns.add(PLUS.class);
|
||||||
allBuiltIns.add(PRINT.class);
|
allBuiltIns.add(PRINT.class);
|
||||||
|
allBuiltIns.add(PROGN.class);
|
||||||
allBuiltIns.add(QUOTE.class);
|
allBuiltIns.add(QUOTE.class);
|
||||||
allBuiltIns.add(REST.class);
|
allBuiltIns.add(REST.class);
|
||||||
allBuiltIns.add(SET.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