From 7f288c0878fc7c9190010cd0f7fe246edc955c70 Mon Sep 17 00:00:00 2001 From: Jonathan Bernard Date: Wed, 25 Nov 2009 16:18:13 -0600 Subject: [PATCH] Generalized special form argument type checking. Added <=, <, =, /=, >, >= --- build.xml | 6 +- project.properties | 26 +- src/edu/utexas/cs345/jdblisp/LISPRuntime.java | 5 +- src/edu/utexas/cs345/jdblisp/Num.java | 7 +- src/edu/utexas/cs345/jdblisp/Parser.jj | 6 +- .../cs345/jdblisp/SpecialFormEntry.java | 571 ++++++++++++++---- src/lisp-samples/tests.lisp | 33 + 7 files changed, 513 insertions(+), 141 deletions(-) create mode 100644 src/lisp-samples/tests.lisp diff --git a/build.xml b/build.xml index 3114ae8..214e7e0 100755 --- a/build.xml +++ b/build.xml @@ -6,6 +6,7 @@ + @@ -66,7 +67,10 @@ - + + + + diff --git a/project.properties b/project.properties index 25668d4..ff41943 100755 --- a/project.properties +++ b/project.properties @@ -1,13 +1,13 @@ -#Tue Nov 24 14:17:29 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=19 -dist.dir=dist -dist.jar=${dist.dir}/JCLisp-${application.version}.jar -lib.dir=lib -build.classes.dir=${build.dir}/classes -grammar.file=${src.dir}/edu/utexas/cs345/jdblisp/Parser.jj -application.version=0.1.0 -javacc.home=${lib}/javacc +#Wed Nov 25 16:01:45 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=27 +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 +grammar.file=${src.dir}/edu/utexas/cs345/jdblisp/Parser.jj +application.version=0.1.0 diff --git a/src/edu/utexas/cs345/jdblisp/LISPRuntime.java b/src/edu/utexas/cs345/jdblisp/LISPRuntime.java index 257fc1d..bc2a9f8 100755 --- a/src/edu/utexas/cs345/jdblisp/LISPRuntime.java +++ b/src/edu/utexas/cs345/jdblisp/LISPRuntime.java @@ -23,6 +23,7 @@ public class LISPRuntime { private Parser parser; private boolean interactive = true; + private boolean stop = false; boolean dumpAST = false; @@ -76,7 +77,7 @@ public class LISPRuntime { parser.ReInit(is); SExp sexp; - while (true) { + while (!stop) { // print prompt if applicable if (interactive) { @@ -118,6 +119,8 @@ public class LISPRuntime { OutputStream getOutputStream() { return os; } + void signalStop() { stop = true; } + private static SymbolTable defineGlobalConstants() { SymbolTable constantsTable = new SymbolTable(); constantsTable.bind(new Symbol("T"), new VariableEntry(SExp.T, true)); diff --git a/src/edu/utexas/cs345/jdblisp/Num.java b/src/edu/utexas/cs345/jdblisp/Num.java index d0e21ad..6154cfd 100755 --- a/src/edu/utexas/cs345/jdblisp/Num.java +++ b/src/edu/utexas/cs345/jdblisp/Num.java @@ -6,7 +6,7 @@ import java.math.BigInteger; /** * @author Jonathan Bernard (jdbernard@gmail.com) */ -public class Num implements SExp { +public class Num implements SExp, Comparable { private BigDecimal n; @@ -74,4 +74,9 @@ public class Num implements SExp { public Num abs() { return new Num(n.abs()); } + + @Override + public int compareTo(Num that) { + return this.n.compareTo(that.n); + } } diff --git a/src/edu/utexas/cs345/jdblisp/Parser.jj b/src/edu/utexas/cs345/jdblisp/Parser.jj index 353fcb4..75aa6e8 100755 --- a/src/edu/utexas/cs345/jdblisp/Parser.jj +++ b/src/edu/utexas/cs345/jdblisp/Parser.jj @@ -23,7 +23,7 @@ SKIP : /* WHITE SPACE */ | "\t" | "\n" | "\n\r" -| ";.*$" +| < ";" (~["\n", "\r"])* ("\n"|"\r")> } TOKEN : /* PUNCTUATION */ @@ -39,9 +39,9 @@ TOKEN : /* PUNCTUATION */ TOKEN : /* LITERALS & SYMBOLS */ { < NUMB: (["+", "-"])? (["0"-"9"])+ ("." (["0"-"9"])+ )? > | < STRG: "\"" (~["\""])* "\"" > -| < SYMB: (["A"-"Z", "a"-"z", "_", "+", "-", "*", "/", "="])+ +| < SYMB: (["A"-"Z", "a"-"z", "_", "+", "-", "*", "/", "=", ">", "<"])+ (["A"-"Z", "a"-"z", "0"-"9", - "_", "+", "-", "*", "/", "="])? > + "_", "+", "-", "*", "/", "=", ">", "<"])? > } /** diff --git a/src/edu/utexas/cs345/jdblisp/SpecialFormEntry.java b/src/edu/utexas/cs345/jdblisp/SpecialFormEntry.java index 537d9ca..0203867 100755 --- a/src/edu/utexas/cs345/jdblisp/SpecialFormEntry.java +++ b/src/edu/utexas/cs345/jdblisp/SpecialFormEntry.java @@ -10,10 +10,22 @@ import java.util.ArrayList; public abstract class SpecialFormEntry extends FormEntry { protected LISPRuntime environment; + protected int expectedArgumentCount; + protected Class[] expectedArgumentTypes; - public SpecialFormEntry(Symbol name, LISPRuntime environment, HelpTopic helpinfo) { + public SpecialFormEntry(Symbol name, LISPRuntime environment, + HelpTopic helpinfo, int expectedArgCount, Class... expectedArgTypes) { super(name, helpinfo); + + // three cases: no arguments, so EAT == null || 0; arg types homogenous + // so EAT == 1; arg types heterogenous, EAT == numArgs + assert (expectedArgumentTypes == null || + expectedArgumentTypes.length <= 1 || + expectedArgumentTypes.length == expectedArgumentCount); + this.environment = environment; + this.expectedArgumentCount = expectedArgCount; + this.expectedArgumentTypes = expectedArgTypes; } public abstract SExp call(SymbolTable symbolTable, Seq arguments) @@ -28,6 +40,56 @@ public abstract class SpecialFormEntry extends FormEntry { public String toString() { return ""; } + + protected void checkArguments(Seq arguments) throws LispException { + + boolean argsUnbounded = expectedArgumentCount < 0; + int expectedArgs = Math.abs(expectedArgumentCount); + int actualArgs; + + // first case: expect 0 arguments + if (expectedArgs == 0) { + if (arguments != null) + throw new InvalidArgumentQuantityException(0, arguments.length()); + return; + } + + // expect at least one arg, err if none given + if (arguments == null) + throw new InvalidArgumentQuantityException(expectedArgs, 0); + + actualArgs = arguments.length(); + + // there should be at least as many actual argument as expected + if ( actualArgs < expectedArgs || + (actualArgs > expectedArgs && !argsUnbounded)) { + if (argsUnbounded) + throw new InvalidArgumentQuantityException("expected at least " + + expectedArgs + " arguments"); + else + throw new InvalidArgumentQuantityException(expectedArgs, actualArgs); + } + + assert (expectedArgumentTypes != null && + expectedArgumentTypes.length > 0); + + // at this point, we know that the amount of arguments is valid + for (int i = 0; arguments != null; ++i) { + Class expectedType = + (i >= expectedArgumentTypes.length ? + expectedArgumentTypes[expectedArgumentTypes.length - 1] : + expectedArgumentTypes[i]); + + // check the type of the argument + if (!expectedType.isAssignableFrom(arguments.car.getClass())) + throw new TypeException(arguments.car, expectedType); + + // next argument + arguments = arguments.cdr; + } + + return; // no error, good times + } // ------------------------ // SPECIAL FORMS DEFINITION // ------------------------ @@ -40,6 +102,292 @@ public abstract class SpecialFormEntry extends FormEntry { */ public static void defineSpecialForms(LISPRuntime environment) { + // --- + // LTE + // --- + + final SpecialFormEntry LTE = new SpecialFormEntry( + new Symbol("<="), + environment, + new FormHelpTopic("<=", "Less than or equal to", + "(<= *) => ", + "The value of <= is true if the numbers are in monotonically " + + "nondecreasing order; otherwise it is false.", + "number", "a real", + "result", "a boolean"), + -2, Num.class) + { + public SExp call(SymbolTable symbolTable, Seq arguments) + throws LispException { + + Num current; + Num next; + + checkArguments(arguments); + + // get first number + current = (Num) arguments.car; + + // advance to next argument + arguments = arguments.cdr; + + while(arguments != null) { + // get next number + next = (Num) arguments.car; + + // current > next, return false + if (current.compareTo(next) > 0) return SExp.NIL; + + // next becomes current + current = next; + + // advance to next argument + arguments = arguments.cdr; + } + + // all are nondecreasing, return true + return SExp.T; + } + }; + + // -- + // LT + // -- + + final SpecialFormEntry LT = new SpecialFormEntry( + new Symbol("<"), + environment, + new FormHelpTopic("<", "Less than", + "(< *) => ", + "The value of < is true if the numbers are in monotonically " + + "increasing order; otherwise it is false.", + "number", "a real", + "result", "a boolean"), + -2, Num.class) + { + public SExp call(SymbolTable symbolTable, Seq arguments) + throws LispException { + + Num current; + Num next; + + checkArguments(arguments); + + // get first number + current = (Num) arguments.car; + + // advance to next argument + arguments = arguments.cdr; + + while(arguments != null) { + // get next number + next = (Num) arguments.car; + + // current >= next, return false + if (current.compareTo(next) >= 0) return SExp.NIL; + + // next becomes current + current = next; + + // advance to next argument + arguments = arguments.cdr; + } + + // all are increasing, return true + return SExp.T; + } + }; + + // --------- + // NUMEQ (=) + // --------- + + final SpecialFormEntry NUMEQ = new SpecialFormEntry( + new Symbol("="), + environment, + new FormHelpTopic("=", "Equal to", + "(= *) => ", + "The value of = is true if all numbers are the same in value.", + "number", "a number", + "result", "a boolean"), + -2, Num.class) + { + public SExp call(SymbolTable symbolTable, Seq arguments) + throws LispException { + + Num current; + Num next; + + checkArguments(arguments); + + // get first number + current = (Num) arguments.car; + + // advance to next argument + arguments = arguments.cdr; + + while(arguments != null) { + // get next number + next = (Num) arguments.car; + + // current != next, return false + if (current.compareTo(next) != 0) return SExp.NIL; + + // next becomes current + current = next; + + // advance to next argument + arguments = arguments.cdr; + } + + // all are equal, return true + return SExp.T; + } + }; + + // ------------- + // NUMNOTEQ (/=) + // ------------- + + final SpecialFormEntry NUMNOTEQ = new SpecialFormEntry( + new Symbol("/="), + environment, + new FormHelpTopic("/=", "Not equal to", + "(/= *) => ", + "The value of /= is true if no two numbers are the same in value.", + "number", "a number", + "result", "a boolean"), + -2, Num.class) + { + public SExp call(SymbolTable symbolTable, Seq arguments) + throws LispException { + + Num current; + Num next; + + checkArguments(arguments); + + // get first number + current = (Num) arguments.car; + + // advance to next argument + arguments = arguments.cdr; + + while(arguments != null) { + // get next number + next = (Num) arguments.car; + + // current == next, return false + if (current.compareTo(next) == 0) return SExp.NIL; + + // next becomes current + current = next; + + // advance to next argument + arguments = arguments.cdr; + } + + // all are non-equal, return true + return SExp.T; + } + }; + + // -- + // GT + // -- + + final SpecialFormEntry GT = new SpecialFormEntry( + new Symbol(">"), + environment, + new FormHelpTopic(">", "Greater than", + "(> *) => ", + "The value of > is true if the numbers are in monotonically " + + "decreasing order; otherwise it is false.", + "number", "a number", + "result", "a boolean"), + -2, Num.class) + { + public SExp call(SymbolTable symbolTable, Seq arguments) + throws LispException { + + Num current; + Num next; + + checkArguments(arguments); + + // get first number + current = (Num) arguments.car; + + // advance to next argument + arguments = arguments.cdr; + + while(arguments != null) { + // get next number + next = (Num) arguments.car; + + // current <= next, return false + if (current.compareTo(next) <= 0) return SExp.NIL; + + // next becomes current + current = next; + + // advance to next argument + arguments = arguments.cdr; + } + + // all are decreasing, return true + return SExp.T; + } + }; + + // --- + // GTE + // --- + + final SpecialFormEntry GTE = new SpecialFormEntry( + new Symbol(">="), + environment, + new FormHelpTopic(">=", "Greater than or equal to", + "(>= *) => ", + "The value of > is true if the numbers are in monotonically " + + "non-increasing order; otherwise it is false.", + "number", "a number", + "result", "a boolean"), + -2, Num.class) + { + public SExp call(SymbolTable symbolTable, Seq arguments) + throws LispException { + + Num current; + Num next; + + checkArguments(arguments); + + // get first number + current = (Num) arguments.car; + + // advance to next argument + arguments = arguments.cdr; + + while(arguments != null) { + // get next number + next = (Num) arguments.car; + + // current < next, return false + if (current.compareTo(next) < 0) return SExp.NIL; + + // next becomes current + current = next; + + // advance to next argument + arguments = arguments.cdr; + } + + // all are non-increasing, return true + return SExp.T; + } + }; + // --- // DIV // --- @@ -59,7 +407,8 @@ public abstract class SpecialFormEntry extends FormEntry { + "the number which is diveded.", "divisor_1 ... divisor_n", "Divisors are the numbers dividing " + "the dividend and may be any expression that evaluates " - + "to a number.")) + + "to a number."), + -1, Num.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -67,15 +416,10 @@ public abstract class SpecialFormEntry extends FormEntry { Num dividend = new Num("1"); Num firstArg; - if (arguments == null) - throw new InvalidArgumentQuantityException( - "invalid number of arguments: 0"); + checkArguments(arguments); // case: only one argument: 1 / arg - try { firstArg = (Num) arguments.car.eval(symbolTable); } - catch (ClassCastException cce) { - throw new TypeException(arguments.car, Num.class); - } + firstArg = (Num) arguments.car.eval(symbolTable); dividend = dividend.divideBy(firstArg); @@ -87,12 +431,8 @@ public abstract class SpecialFormEntry extends FormEntry { // variable number of arguments [0..inf) while (arguments != null) { - try { - dividend = dividend.divideBy( - (Num) arguments.car.eval(symbolTable)); - } catch (ClassCastException cce) { - throw new TypeException(arguments.car, Num.class); - } + dividend = dividend.divideBy( + (Num) arguments.car.eval(symbolTable)); arguments = arguments.cdr; } @@ -119,25 +459,19 @@ public abstract class SpecialFormEntry extends FormEntry { + "the number from which the others are subtracted.", "subtrahend_1 ... subtrahend_n", "Subtrahends are numbers " + "subtracted from the minuend and may be any expression " - + "that evaluates to a number.")) + + "that evaluates to a number."), + -1, Num.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { Num difference = new Num("0"); - // need at least one argument - if (arguments == null) - throw new InvalidArgumentQuantityException( - "invalid number of arguments: 0"); + checkArguments(arguments); // case: only one argument: 0 - arg - try { - difference = difference.subtract( - (Num) arguments.car.eval(symbolTable)); - } catch (ClassCastException cce) { - throw new TypeException(arguments.car, Num.class); - } + difference = difference.subtract( + (Num) arguments.car.eval(symbolTable)); arguments = arguments.cdr; if (arguments == null) return difference; @@ -147,12 +481,8 @@ public abstract class SpecialFormEntry extends FormEntry { // variable number of arguments [0..inf) while (arguments != null) { - try { - difference = difference.subtract( - (Num) arguments.car.eval(symbolTable)); - } catch (ClassCastException cce) { - throw new TypeException(arguments.car, Num.class); - } + difference = difference.subtract( + (Num) arguments.car.eval(symbolTable)); arguments = arguments.cdr; } @@ -174,7 +504,8 @@ public abstract class SpecialFormEntry extends FormEntry { + "before being bound to function parameters. The" + " expressions passed to multiply must evaluate to numbers.", "multiplicand_1 ... multiplicand_n", "Multiplicands may be " - + "any expression that evaluates to a number.")) + + "any expression that evaluates to a number."), + -1, Num.class) // not technically correct, * accepts 0 arguments { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -210,7 +541,8 @@ public abstract class SpecialFormEntry extends FormEntry { + "before being bound to function parameters. The" + " expressions passed to sum must evaluate to numbers.", "addend_1 ... addend_n", "Addends may be any expression that " - + "evaluates to a number.")) + + "evaluates to a number."), + -1, Num.class) // not technically correct, + accepts 0 arguments { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -250,7 +582,8 @@ public abstract class SpecialFormEntry extends FormEntry { + "cdr of which is object-2.", "object-1", "an object", "object-2", "an object", - "cons", "a cons")) + "cons", "a cons"), + 2, SExp.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -258,9 +591,7 @@ public abstract class SpecialFormEntry extends FormEntry { SExp object1, object2; Cons cons; - if (arguments.length() != 2) - throw new InvalidArgumentQuantityException(2, - arguments.length()); + checkArguments(arguments); // get the two objects object1 = arguments.car.eval(symbolTable); @@ -287,7 +618,8 @@ public abstract class SpecialFormEntry extends FormEntry { "param-list", "a list of symbols that will be bound in the " + "function scope to the arguments passed to the function.", "func-body", "an sexpression evaluated when the function is " - + "called.")) + + "called."), + 3, Symbol.class, List.class, SExp.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -296,25 +628,18 @@ public abstract class SpecialFormEntry extends FormEntry { ArrayList parameters = new ArrayList(); SExp body; + checkArguments(arguments); + // TODO: check to see if a function for this symbol exists // and warn if so - if (arguments == null || arguments.length() != 3) - new InvalidArgumentQuantityException(3, arguments.length()); - // first argument: Symbol for function name - if (!(arguments.car instanceof Symbol)) - throw new TypeException(arguments.car, Symbol.class); - functionName = (Symbol) arguments.car; // second argument, parameter list arguments = arguments.cdr; assert (arguments != null); - //if (!(arguments.car instanceof List)) - // TODO: error, need parameter list - // read parameters Seq paramSeq = ((List) arguments.car).seq; while (paramSeq != null) { @@ -350,7 +675,7 @@ public abstract class SpecialFormEntry extends FormEntry { new Symbol("DEFPARAMETER"), environment, new FormHelpTopic("DEFPARAMETER", "define a dynamic variable", - "(defparameter []) => ", + "(defparameter [ []]) => ", "defparameter establishes name as a dynamic variable. " + "defparameter unconditionally assigns the initial-value " + "to the dynamic variable named name (as opposed to " @@ -359,7 +684,8 @@ public abstract class SpecialFormEntry extends FormEntry { + "already bound.)", "name", "a symbol; not evaluated. ", "initial-value", "a form, always evaluated", - "documentation", "a string; not evaluated.")) + "documentation", "a string; not evaluated."), + -1, Symbol.class, SExp.class, Str.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -368,13 +694,9 @@ public abstract class SpecialFormEntry extends FormEntry { SExp initValue = null; HelpTopic helpinfo = null; - if (arguments == null) - throw new InvalidArgumentQuantityException(0); + checkArguments(arguments); // first argument: variable name - if (!(arguments.car instanceof Symbol)) - throw new TypeException(arguments.car, Symbol.class); - name = (Symbol) arguments.car; // second argument: initial value @@ -384,13 +706,9 @@ public abstract class SpecialFormEntry extends FormEntry { // third argument: documentation arguments = arguments.cdr; - if (arguments != null) { - if (!(arguments.car instanceof Str)) - throw new TypeException(arguments.car, Str.class); - + if (arguments != null) helpinfo = new HelpTopic(name.toString(), "variable", ((Str) arguments.car).value); - } } symbolTable.bind(name, @@ -418,7 +736,8 @@ public abstract class SpecialFormEntry extends FormEntry { "name", "a symbol; not evaluated. ", "initial-value", "a form, evaluated only if name is not " + "already bound.", - "documentation", "a string; not evaluated.")) + "documentation", "a string; not evaluated."), + -1, Symbol.class, SExp.class, Str.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -427,13 +746,9 @@ public abstract class SpecialFormEntry extends FormEntry { SExp initValue = null; HelpTopic helpinfo = null; - if (arguments == null) - throw new InvalidArgumentQuantityException(0); + checkArguments(arguments); // first argument: variable name - if (!(arguments.car instanceof Symbol)) - throw new TypeException(arguments.car, Symbol.class); - name = (Symbol) arguments.car; // if this variable is already defined, return without @@ -459,7 +774,7 @@ public abstract class SpecialFormEntry extends FormEntry { + "representation of the abstract syntax tree generated " + "by the parser for each sexpression it parses.", "enable", "NIL = disabled, anything else = enabled. No " - + "argument = enabled.")) + + "argument = enabled."), -1) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -470,7 +785,7 @@ public abstract class SpecialFormEntry extends FormEntry { SExp retVal = arguments.car.eval(symbolTable); - if (retVal != null) environment.dumpAST = true; + if (retVal != null && retVal != SExp.NIL) environment.dumpAST = true; else environment.dumpAST = false; return retVal; @@ -490,17 +805,14 @@ public abstract class SpecialFormEntry extends FormEntry { + " as an argument. #'funcname is equivalent to (function " + " funcname).", "func-name", "a symbol naming a function", - "function", "a function")) + "function", "a function"), + 1, Symbol.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { FormEntry fe = null; - if (arguments == null || arguments.length() != 1) - throw new InvalidArgumentQuantityException(1); - - if (!(arguments.car instanceof Symbol)) - throw new TypeException(arguments.car, Symbol.class); + checkArguments(arguments); fe = symbolTable.lookupFunction((Symbol) arguments.car); @@ -525,14 +837,13 @@ public abstract class SpecialFormEntry extends FormEntry { + "functional value in the global environment.", "function", "a function designator", "arg", "an object", - "results", "the result of the function call")) + "results", "the result of the function call"), + -1, SExp.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { - if (arguments == null) - throw new InvalidArgumentQuantityException( - "form requires at least one argument."); + checkArguments(arguments); // first argument: function designator SExp func = arguments.car.eval(symbolTable); @@ -576,7 +887,8 @@ public abstract class SpecialFormEntry extends FormEntry { "plist", "a property list.", "indicator", "an object", "default", "an object. The default is NIL", - "value", "an object")) + "value", "an object"), + -2, List.class, SExp.class, SExp.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -586,16 +898,10 @@ public abstract class SpecialFormEntry extends FormEntry { SExp indicator; SExp retVal = SExp.NIL; - // check number of arguments - if (arguments.length() < 2) - throw new InvalidArgumentQuantityException( - "form requires at least 2 arguments."); + checkArguments(arguments); // first argument: property list plistEval = arguments.car.eval(symbolTable); - if (!(plistEval instanceof List)) - throw new TypeException(arguments.car, List.class); - plistSeq = ((List) plistEval).seq; // second argument: indicator @@ -634,7 +940,8 @@ public abstract class SpecialFormEntry extends FormEntry { "(help [*])", null, "topic", - "either a string representing the topic to lookup or a symbol")) + "either a string representing the topic to lookup or a symbol"), + -1, SExp.class) // technically can accept 0 arguments { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -694,13 +1001,13 @@ public abstract class SpecialFormEntry extends FormEntry { "else-form", "a form. The default is nil. ", "results", "if the test-form yielded true, the values " + "returned by the then-form; otherwise, the values " - + "returned by the else-form.")) + + "returned by the else-form."), + -2, SExp.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { - if (arguments == null || arguments.length() < 2) - throw new InvalidArgumentQuantityException( - 2, arguments == null ? 0 : arguments.length()); + + checkArguments(arguments); // evaluate test form SExp testResult = arguments.car.eval(symbolTable); @@ -709,9 +1016,10 @@ public abstract class SpecialFormEntry extends FormEntry { arguments = arguments.cdr; // if false, advance to else-form - if (testResult == null) arguments = arguments.cdr; + if (testResult == null || testResult == SExp.NIL) arguments = arguments.cdr; + + if (arguments == null) return SExp.NIL; - if (arguments == null) return arguments; return arguments.eval(symbolTable); } }; @@ -729,7 +1037,8 @@ public abstract class SpecialFormEntry extends FormEntry { "", "param-list", "a list of symbols", "form", "a form", - "lambda", "a function")) + "lambda", "a function"), + 2, List.class, SExp.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -738,14 +1047,9 @@ public abstract class SpecialFormEntry extends FormEntry { SExp body; Seq paramSeq; - if (arguments.length() != 2) - throw new InvalidArgumentQuantityException( - 2, arguments.length()); + checkArguments(arguments); // first parameter: parameters to the lambda - if (!(arguments.car instanceof List)) - throw new TypeException(arguments.car, List.class); - paramSeq = ((List) arguments.car).seq; while (paramSeq != null) { if (!(paramSeq.car instanceof Symbol)) @@ -766,7 +1070,6 @@ public abstract class SpecialFormEntry extends FormEntry { } }; - // --- // LET // --- @@ -791,7 +1094,8 @@ public abstract class SpecialFormEntry extends FormEntry { "var", "a symbol", "init-form", "a form", "form", "a form", - "result", "the value returned by the last form")) + "result", "the value returned by the last form"), + -1, List.class, SExp.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -802,12 +1106,7 @@ public abstract class SpecialFormEntry extends FormEntry { ArrayList values = new ArrayList(); SExp retVal = SExp.NIL; - if (arguments == null) - throw new InvalidArgumentQuantityException(0); - - if (!(arguments.car instanceof List)) - throw new LispException("Malformed LET bindings: " - + arguments.car.toString()); + checkArguments(arguments); letBinding = ((List) arguments.car).seq; @@ -881,7 +1180,8 @@ public abstract class SpecialFormEntry extends FormEntry { "var", "a symbol", "init-form", "a form", "form", "a form", - "result", "the value returned by the last form")) + "result", "the value returned by the last form"), + -1, List.class, SExp.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -892,12 +1192,7 @@ public abstract class SpecialFormEntry extends FormEntry { SExp initvalue; SExp retVal = SExp.NIL; - if (arguments == null) - throw new InvalidArgumentQuantityException(0); - - if (!(arguments.car instanceof List)) - throw new LispException("Malformed LET bindings: " - + arguments.car.toString()); + checkArguments(arguments); letBinding = ((List) arguments.car).seq; @@ -957,7 +1252,8 @@ public abstract class SpecialFormEntry extends FormEntry { "(list *) => list", "list returns a list containing the supplied objects.", "object", "an object.", - "list", "a list.")) + "list", "a list."), + -1, SExp.class) // actually accepts 0 or more args, not 1 or more { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -994,7 +1290,8 @@ public abstract class SpecialFormEntry extends FormEntry { "The quote special operator just returns object. The " + "consequences are undefined if literal objects (including " + "quoted objects) are destructively modified. ", - "object", "an object; not evaluated.")) + "object", "an object; not evaluated."), + 1, SExp.class) { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -1021,7 +1318,8 @@ public abstract class SpecialFormEntry extends FormEntry { + "within that progn are considered by the compiler to be " + "top level forms. ", "form", "a list of forms", - "result", "the value of the last form")) + "result", "the value of the last form"), + -1, SExp.class) // actually accepts 0 or more args { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -1058,7 +1356,8 @@ public abstract class SpecialFormEntry extends FormEntry { + "(not setq) had been used. ", "name", "a symbol naming a variable other than a constant variable", - "form", "a form")) + "form", "a form"), + -1, SExp.class) //actually accepts an even number of args { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -1110,8 +1409,9 @@ public abstract class SpecialFormEntry extends FormEntry { "enable trace information for a function", "(trace )", "Turn on trace information for a function.", - "funcname", "the name of the function to trace")) - { + "funcname", "the name of the function to trace"), + -1, Symbol.class) //actually accepts 0 or 1 arg + { public SExp call(SymbolTable symbolTable, Seq arguments) throws LispException { @@ -1135,8 +1435,34 @@ public abstract class SpecialFormEntry extends FormEntry { return SExp.NIL; } - }; + }; + // ---- + // QUIT + // ---- + + final SpecialFormEntry QUIT = new SpecialFormEntry( + new Symbol("QUIT"), + environment, + new FormHelpTopic("QUIT", "Exit the interpreter.", + "(quit)", + ""), + 0, SExp.class) + { + public SExp call(SymbolTable symbolTable, Seq arguments) + throws LispException { + checkArguments(arguments); + environment.signalStop(); + return SExp.NIL; + } + }; + + environment.globalSymbolTable.bind(LTE.name, LTE); + environment.globalSymbolTable.bind(LT.name, LT); + environment.globalSymbolTable.bind(NUMEQ.name, NUMEQ); + environment.globalSymbolTable.bind(NUMNOTEQ.name, NUMNOTEQ); + environment.globalSymbolTable.bind(GT.name, GT); + environment.globalSymbolTable.bind(GTE.name, GTE); environment.globalSymbolTable.bind(DIF.name, DIF); environment.globalSymbolTable.bind(DIV.name, DIV); environment.globalSymbolTable.bind(MUL.name, MUL); @@ -1159,5 +1485,6 @@ public abstract class SpecialFormEntry extends FormEntry { environment.globalSymbolTable.bind(PROGN.name, PROGN); environment.globalSymbolTable.bind(SETQ.name, SETQ); environment.globalSymbolTable.bind(TRACE.name, TRACE); + environment.globalSymbolTable.bind(QUIT.name, QUIT); } } diff --git a/src/lisp-samples/tests.lisp b/src/lisp-samples/tests.lisp new file mode 100644 index 0000000..76f2237 --- /dev/null +++ b/src/lisp-samples/tests.lisp @@ -0,0 +1,33 @@ +(<= 1 1 2 3 5 8 13) ; => T + +(<= 1 2 3 4) ; => T + +(<= 1 2 3 2) ; => NIL + +(<= 1 "Hi") ; => TYPE-ERROR + +(<= 1 2 3 4) ; => T + +(<=) ; error, not enough args + +(< 1 2 3 4) ; => T + +(< 1 1 2 3 5) ; => NIL + +(< 1 3) ; => T + +(< 2 1) ; => NIL + +(< 1 "hi") ; type error + +(<) ; not enough args + +(= 1 1) ; => T + +(= 1.0 -1.0) ; => NIL + +(= 0.0 -0.0) ; => T + +(= 1 2) ; => NIL + +(= 7 7 7) ; => T