From 794467003a55ab47ec6372bace55143adf845612 Mon Sep 17 00:00:00 2001 From: Jonathan Bernard Date: Tue, 9 Feb 2010 14:13:30 -0600 Subject: [PATCH] Implemented NOT. Fixed SExp.NIL equality bug. --- project.properties | 8 +- src/edu/utexas/cs345/jdblisp/Cons.java | 8 +- src/edu/utexas/cs345/jdblisp/Parser.jj | 2 +- src/edu/utexas/cs345/jdblisp/SExp.java | 10 ++ .../cs345/jdblisp/SpecialFormEntry.java | 100 +++++++++++++++++- 5 files changed, 115 insertions(+), 13 deletions(-) diff --git a/project.properties b/project.properties index d532bef..7a2efdc 100755 --- a/project.properties +++ b/project.properties @@ -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 diff --git a/src/edu/utexas/cs345/jdblisp/Cons.java b/src/edu/utexas/cs345/jdblisp/Cons.java index f950903..0b466ff 100644 --- a/src/edu/utexas/cs345/jdblisp/Cons.java +++ b/src/edu/utexas/cs345/jdblisp/Cons.java @@ -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(); } } diff --git a/src/edu/utexas/cs345/jdblisp/Parser.jj b/src/edu/utexas/cs345/jdblisp/Parser.jj index 3dc193f..16717b9 100755 --- a/src/edu/utexas/cs345/jdblisp/Parser.jj +++ b/src/edu/utexas/cs345/jdblisp/Parser.jj @@ -41,7 +41,7 @@ TOKEN : /* LITERALS & SYMBOLS */ | < STRG: "\"" (~["\""])* "\"" > | < SYMB: (["A"-"Z", "a"-"z", "_", "+", "-", "*", "/", "=", ">", "<"])+ (["A"-"Z", "a"-"z", "0"-"9", - "_", "+", "-", "*", "/", "=", ">", "<"])* > + "_", "+", "-", "*", "/", "=", ">", "<", "?"])* > } /** diff --git a/src/edu/utexas/cs345/jdblisp/SExp.java b/src/edu/utexas/cs345/jdblisp/SExp.java index cb6e2f3..d611941 100755 --- a/src/edu/utexas/cs345/jdblisp/SExp.java +++ b/src/edu/utexas/cs345/jdblisp/SExp.java @@ -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; + } }; } diff --git a/src/edu/utexas/cs345/jdblisp/SpecialFormEntry.java b/src/edu/utexas/cs345/jdblisp/SpecialFormEntry.java index 0ac32cf..6d55d42 100755 --- a/src/edu/utexas/cs345/jdblisp/SpecialFormEntry.java +++ b/src/edu/utexas/cs345/jdblisp/SpecialFormEntry.java @@ -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 ) => ", + "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 ) => ", + "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 ) => ", + "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);