Resolves #6 - PROGN Special Function (Form)

lisp/compound-interest.lisp

@@ -1,19 +1,18 @@
 (defun decrement (n) (- n 1))
 
 (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)
-  (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)
-       )
     )
   )
 )

lisp/paydays.lisp

@@ -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
-     (/ (- (+ *days-in-year*
+     (/ (- (+ days-in-year
-              *leap-year*)
+              leap-year)
-           *first-payday-day*)
+           first-payday-day)
-        *two-weeks*))
+        two-weeks))
 )

lisp/problem.lisp

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

lisp/unit-test.lisp

@@ -1,13 +1,15 @@
 (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)
-  (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)
-  (cond
+  (if (= expected actual)
-    ((= expected actual) T)
+    t
-    (T (print (list expected 'is 'not actual)) nil)
+    (progn (print (list expected 'is 'not actual)) nil)
   )
 )

src/function/builtin/special/PROGN.java

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

src/table/FunctionTable.java

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

test/function/builtin/special/PROGNTester.java

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