Resolves #6 - PROGN Special Function (Form)

This commit is contained in:
Mike Cifelli 2017-02-27 15:36:17 -05:00
parent 5129f6c17b
commit 50a3f3be67
7 changed files with 102 additions and 26 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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