LETREC tests

README.rst

@@ -0,0 +1,14 @@
+J Common Lisp
+=============
+Jonathan Bernard
+````````````````
+J Common Lisp is a pure Java implementation of a subset of Common Lisp.
+
+Features
+--------
+
+Example Algorithms
+------------------
+
+Notes
+-----

project.properties

@@ -1,13 +1,13 @@
-#Mon Nov 30 20:37:52 CST 2009
+#Mon Nov 30 22:18:15 CST 2009
 build.dir=build
 src.dir=src
 grammar.output.dir=${src.dir}/edu/utexas/cs345/jdblisp/parser
 build.jar=${build.dir}/JCLisp-${application.version}.${build.number}.jar
-build.number=46
+build.number=2
 dist.dir=dist
 javacc.home=${lib.dir}/javacc
-dist.jar=${dist.dir}/JCLisp-${application.version}.jar
 lib.dir=lib
-grammar.file=${src.dir}/edu/utexas/cs345/jdblisp/Parser.jj
+dist.jar=${dist.dir}/JCLisp-${application.version}.jar
 build.classes.dir=${build.dir}/classes
-application.version=0.1.0
+grammar.file=${src.dir}/edu/utexas/cs345/jdblisp/Parser.jj
+application.version=0.2.0

src/edu/utexas/cs345/jdblisp/SpecialFormEntry.java

@@ -2,6 +2,7 @@ package edu.utexas.cs345.jdblisp;
 
 import java.io.PrintWriter;
 import java.util.ArrayList;
+import java.util.LinkedList;
 
 /**
  * SpecialFormEntry
@@ -53,9 +54,11 @@ public abstract class SpecialFormEntry extends FormEntry {
     static final Symbol GETF                = new Symbol("GETF");
     static final Symbol HELP                = new Symbol("HELP");
     static final Symbol IF                  = new Symbol("IF");
+    static final Symbol LABELS              = new Symbol("LABELS");
     static final Symbol LAMBDA              = new Symbol("LAMBDA");
     static final Symbol LET                 = new Symbol("LET");
     static final Symbol LET_STAR            = new Symbol("LET*");
+    static final Symbol LETREC              = new Symbol("LETREC");
     static final Symbol LIST                = new Symbol("LIST");
     static final Symbol MOD                 = new Symbol("MOD");
     static final Symbol QUOTE               = new Symbol("QUOTE");
@@ -1015,6 +1018,103 @@ public abstract class SpecialFormEntry extends FormEntry {
             }
         };
 
+        // ------
+        // LABELS
+        // ------
+
+        final SpecialFormEntry LABELS = new SpecialFormEntry(
+            SpecialFormEntry.LABELS, environment,
+            new FormHelpTopic("LABELS", "recursive function definition",
+                "(labels ((function-name (param*) local-form*)*) form*) => "
+                    + "result",
+                "labels defines locally named functions and executes a series "
+                    + "of forms with these definition bindings. Any number of "
+                    + "such local functions can be defined. The scope of the "
+                    + "defined function names for labels encompasses the "
+                    + "function definitions themselves as well as the body.",
+                "function-name", "a symbol",
+                "param", "a symbol",
+                "local-form", "a form (the list of local-forms is an implicit "
+                    + "progn.",
+                "form", "a form (the list of forms is an implicit progn."))
+        {
+            public SExp call(SymbolTable symbolTable, Seq arguments)
+            throws LispException {
+
+                ArrayList<FormEntry> localFunctions = new ArrayList<FormEntry>();
+                ArrayList<Symbol> params;
+                LinkedList<SExp> localForms;
+                Seq labelsSeq, defunSeq, paramSeq;
+                SExp funcBody, result = SExp.NIL;
+                Symbol funcName;
+                SymbolTable newScope;
+
+                if (arguments == null)
+                    throw new InvalidArgumentQuantityException(toString(),
+                        "at least one argument is required.");
+
+                labelsSeq = TypeUtil.attemptCast(List.class, arguments.car).seq;
+
+                // parse each local function definition
+                while (labelsSeq != null) {
+                    defunSeq = TypeUtil.attemptCast(List.class,
+                        labelsSeq.car).seq;
+
+                    if (defunSeq == null || defunSeq.length() < 3)
+                        throw new LispException("Malformed LABELS expression: "
+                            + "function definition list is incomplete.");
+
+                    funcName = TypeUtil.attemptCast(Symbol.class, defunSeq.car);
+                    defunSeq = defunSeq.cdr;
+                    paramSeq = TypeUtil.attemptCast(List.class,
+                        defunSeq.car).seq;
+                    defunSeq = defunSeq.cdr;
+
+                    // capture each parameter to this function
+                    params = new ArrayList<Symbol>();
+                    while (paramSeq != null) {
+                        params.add(TypeUtil.attemptCast(Symbol.class,
+                            paramSeq.car));
+                        paramSeq = paramSeq.cdr;
+                    }
+
+                    // capture each local form
+                    localForms = new LinkedList<SExp>();
+                    while(defunSeq != null) {
+                        localForms.add(defunSeq.car);
+                        defunSeq = defunSeq.cdr;
+                    }
+
+                    // create the implicit PROGN
+                    localForms.addFirst(SpecialFormEntry.PROGN);
+                    funcBody = new List(new Seq(
+                        localForms.toArray(new SExp[]{})));
+
+                    // create the FunctionEntry
+                    localFunctions.add(new FunctionEntry(funcName,
+                        params.toArray(new Symbol[]{}), funcBody));
+
+                    // next function definition
+                    labelsSeq = labelsSeq.cdr;
+                }
+
+                // create the new scope to include the new function definitions
+                newScope = new SymbolTable(symbolTable);
+                for (FormEntry fe : localFunctions)
+                    newScope.bind(fe.symbol, fe);
+
+                // advance to the body of the LABELS form, the implicit PROGN
+                // of forms
+                arguments = arguments.cdr;
+                while (arguments != null) {
+                    result = arguments.car.eval(newScope);
+                    arguments = arguments.cdr;
+                }
+
+                return result;
+            }
+        };
+
         // ------
         // LAMBDA
         // ------
@@ -1227,6 +1327,13 @@ public abstract class SpecialFormEntry extends FormEntry {
             }
         };
 
+        // ------
+        // LETREC
+        // ------
+
+        // This is a Scheme function. It exists in CLISP as LABELS. The 
+        // special form in JLisp is provided as an alias for LABELS
+
         // ----
         // LIST
         // ----
@@ -1484,9 +1591,11 @@ public abstract class SpecialFormEntry extends FormEntry {
         environment.globalSymbolTable.bind(GETF.symbol, GETF);
         environment.globalSymbolTable.bind(HELP.symbol, HELP);
         environment.globalSymbolTable.bind(IF.symbol, IF);
+        environment.globalSymbolTable.bind(LABELS.symbol, LABELS);
         environment.globalSymbolTable.bind(LAMBDA.symbol, LAMBDA);
         environment.globalSymbolTable.bind(LET.symbol, LET);
         environment.globalSymbolTable.bind(LET_STAR.symbol, LET_STAR);
+        environment.globalSymbolTable.bind(SpecialFormEntry.LETREC, LABELS);
         environment.globalSymbolTable.bind(LIST.symbol, LIST);
         environment.globalSymbolTable.bind(MOD.symbol, MOD);
         environment.globalSymbolTable.bind(QUOTE.symbol, QUOTE);

src/lisp-samples/tests.lisp

@@ -192,30 +192,70 @@ sq ; => <LAMBDA (X) >
 
 ;;; SAMPLE ALGORITHMS
 
-(defun factorial (n) (if (<= n 1) 
+(defun fibonacci (n) (if (<= n 1) 
     1 
     (+ 
-        (factorial (- n 1)) 
+        (fibonacci (- n 1)) 
-        (factorial (- n 2)))))
+        (fibonacci (- n 2)))))
 
-(factorial 0) ; => 1
+(fibonacci 0) ; => 1
 
-(factorial 1) ; => 1
+(fibonacci 1) ; => 1
 
-(factorial 2) ; => 2
+(fibonacci 2) ; => 2
 
-(factorial 3) ; => 3
+(fibonacci 3) ; => 3
 
-(factorial 4) ; => 5
+(fibonacci 4) ; => 5
 
-(factorial 5) ; => 8
+(fibonacci 5) ; => 8
 
-(factorial 6) ; => 13
+(fibonacci 6) ; => 13
 
-(factorial 20) ; => 10946
+(fibonacci 20) ; => 10946
 
 (defun collatz (n) (if (= n 1)
     1
     (if (= 0 (mod n 2))
         (+ 1 (collatz (/ n 2)))
         (+ 1 (collatz (+ (* n 3) 1))))))
+
+;;; LABELS/LETREC TESTS
+
+;; LABELS is similar to LETREC from Scheme, but some key differences remain.
+;; In Scheme, if you store a lambda to a variable, you can treat that variable
+;; as a function. In Common Lisp you cannot, you must explicitly use the FUNCALL
+;; form to invoke the function. For example, in Scheme you can do this:
+;;
+;;  (let ((plus5 (lambda (x) (+ x 5)))) (plus5 3)) => 8
+;;
+;; In Common Lisp, this will result in an undefined function error. The syntax
+;; for the same thing in CL is:
+;;
+;;  (let ((plus5 (lambda (x) (+ x 5)))) (funcall plus5 3)) => 8
+;;
+;; More specifically to LABELS vs. LETREC: Since CL allows functions and
+;; variables to share names, the functions of CL generally operate on one or
+;; the other, but not both. LET creates locally-scoped variables. LABELS
+;; creates locally-scoped functions. So, to rewriting the LETREC example from
+;; notes15 using LABELS looks like:
+(labels
+    ((factorial (n) 
+        (if (<= n 1)
+            1
+            (* n (factorial (- n 1))))))
+    (factorial 10)) ; => 3628800
+
+;; rewriting the LETREC example using LET looks like:
+(let
+    ((factorial
+        (lambda (n)
+            (if (= n 0)
+                1
+                (* n (funcall factorial (- n 1)))))))
+    (funcall factorial 5))
+
+;; final note regarding LETREC and LET. In a compliant Common Lisp
+;; implementation, LET does not allow recursive definition similar to
+;; LETREC. As I noted in my presentation, my implementation of LET does
+;; allow recursive definition.