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

Implemented NOT. Fixed SExp.NIL equality bug.

Browse Source
This commit is contained in:
Jonathan Bernard 2010-02-09 14:13:30 -06:00
parent c754b2e7a9
commit 794467003a
5 changed files with 115 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
project.properties
View File

@ -1,13 +1,13 @@
#Mon Nov 30 22:18:15 CST 2009
#Tue Feb 09 14:02:30 CST 2010
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=2
build.number=15
dist.dir=dist
javacc.home=${lib.dir}/javacc
lib.dir=lib
dist.jar=${dist.dir}/JCLisp-${application.version}.jar
build.classes.dir=${build.dir}/classes
lib.dir=lib
grammar.file=${src.dir}/edu/utexas/cs345/jdblisp/Parser.jj
build.classes.dir=${build.dir}/classes
application.version=0.2.0

8
src/edu/utexas/cs345/jdblisp/Cons.java
View File

@ -12,8 +12,8 @@ public class Cons extends Seq {
super(car, (cdr == null ||
cdr == SExp.NIL ||
!(cdr instanceof Seq) ?
null : (Seq) cdr));
this.cdr = (cdr == SExp.NIL ? null : cdr);
SExp.NIL : (Seq) cdr));
this.cdr = cdr;
}
public Cons(SExp car, List list) {
@ -32,7 +32,7 @@ public class Cons extends Seq {
sb.append(car.display(offset + " "));
if (cdr != null) sb.append(cdr.display(offset));
if (cdr != SExp.NIL) sb.append(cdr.display(offset));
return sb.toString();
}
@ -40,7 +40,7 @@ public class Cons extends Seq {
@Override
public String toString() {
if (this.cdr == super.cdr) return super.toString();
else if (this.cdr == SExp.NIL) return car.toString();
else return car.toString() + " . " + cdr.toString();
}
}

2
src/edu/utexas/cs345/jdblisp/Parser.jj
View File

@ -41,7 +41,7 @@ TOKEN : /* LITERALS & SYMBOLS */
| < STRG: "\"" (~["\""])* "\"" >
| < SYMB: (["A"-"Z", "a"-"z", "_", "+", "-", "*", "/", "=", ">", "<"])+
(["A"-"Z", "a"-"z", "0"-"9",
"_", "+", "-", "*", "/", "=", ">", "<"])* >
"_", "+", "-", "*", "/", "=", ">", "<", "?"])* >
}
/**

10
src/edu/utexas/cs345/jdblisp/SExp.java
View File

@ -25,6 +25,16 @@ public interface SExp {
public SExp eval(SymbolTable table) { return this; }
public String display(String offset) { return offset + "NIL\n"; }
public String toString() { return "NIL"; }
public boolean equals(Object that) {
if (this == that) return true;
// empty list is also null. This is not just at the parser level!
// It can happen when peeling entries off a list
// ie. (NOT (CAR '())) should return T
else if (that instanceof List && ((List) that).seq == null)
return true;
return false;
}
};
}

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

@ -61,6 +61,8 @@ public abstract class SpecialFormEntry extends FormEntry {
static final Symbol LETREC = new Symbol("LETREC");
static final Symbol LIST = new Symbol("LIST");
static final Symbol MOD = new Symbol("MOD");
static final Symbol NOT = new Symbol("NOT");
static final Symbol NULL = new Symbol("NULL?");
static final Symbol QUOTE = new Symbol("QUOTE");
static final Symbol PROGN = new Symbol("PROGN");
static final Symbol REM = new Symbol("REM");
@ -551,13 +553,71 @@ public abstract class SpecialFormEntry extends FormEntry {
// CAR
// ---
// TODO
final SpecialFormEntry CAR = new SpecialFormEntry(
SpecialFormEntry.CAR, environment,
new FormHelpTopic("CAR", "get first element of a list",
"(car <List>) => <SExp>",
"Return the first element of a List or Cons",
"List", "a list",
"car", "an sexp"))
{
public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException {
if (arguments == null)
throw new InvalidArgumentQuantityException(toString(), 1);
SExp evaluatedArg = arguments.car.eval(symbolTable);
// check for NIL case
if (SExp.NIL.equals(evaluatedArg)) return SExp.NIL;
// TypeUtil.attemptCast is not quite good enough here, we need
// to check against two possible classes.
if (evaluatedArg instanceof List)
return ((List) evaluatedArg).seq.car;
// rare use case, but possible and the CL spec says it should still accept
else if (evaluatedArg instanceof Seq)
return ((Seq) evaluatedArg).car;
else throw new TypeException(arguments.car, List.class);
}
};
// ---
// CDR
// ---
// TODO
final SpecialFormEntry CDR = new SpecialFormEntry(
SpecialFormEntry.CDR, environment,
new FormHelpTopic("CDR", "get the cdr of a list or cons",
"(cdr <List>) => <SExp>",
"Returns the cdr of a List or Cons",
"List", "a list",
"cdr", "an sexp"))
{
public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException {
if (arguments == null)
throw new InvalidArgumentQuantityException(toString(), 1);
SExp evaluatedArg = arguments.car.eval(symbolTable);
// check for NIL case
if (SExp.NIL.equals(evaluatedArg)) return SExp.NIL;
// TypeUtil.attemptCast is not quite good enough here, we need
// to check against two possible classes.
if (evaluatedArg instanceof List)
return new List(((List) evaluatedArg).seq.cdr);
// rare use case, but possible and the CL spec says it should still accept
else if (evaluatedArg instanceof Seq)
return ((Seq) evaluatedArg).cdr;
else throw new TypeException(arguments.car, List.class);
}
};
// ----
// CONS
@ -1375,7 +1435,7 @@ public abstract class SpecialFormEntry extends FormEntry {
// TODO: this does not follow the Common Lisp standard (which requires
// FLOOR, TRUNCATE, and others to be defined). Fix in future when the
// required functionsa re defined.
// required functions are defined.
final SpecialFormEntry MOD = new SpecialFormEntry(
SpecialFormEntry.MOD, environment,
new FormHelpTopic("MOD", "modulus",
@ -1405,6 +1465,29 @@ public abstract class SpecialFormEntry extends FormEntry {
}
};
// ---
// NOT (also mapped to NULL?)
// ---
final SpecialFormEntry NOT = new SpecialFormEntry(
SpecialFormEntry.NOT, environment,
new FormHelpTopic("NOT", "Returns t if x is false; otherwise, "
+ "returns nil.",
"(not <object>) => <object>",
"The not operator returns T iff the object passed as a "
+ " parameter is equal to NIL and NIL otherwise.",
"object", "a generalized boolean (any object)"))
{
public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException {
if (arguments == null || arguments.length() != 1)
throw new InvalidArgumentQuantityException(toString(), 1);
if (SExp.NIL.equals(arguments.car.eval(symbolTable)))
return SExp.T;
else return SExp.NIL;
}
};
// -----
// QUOTE
// -----
@ -1581,6 +1664,8 @@ public abstract class SpecialFormEntry extends FormEntry {
environment.globalSymbolTable.bind(DIV.symbol, DIV);
environment.globalSymbolTable.bind(MUL.symbol, MUL);
environment.globalSymbolTable.bind(SUM.symbol, SUM);
environment.globalSymbolTable.bind(CAR.symbol, CAR);
environment.globalSymbolTable.bind(CDR.symbol, CDR);
environment.globalSymbolTable.bind(CONS.symbol, CONS);
environment.globalSymbolTable.bind(DEFUN.symbol, DEFUN);
environment.globalSymbolTable.bind(DEFPARAM.symbol, DEFPARAM);
@ -1595,9 +1680,16 @@ public abstract class SpecialFormEntry extends FormEntry {
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);
// map LETREC to LABELS (not quite honest. Scheme's LETREC allows you
// to define variables and functions with LETRECT. In CL, LABELS allows
// you to recursively define functions only. LET* allows you to
// recursively define variables).
environment.globalSymbolTable.bind(SpecialFormEntry.LETREC, LABELS);
environment.globalSymbolTable.bind(LIST.symbol, LIST);
environment.globalSymbolTable.bind(MOD.symbol, MOD);
environment.globalSymbolTable.bind(NOT.symbol, NOT);
environment.globalSymbolTable.bind(SpecialFormEntry.NULL, NOT);
environment.globalSymbolTable.bind(QUOTE.symbol, QUOTE);
environment.globalSymbolTable.bind(PROGN.symbol, PROGN);
environment.globalSymbolTable.bind(SETQ.symbol, SETQ);