Generalized special form argument type checking. Added <=, <, =, /=, >, >=

This commit is contained in:
Jonathan Bernard 2009-11-25 16:18:13 -06:00
parent 86a0e3981b
commit 7f288c0878
7 changed files with 513 additions and 141 deletions

View File

@ -6,6 +6,7 @@
<path id="javac.path"> <path id="javac.path">
<fileset dir="${lib.dir}"> <fileset dir="${lib.dir}">
<include name="**/*.jar"/> <include name="**/*.jar"/>
<exclude name="javacc"/>
</fileset> </fileset>
</path> </path>
@ -66,7 +67,10 @@
<mkdir dir="${dist.dir}/lib"/> <mkdir dir="${dist.dir}/lib"/>
<move file="${build.jar}" tofile="${dist.jar}" /> <move file="${build.jar}" tofile="${dist.jar}" />
<copy todir="${dist.dir}/lib"> <copy todir="${dist.dir}/lib">
<fileset dir="${lib.dir}"/> <fileset dir="${lib.dir}">
<include name="**/*"/>
<exclude name="javacc"/>
</fileset>
</copy> </copy>
</target> </target>
</project> </project>

View File

@ -1,13 +1,13 @@
#Tue Nov 24 14:17:29 CST 2009 #Wed Nov 25 16:01:45 CST 2009
build.dir=build build.dir=build
src.dir=src src.dir=src
grammar.output.dir=${src.dir}/edu/utexas/cs345/jdblisp/parser grammar.output.dir=${src.dir}/edu/utexas/cs345/jdblisp/parser
build.jar=${build.dir}/JCLisp-${application.version}.${build.number}.jar build.jar=${build.dir}/JCLisp-${application.version}.${build.number}.jar
build.number=19 build.number=27
dist.dir=dist dist.dir=dist
dist.jar=${dist.dir}/JCLisp-${application.version}.jar javacc.home=${lib.dir}/javacc
lib.dir=lib lib.dir=lib
build.classes.dir=${build.dir}/classes dist.jar=${dist.dir}/JCLisp-${application.version}.jar
grammar.file=${src.dir}/edu/utexas/cs345/jdblisp/Parser.jj build.classes.dir=${build.dir}/classes
application.version=0.1.0 grammar.file=${src.dir}/edu/utexas/cs345/jdblisp/Parser.jj
javacc.home=${lib}/javacc application.version=0.1.0

View File

@ -23,6 +23,7 @@ public class LISPRuntime {
private Parser parser; private Parser parser;
private boolean interactive = true; private boolean interactive = true;
private boolean stop = false;
boolean dumpAST = false; boolean dumpAST = false;
@ -76,7 +77,7 @@ public class LISPRuntime {
parser.ReInit(is); parser.ReInit(is);
SExp sexp; SExp sexp;
while (true) { while (!stop) {
// print prompt if applicable // print prompt if applicable
if (interactive) { if (interactive) {
@ -118,6 +119,8 @@ public class LISPRuntime {
OutputStream getOutputStream() { return os; } OutputStream getOutputStream() { return os; }
void signalStop() { stop = true; }
private static SymbolTable defineGlobalConstants() { private static SymbolTable defineGlobalConstants() {
SymbolTable constantsTable = new SymbolTable(); SymbolTable constantsTable = new SymbolTable();
constantsTable.bind(new Symbol("T"), new VariableEntry(SExp.T, true)); constantsTable.bind(new Symbol("T"), new VariableEntry(SExp.T, true));

View File

@ -6,7 +6,7 @@ import java.math.BigInteger;
/** /**
* @author Jonathan Bernard (jdbernard@gmail.com) * @author Jonathan Bernard (jdbernard@gmail.com)
*/ */
public class Num implements SExp { public class Num implements SExp, Comparable<Num> {
private BigDecimal n; private BigDecimal n;
@ -74,4 +74,9 @@ public class Num implements SExp {
public Num abs() { public Num abs() {
return new Num(n.abs()); return new Num(n.abs());
} }
@Override
public int compareTo(Num that) {
return this.n.compareTo(that.n);
}
} }

View File

@ -23,7 +23,7 @@ SKIP : /* WHITE SPACE */
| "\t" | "\t"
| "\n" | "\n"
| "\n\r" | "\n\r"
| ";.*$" | < ";" (~["\n", "\r"])* ("\n"|"\r")>
} }
TOKEN : /* PUNCTUATION */ TOKEN : /* PUNCTUATION */
@ -39,9 +39,9 @@ TOKEN : /* PUNCTUATION */
TOKEN : /* LITERALS & SYMBOLS */ TOKEN : /* LITERALS & SYMBOLS */
{ < NUMB: (["+", "-"])? (["0"-"9"])+ ("." (["0"-"9"])+ )? > { < NUMB: (["+", "-"])? (["0"-"9"])+ ("." (["0"-"9"])+ )? >
| < STRG: "\"" (~["\""])* "\"" > | < STRG: "\"" (~["\""])* "\"" >
| < SYMB: (["A"-"Z", "a"-"z", "_", "+", "-", "*", "/", "="])+ | < SYMB: (["A"-"Z", "a"-"z", "_", "+", "-", "*", "/", "=", ">", "<"])+
(["A"-"Z", "a"-"z", "0"-"9", (["A"-"Z", "a"-"z", "0"-"9",
"_", "+", "-", "*", "/", "="])? > "_", "+", "-", "*", "/", "=", ">", "<"])? >
} }
/** /**

View File

@ -10,10 +10,22 @@ import java.util.ArrayList;
public abstract class SpecialFormEntry extends FormEntry { public abstract class SpecialFormEntry extends FormEntry {
protected LISPRuntime environment; protected LISPRuntime environment;
protected int expectedArgumentCount;
protected Class<? extends SExp>[] expectedArgumentTypes;
public SpecialFormEntry(Symbol name, LISPRuntime environment, HelpTopic helpinfo) { public SpecialFormEntry(Symbol name, LISPRuntime environment,
HelpTopic helpinfo, int expectedArgCount, Class<? extends SExp>... expectedArgTypes) {
super(name, helpinfo); 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.environment = environment;
this.expectedArgumentCount = expectedArgCount;
this.expectedArgumentTypes = expectedArgTypes;
} }
public abstract SExp call(SymbolTable symbolTable, Seq arguments) public abstract SExp call(SymbolTable symbolTable, Seq arguments)
@ -28,6 +40,56 @@ public abstract class SpecialFormEntry extends FormEntry {
public String toString() { public String toString() {
return "<SPECIAL-FORM (" + name.toString() + ") >"; return "<SPECIAL-FORM (" + name.toString() + ") >";
} }
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<? extends SExp> 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 // SPECIAL FORMS DEFINITION
// ------------------------ // ------------------------
@ -40,6 +102,292 @@ public abstract class SpecialFormEntry extends FormEntry {
*/ */
public static void defineSpecialForms(LISPRuntime environment) { public static void defineSpecialForms(LISPRuntime environment) {
// ---
// LTE
// ---
final SpecialFormEntry LTE = new SpecialFormEntry(
new Symbol("<="),
environment,
new FormHelpTopic("<=", "Less than or equal to",
"(<= <number>*) => <result>",
"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",
"(< <number>*) => <result>",
"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",
"(= <number>*) => <result>",
"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",
"(/= <number>*) => <result>",
"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",
"(> <number>*) => <result>",
"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",
"(>= <number>*) => <result>",
"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 // DIV
// --- // ---
@ -59,7 +407,8 @@ public abstract class SpecialFormEntry extends FormEntry {
+ "the number which is diveded.", + "the number which is diveded.",
"divisor_1 ... divisor_n", "Divisors are the numbers dividing " "divisor_1 ... divisor_n", "Divisors are the numbers dividing "
+ "the dividend and may be any expression that evaluates " + "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -67,15 +416,10 @@ public abstract class SpecialFormEntry extends FormEntry {
Num dividend = new Num("1"); Num dividend = new Num("1");
Num firstArg; Num firstArg;
if (arguments == null) checkArguments(arguments);
throw new InvalidArgumentQuantityException(
"invalid number of arguments: 0");
// case: only one argument: 1 / arg // case: only one argument: 1 / arg
try { firstArg = (Num) arguments.car.eval(symbolTable); } firstArg = (Num) arguments.car.eval(symbolTable);
catch (ClassCastException cce) {
throw new TypeException(arguments.car, Num.class);
}
dividend = dividend.divideBy(firstArg); dividend = dividend.divideBy(firstArg);
@ -87,12 +431,8 @@ public abstract class SpecialFormEntry extends FormEntry {
// variable number of arguments [0..inf) // variable number of arguments [0..inf)
while (arguments != null) { while (arguments != null) {
try { dividend = dividend.divideBy(
dividend = dividend.divideBy( (Num) arguments.car.eval(symbolTable));
(Num) arguments.car.eval(symbolTable));
} catch (ClassCastException cce) {
throw new TypeException(arguments.car, Num.class);
}
arguments = arguments.cdr; arguments = arguments.cdr;
} }
@ -119,25 +459,19 @@ public abstract class SpecialFormEntry extends FormEntry {
+ "the number from which the others are subtracted.", + "the number from which the others are subtracted.",
"subtrahend_1 ... subtrahend_n", "Subtrahends are numbers " "subtrahend_1 ... subtrahend_n", "Subtrahends are numbers "
+ "subtracted from the minuend and may be any expression " + "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
Num difference = new Num("0"); Num difference = new Num("0");
// need at least one argument checkArguments(arguments);
if (arguments == null)
throw new InvalidArgumentQuantityException(
"invalid number of arguments: 0");
// case: only one argument: 0 - arg // case: only one argument: 0 - arg
try { difference = difference.subtract(
difference = difference.subtract( (Num) arguments.car.eval(symbolTable));
(Num) arguments.car.eval(symbolTable));
} catch (ClassCastException cce) {
throw new TypeException(arguments.car, Num.class);
}
arguments = arguments.cdr; arguments = arguments.cdr;
if (arguments == null) return difference; if (arguments == null) return difference;
@ -147,12 +481,8 @@ public abstract class SpecialFormEntry extends FormEntry {
// variable number of arguments [0..inf) // variable number of arguments [0..inf)
while (arguments != null) { while (arguments != null) {
try { difference = difference.subtract(
difference = difference.subtract( (Num) arguments.car.eval(symbolTable));
(Num) arguments.car.eval(symbolTable));
} catch (ClassCastException cce) {
throw new TypeException(arguments.car, Num.class);
}
arguments = arguments.cdr; arguments = arguments.cdr;
} }
@ -174,7 +504,8 @@ public abstract class SpecialFormEntry extends FormEntry {
+ "before being bound to function parameters. The" + "before being bound to function parameters. The"
+ " expressions passed to multiply must evaluate to numbers.", + " expressions passed to multiply must evaluate to numbers.",
"multiplicand_1 ... multiplicand_n", "Multiplicands may be " "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -210,7 +541,8 @@ public abstract class SpecialFormEntry extends FormEntry {
+ "before being bound to function parameters. The" + "before being bound to function parameters. The"
+ " expressions passed to sum must evaluate to numbers.", + " expressions passed to sum must evaluate to numbers.",
"addend_1 ... addend_n", "Addends may be any expression that " "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -250,7 +582,8 @@ public abstract class SpecialFormEntry extends FormEntry {
+ "cdr of which is object-2.", + "cdr of which is object-2.",
"object-1", "an object", "object-1", "an object",
"object-2", "an object", "object-2", "an object",
"cons", "a cons")) "cons", "a cons"),
2, SExp.class)
{ {
public SExp call(SymbolTable symbolTable, Seq arguments) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -258,9 +591,7 @@ public abstract class SpecialFormEntry extends FormEntry {
SExp object1, object2; SExp object1, object2;
Cons cons; Cons cons;
if (arguments.length() != 2) checkArguments(arguments);
throw new InvalidArgumentQuantityException(2,
arguments.length());
// get the two objects // get the two objects
object1 = arguments.car.eval(symbolTable); 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 " "param-list", "a list of symbols that will be bound in the "
+ "function scope to the arguments passed to the function.", + "function scope to the arguments passed to the function.",
"func-body", "an sexpression evaluated when the function is " "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -296,25 +628,18 @@ public abstract class SpecialFormEntry extends FormEntry {
ArrayList<Symbol> parameters = new ArrayList<Symbol>(); ArrayList<Symbol> parameters = new ArrayList<Symbol>();
SExp body; SExp body;
checkArguments(arguments);
// TODO: check to see if a function for this symbol exists // TODO: check to see if a function for this symbol exists
// and warn if so // and warn if so
if (arguments == null || arguments.length() != 3)
new InvalidArgumentQuantityException(3, arguments.length());
// first argument: Symbol for function name // first argument: Symbol for function name
if (!(arguments.car instanceof Symbol))
throw new TypeException(arguments.car, Symbol.class);
functionName = (Symbol) arguments.car; functionName = (Symbol) arguments.car;
// second argument, parameter list // second argument, parameter list
arguments = arguments.cdr; arguments = arguments.cdr;
assert (arguments != null); assert (arguments != null);
//if (!(arguments.car instanceof List))
// TODO: error, need parameter list
// read parameters // read parameters
Seq paramSeq = ((List) arguments.car).seq; Seq paramSeq = ((List) arguments.car).seq;
while (paramSeq != null) { while (paramSeq != null) {
@ -350,7 +675,7 @@ public abstract class SpecialFormEntry extends FormEntry {
new Symbol("DEFPARAMETER"), new Symbol("DEFPARAMETER"),
environment, environment,
new FormHelpTopic("DEFPARAMETER", "define a dynamic variable", new FormHelpTopic("DEFPARAMETER", "define a dynamic variable",
"(defparameter <name> <initial-value> [<documentation>]) => <name>", "(defparameter <name> [<initial-value> [<documentation>]]) => <name>",
"defparameter establishes name as a dynamic variable. " "defparameter establishes name as a dynamic variable. "
+ "defparameter unconditionally assigns the initial-value " + "defparameter unconditionally assigns the initial-value "
+ "to the dynamic variable named name (as opposed to " + "to the dynamic variable named name (as opposed to "
@ -359,7 +684,8 @@ public abstract class SpecialFormEntry extends FormEntry {
+ "already bound.)", + "already bound.)",
"name", "a symbol; not evaluated. ", "name", "a symbol; not evaluated. ",
"initial-value", "a form, always 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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -368,13 +694,9 @@ public abstract class SpecialFormEntry extends FormEntry {
SExp initValue = null; SExp initValue = null;
HelpTopic helpinfo = null; HelpTopic helpinfo = null;
if (arguments == null) checkArguments(arguments);
throw new InvalidArgumentQuantityException(0);
// first argument: variable name // first argument: variable name
if (!(arguments.car instanceof Symbol))
throw new TypeException(arguments.car, Symbol.class);
name = (Symbol) arguments.car; name = (Symbol) arguments.car;
// second argument: initial value // second argument: initial value
@ -384,13 +706,9 @@ public abstract class SpecialFormEntry extends FormEntry {
// third argument: documentation // third argument: documentation
arguments = arguments.cdr; arguments = arguments.cdr;
if (arguments != null) { if (arguments != null)
if (!(arguments.car instanceof Str))
throw new TypeException(arguments.car, Str.class);
helpinfo = new HelpTopic(name.toString(), "variable", helpinfo = new HelpTopic(name.toString(), "variable",
((Str) arguments.car).value); ((Str) arguments.car).value);
}
} }
symbolTable.bind(name, symbolTable.bind(name,
@ -418,7 +736,8 @@ public abstract class SpecialFormEntry extends FormEntry {
"name", "a symbol; not evaluated. ", "name", "a symbol; not evaluated. ",
"initial-value", "a form, evaluated only if name is not " "initial-value", "a form, evaluated only if name is not "
+ "already bound.", + "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -427,13 +746,9 @@ public abstract class SpecialFormEntry extends FormEntry {
SExp initValue = null; SExp initValue = null;
HelpTopic helpinfo = null; HelpTopic helpinfo = null;
if (arguments == null) checkArguments(arguments);
throw new InvalidArgumentQuantityException(0);
// first argument: variable name // first argument: variable name
if (!(arguments.car instanceof Symbol))
throw new TypeException(arguments.car, Symbol.class);
name = (Symbol) arguments.car; name = (Symbol) arguments.car;
// if this variable is already defined, return without // 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 " + "representation of the abstract syntax tree generated "
+ "by the parser for each sexpression it parses.", + "by the parser for each sexpression it parses.",
"enable", "NIL = disabled, anything else = enabled. No " "enable", "NIL = disabled, anything else = enabled. No "
+ "argument = enabled.")) + "argument = enabled."), -1)
{ {
public SExp call(SymbolTable symbolTable, Seq arguments) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -470,7 +785,7 @@ public abstract class SpecialFormEntry extends FormEntry {
SExp retVal = arguments.car.eval(symbolTable); 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; else environment.dumpAST = false;
return retVal; return retVal;
@ -490,17 +805,14 @@ public abstract class SpecialFormEntry extends FormEntry {
+ " as an argument. #'funcname is equivalent to (function " + " as an argument. #'funcname is equivalent to (function "
+ " funcname).", + " funcname).",
"func-name", "a symbol naming a function", "func-name", "a symbol naming a function",
"function", "a function")) "function", "a function"),
1, Symbol.class)
{ {
public SExp call(SymbolTable symbolTable, Seq arguments) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
FormEntry fe = null; FormEntry fe = null;
if (arguments == null || arguments.length() != 1) checkArguments(arguments);
throw new InvalidArgumentQuantityException(1);
if (!(arguments.car instanceof Symbol))
throw new TypeException(arguments.car, Symbol.class);
fe = symbolTable.lookupFunction((Symbol) arguments.car); fe = symbolTable.lookupFunction((Symbol) arguments.car);
@ -525,14 +837,13 @@ public abstract class SpecialFormEntry extends FormEntry {
+ "functional value in the global environment.", + "functional value in the global environment.",
"function", "a function designator", "function", "a function designator",
"arg", "an object", "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
if (arguments == null) checkArguments(arguments);
throw new InvalidArgumentQuantityException(
"form requires at least one argument.");
// first argument: function designator // first argument: function designator
SExp func = arguments.car.eval(symbolTable); SExp func = arguments.car.eval(symbolTable);
@ -576,7 +887,8 @@ public abstract class SpecialFormEntry extends FormEntry {
"plist", "a property list.", "plist", "a property list.",
"indicator", "an object", "indicator", "an object",
"default", "an object. The default is NIL", "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -586,16 +898,10 @@ public abstract class SpecialFormEntry extends FormEntry {
SExp indicator; SExp indicator;
SExp retVal = SExp.NIL; SExp retVal = SExp.NIL;
// check number of arguments checkArguments(arguments);
if (arguments.length() < 2)
throw new InvalidArgumentQuantityException(
"form requires at least 2 arguments.");
// first argument: property list // first argument: property list
plistEval = arguments.car.eval(symbolTable); plistEval = arguments.car.eval(symbolTable);
if (!(plistEval instanceof List))
throw new TypeException(arguments.car, List.class);
plistSeq = ((List) plistEval).seq; plistSeq = ((List) plistEval).seq;
// second argument: indicator // second argument: indicator
@ -634,7 +940,8 @@ public abstract class SpecialFormEntry extends FormEntry {
"(help [<topic>*])", "(help [<topic>*])",
null, null,
"topic", "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -694,13 +1001,13 @@ public abstract class SpecialFormEntry extends FormEntry {
"else-form", "a form. The default is nil. ", "else-form", "a form. The default is nil. ",
"results", "if the test-form yielded true, the values " "results", "if the test-form yielded true, the values "
+ "returned by the then-form; otherwise, 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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
if (arguments == null || arguments.length() < 2)
throw new InvalidArgumentQuantityException( checkArguments(arguments);
2, arguments == null ? 0 : arguments.length());
// evaluate test form // evaluate test form
SExp testResult = arguments.car.eval(symbolTable); SExp testResult = arguments.car.eval(symbolTable);
@ -709,9 +1016,10 @@ public abstract class SpecialFormEntry extends FormEntry {
arguments = arguments.cdr; arguments = arguments.cdr;
// if false, advance to else-form // 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); return arguments.eval(symbolTable);
} }
}; };
@ -729,7 +1037,8 @@ public abstract class SpecialFormEntry extends FormEntry {
"", "",
"param-list", "a list of symbols", "param-list", "a list of symbols",
"form", "a form", "form", "a form",
"lambda", "a function")) "lambda", "a function"),
2, List.class, SExp.class)
{ {
public SExp call(SymbolTable symbolTable, Seq arguments) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -738,14 +1047,9 @@ public abstract class SpecialFormEntry extends FormEntry {
SExp body; SExp body;
Seq paramSeq; Seq paramSeq;
if (arguments.length() != 2) checkArguments(arguments);
throw new InvalidArgumentQuantityException(
2, arguments.length());
// first parameter: parameters to the lambda // first parameter: parameters to the lambda
if (!(arguments.car instanceof List))
throw new TypeException(arguments.car, List.class);
paramSeq = ((List) arguments.car).seq; paramSeq = ((List) arguments.car).seq;
while (paramSeq != null) { while (paramSeq != null) {
if (!(paramSeq.car instanceof Symbol)) if (!(paramSeq.car instanceof Symbol))
@ -766,7 +1070,6 @@ public abstract class SpecialFormEntry extends FormEntry {
} }
}; };
// --- // ---
// LET // LET
// --- // ---
@ -791,7 +1094,8 @@ public abstract class SpecialFormEntry extends FormEntry {
"var", "a symbol", "var", "a symbol",
"init-form", "a form", "init-form", "a form",
"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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -802,12 +1106,7 @@ public abstract class SpecialFormEntry extends FormEntry {
ArrayList<SExp> values = new ArrayList<SExp>(); ArrayList<SExp> values = new ArrayList<SExp>();
SExp retVal = SExp.NIL; SExp retVal = SExp.NIL;
if (arguments == null) checkArguments(arguments);
throw new InvalidArgumentQuantityException(0);
if (!(arguments.car instanceof List))
throw new LispException("Malformed LET bindings: "
+ arguments.car.toString());
letBinding = ((List) arguments.car).seq; letBinding = ((List) arguments.car).seq;
@ -881,7 +1180,8 @@ public abstract class SpecialFormEntry extends FormEntry {
"var", "a symbol", "var", "a symbol",
"init-form", "a form", "init-form", "a form",
"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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -892,12 +1192,7 @@ public abstract class SpecialFormEntry extends FormEntry {
SExp initvalue; SExp initvalue;
SExp retVal = SExp.NIL; SExp retVal = SExp.NIL;
if (arguments == null) checkArguments(arguments);
throw new InvalidArgumentQuantityException(0);
if (!(arguments.car instanceof List))
throw new LispException("Malformed LET bindings: "
+ arguments.car.toString());
letBinding = ((List) arguments.car).seq; letBinding = ((List) arguments.car).seq;
@ -957,7 +1252,8 @@ public abstract class SpecialFormEntry extends FormEntry {
"(list <object>*) => list", "(list <object>*) => list",
"list returns a list containing the supplied objects.", "list returns a list containing the supplied objects.",
"object", "an object.", "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -994,7 +1290,8 @@ public abstract class SpecialFormEntry extends FormEntry {
"The quote special operator just returns object. The " "The quote special operator just returns object. The "
+ "consequences are undefined if literal objects (including " + "consequences are undefined if literal objects (including "
+ "quoted objects) are destructively modified. ", + "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -1021,7 +1318,8 @@ public abstract class SpecialFormEntry extends FormEntry {
+ "within that progn are considered by the compiler to be " + "within that progn are considered by the compiler to be "
+ "top level forms. ", + "top level forms. ",
"form", "a list of 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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -1058,7 +1356,8 @@ public abstract class SpecialFormEntry extends FormEntry {
+ "(not setq) had been used. ", + "(not setq) had been used. ",
"name", "name",
"a symbol naming a variable other than a constant variable", "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -1110,8 +1409,9 @@ public abstract class SpecialFormEntry extends FormEntry {
"enable trace information for a function", "enable trace information for a function",
"(trace <funcname>)", "(trace <funcname>)",
"Turn on trace information for a function.", "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) public SExp call(SymbolTable symbolTable, Seq arguments)
throws LispException { throws LispException {
@ -1135,8 +1435,34 @@ public abstract class SpecialFormEntry extends FormEntry {
return SExp.NIL; 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(DIF.name, DIF);
environment.globalSymbolTable.bind(DIV.name, DIV); environment.globalSymbolTable.bind(DIV.name, DIV);
environment.globalSymbolTable.bind(MUL.name, MUL); 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(PROGN.name, PROGN);
environment.globalSymbolTable.bind(SETQ.name, SETQ); environment.globalSymbolTable.bind(SETQ.name, SETQ);
environment.globalSymbolTable.bind(TRACE.name, TRACE); environment.globalSymbolTable.bind(TRACE.name, TRACE);
environment.globalSymbolTable.bind(QUIT.name, QUIT);
} }
} }

View File

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