jdb/jdb-lisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

LETREC tests

Browse Source
This commit is contained in:
Jonathan Bernard 2009-12-01 20:05:05 -06:00
parent 2b45af2d9c
commit c754b2e7a9
4 changed files with 179 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
README.rst Normal file
View File

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

10
project.properties
View File

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

109
src/edu/utexas/cs345/jdblisp/SpecialFormEntry.java
View File

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

62
src/lisp-samples/tests.lisp
View File

@ -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))
(factorial (- n 2)))))
(fibonacci (- n 1))
(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.