@Override
public LispObject elt(int index) {
if (index < 0) type_error(Fixnum.getInstance(index), Symbol.UNSIGNED_BYTE);
int i = 0;
Cons cons = this;
while (true) {
if (i == index) return cons.car;
LispObject conscdr = cons.cdr;
if (conscdr.isCons()) {
cons = (Cons) conscdr;
} else {
if (conscdr == NIL) {
// Index too large.
type_error(
Fixnum.getInstance(index),
list(Symbol.INTEGER, Fixnum.ZERO, Fixnum.getInstance(length() - 1)));
} else {
// Dotted list.
type_error(conscdr, Symbol.LIST);
}
// Not reached.
return NIL;
}
++i;
}
}
private int setInitialContents(int axis, int[] dims, LispObject contents, int index) {
if (dims.length == 0) {
try {
data[index] = coerceLispObjectToJavaByte(contents);
} catch (ArrayIndexOutOfBoundsException e) {
error(new LispError("Bad initial contents for array."));
return -1;
}
++index;
} else {
int dim = dims[0];
if (dim != contents.length()) {
error(new LispError("Bad initial contents for array."));
return -1;
}
int[] newDims = new int[dims.length - 1];
for (int i = 1; i < dims.length; i++) newDims[i - 1] = dims[i];
if (contents.listp()) {
for (int i = contents.length(); i-- > 0; ) {
LispObject content = contents.car();
index = setInitialContents(axis + 1, newDims, content, index);
contents = contents.cdr();
}
} else {
AbstractVector v = checkVector(contents);
final int length = v.length();
for (int i = 0; i < length; i++) {
LispObject content = v.AREF(i);
index = setInitialContents(axis + 1, newDims, content, index);
}
}
}
return index;
}
@Override
public final boolean equal(LispObject obj) {
if (this == obj) return true;
if (obj.isCons()) {
if (car.equal(((Cons) obj).car) && cdr.equal(((Cons) obj).cdr)) return true;
}
return false;
}
private static final int computeEqualpHash(LispObject obj, int depth) {
if (obj.isCons()) {
if (depth > 0) {
int n1 = computeEqualpHash(((Cons) obj).car, depth - 1);
int n2 = computeEqualpHash(((Cons) obj).cdr, depth - 1);
return n1 ^ n2;
} else return 261835505; // See above.
} else return obj.psxhash();
}
@Override
public String printObject() {
try {
final LispThread thread = LispThread.currentThread();
// FIXME
if (typep(Symbol.RESTART) != NIL) {
Symbol PRINT_RESTART = PACKAGE_SYS.intern("PRINT-RESTART");
LispObject fun = PRINT_RESTART.getSymbolFunction();
StringOutputStream stream = new StringOutputStream();
thread.execute(fun, this, stream);
return stream.getString().getStringValue();
}
if (_PRINT_STRUCTURE_.symbolValue(thread) == NIL)
return unreadableString(structureClass.getName().printObject());
int maxLevel = Integer.MAX_VALUE;
LispObject printLevel = Symbol.PRINT_LEVEL.symbolValue(thread);
if (printLevel instanceof Fixnum) maxLevel = ((Fixnum) printLevel).value;
LispObject currentPrintLevel = _CURRENT_PRINT_LEVEL_.symbolValue(thread);
int currentLevel = Fixnum.getValue(currentPrintLevel);
if (currentLevel >= maxLevel && slots.length > 0) return "#";
StringBuilder sb = new StringBuilder("#S(");
sb.append(structureClass.getName().printObject());
if (currentLevel < maxLevel) {
LispObject effectiveSlots = structureClass.getSlotDefinitions();
LispObject[] effectiveSlotsArray = effectiveSlots.copyToArray();
Debug.assertTrue(effectiveSlotsArray.length == slots.length);
final LispObject printLength = Symbol.PRINT_LENGTH.symbolValue(thread);
final int limit;
if (printLength instanceof Fixnum)
limit = Math.min(slots.length, ((Fixnum) printLength).value);
else limit = slots.length;
final boolean printCircle = (Symbol.PRINT_CIRCLE.symbolValue(thread) != NIL);
for (int i = 0; i < limit; i++) {
sb.append(' ');
SimpleVector slotDefinition = (SimpleVector) effectiveSlotsArray[i];
// FIXME AREF(1)
LispObject slotName = slotDefinition.AREF(1);
Debug.assertTrue(slotName instanceof Symbol);
sb.append(':');
sb.append(((Symbol) slotName).name.getStringValue());
sb.append(' ');
if (printCircle) {
StringOutputStream stream = new StringOutputStream();
thread.execute(Symbol.OUTPUT_OBJECT.getSymbolFunction(), slots[i], stream);
sb.append(stream.getString().getStringValue());
} else sb.append(slots[i].printObject());
}
if (limit < slots.length) sb.append(" ...");
}
sb.append(')');
return sb.toString();
} catch (StackOverflowError e) {
error(new StorageCondition("Stack overflow."));
return null; // Not reached.
}
}
@Override
public final LispObject[] copyToArray() {
final int length = length();
LispObject[] array = new LispObject[length];
LispObject rest = this;
for (int i = 0; i < length; i++) {
array[i] = rest.car();
rest = rest.cdr();
}
return array;
}
protected int getSlotIndex(LispObject slotName) {
LispObject effectiveSlots = structureClass.getSlotDefinitions();
LispObject[] effectiveSlotsArray = effectiveSlots.copyToArray();
for (int i = 0; i < slots.length; i++) {
SimpleVector slotDefinition = (SimpleVector) effectiveSlotsArray[i];
LispObject candidateSlotName = slotDefinition.AREF(1);
if (slotName == candidateSlotName) {
return i;
}
}
return -1;
}
@Override
public LispObject NTH(int index) {
if (index < 0) type_error(Fixnum.getInstance(index), Symbol.UNSIGNED_BYTE);
int i = 0;
LispObject obj = this;
while (true) {
if (i == index) return obj.car();
obj = obj.cdr();
if (obj == NIL) return NIL;
++i;
}
}
@Override
public final int length() {
int length = 1;
LispObject obj = cdr;
while (obj != NIL) {
++length;
if (obj.isCons()) {
obj = ((Cons) obj).cdr;
} else type_error(obj, Symbol.LIST);
}
return length;
}
public SimpleArray_UnsignedByte8(int[] dimv, LispObject initialContents) {
this.dimv = dimv;
final int rank = dimv.length;
LispObject rest = initialContents;
for (int i = 0; i < rank; i++) {
dimv[i] = rest.length();
rest = rest.elt(0);
}
totalSize = computeTotalSize(dimv);
data = new byte[totalSize];
setInitialContents(0, dimv, initialContents, 0);
}
public SimpleArray_UnsignedByte8(int rank, LispObject initialContents) {
if (rank < 2) Debug.assertTrue(false);
dimv = new int[rank];
LispObject rest = initialContents;
for (int i = 0; i < rank; i++) {
dimv[i] = rest.length();
if (rest == NIL || rest.length() == 0) break;
rest = rest.elt(0);
}
totalSize = computeTotalSize(dimv);
data = new byte[totalSize];
setInitialContents(0, dimv, initialContents, 0);
}
private static final int computeHash(LispObject obj, int depth) {
if (obj.isCons()) {
if (depth > 0) {
int n1 = computeHash(((Cons) obj).car, depth - 1);
int n2 = computeHash(((Cons) obj).cdr, depth - 1);
return n1 ^ n2;
} else {
// This number comes from SBCL, but since we're not really
// using SBCL's SXHASH algorithm, it's probably not optimal.
// But who knows?
return 261835505;
}
} else return obj.sxhash();
}
public Cons(Cons original) {
Cons rest = original;
LispObject result = NIL;
while (rest.car() != NIL) {
result = result.push(rest.car());
if (rest.cdr() == NIL) {
break;
}
rest = (Cons) rest.cdr();
}
result = result.nreverse();
this.car = result.car();
this.cdr = result.cdr();
++count;
}
@Override
public final boolean constantp() {
if (car == Symbol.QUOTE) {
if (cdr.isCons()) if (((Cons) cdr).cdr == NIL) return true;
}
return false;
}
@Override
public LispObject typep(LispObject typeSpecifier) {
if (null == typeSpecifier) {
return NIL;
}
if (typeSpecifier.isSymbol()) {
if (typeSpecifier == Symbol.LIST) return T;
if (typeSpecifier == Symbol.CONS) return T;
if (typeSpecifier == Symbol.SEQUENCE) return T;
if (typeSpecifier == T) return T;
} else if (typeSpecifier.isLispClass()) {
if (typeSpecifier == BuiltInClass.LIST) return T;
if (typeSpecifier == BuiltInClass.CONS) return T;
if (typeSpecifier == BuiltInClass.SEQUENCE) return T;
if (typeSpecifier == BuiltInClass.CLASS_T) return T;
}
return NIL;
}
@Override
public LispObject evalImpl(final Environment env, final LispThread thread) {
if (false && car.isOperator()) {
LispObject fun = car; // env.lookupFunction(car);
if (fun != null) return evalCall(fun, cdr, env, thread);
}
if (car.isSymbol()) {
final Symbol first = (Symbol) car;
LispObject fun = env.lookupFunction(car);
if (fun instanceof SpecialOperator) {
if (profiling) if (!sampling) fun.incrementCallCount();
// Don't eval args!
maybeSaveSymbolFunction(first, fun);
return fun.execute(cdr, env);
}
if (fun != null && fun.isMacroObject()) {
maybeSaveSymbolFunction(first, fun);
LispObject lo = macroexpand(this, env, thread);
return eval(lo, env, thread);
}
if (fun != null && fun.isAutoload()) {
Autoload autoload = (Autoload) fun;
autoload.load();
maybeSaveSymbolFunction(first, autoload);
return eval(this, env, thread);
}
maybeSaveSymbolFunction(first, fun);
return evalCall(fun != null ? fun : first, cdr, env, thread);
} else {
final LispObject first = car;
if (first != null && first.isCons() && first.car() == Symbol.LAMBDA) {
Closure closure = new Closure(first, env);
maybeSaveSymbolFunction(first, closure);
return evalCall(closure, cdr, env, thread);
} else return program_error("Illegal function object: " + Lisp.princNonNull(first) + ".");
}
}
@Override
public LispObject getParts() {
LispObject result = NIL;
result = result.push(new Cons("class", structureClass));
LispObject effectiveSlots = structureClass.getSlotDefinitions();
LispObject[] effectiveSlotsArray = effectiveSlots.copyToArray();
Debug.assertTrue(effectiveSlotsArray.length == slots.length);
for (int i = 0; i < slots.length; i++) {
SimpleVector slotDefinition = (SimpleVector) effectiveSlotsArray[i];
LispObject slotName = slotDefinition.AREF(1);
result = result.push(new Cons(slotName, slots[i]));
}
return result.nreverse();
}
@Override
public final LispObject nreverse() {
if (cdr.isCons()) {
Cons cons = (Cons) cdr;
if (cons.cdr.isCons()) {
Cons cons1 = cons;
LispObject list = NIL;
do {
Cons temp = (Cons) cons.cdr;
cons.cdr = list;
list = cons;
cons = temp;
} while (cons.cdr.isCons());
if (cons.cdr != NIL) return type_error(cons.cdr, Symbol.LIST);
cdr = list;
cons1.cdr = cons;
} else if (cons.cdr != NIL) return type_error(cons.cdr, Symbol.LIST);
LispObject temp = car;
car = cons.car;
cons.car = temp;
} else if (cdr != NIL) return type_error(cdr, Symbol.LIST);
return this;
}
@Override
public LispObject execute(LispObject baseName) {
return new FaslClassLoader(baseName.getStringValue()).boxedThis;
}
@Override
public int hashCode() {
return (car == null ? 0 : car.hashCode()) ^ (cdr == null ? 0 : cdr.hashCode());
}
@Override
public LispObject printObject() {
final LispThread thread = LispThread.currentThread();
final LispObject printLength = Symbol.PRINT_LENGTH.symbolValue(thread);
final int maxLength;
if (printLength.isFixnum()) maxLength = ((Fixnum) printLength).value;
else maxLength = Integer.MAX_VALUE;
final LispObject printLevel = Symbol.PRINT_LEVEL.symbolValue(thread);
final int maxLevel;
if (printLevel.isFixnum()) maxLevel = ((Fixnum) printLevel).value;
else maxLevel = Integer.MAX_VALUE;
StringBuilder sb = new StringBuilder();
if (car == Symbol.QUOTE) {
if (cdr.isCons()) {
// Not a dotted list.
if (cdr.cdr() == NIL) {
sb.append('\'');
sb.append(cdr.car().printObject());
return new SimpleString(sb.toString());
}
}
}
if (car == Symbol.FUNCTION) {
if (cdr.isCons()) {
// Not a dotted list.
if (cdr.cdr() == NIL) {
sb.append("#'");
sb.append(cdr.car().printObject().toString());
return new SimpleString(sb.toString());
}
}
}
LispObject currentPrintLevel = _CURRENT_PRINT_LEVEL_.symbolValue(thread);
int currentLevel = Fixnum.getValue(currentPrintLevel);
if (currentLevel < maxLevel) {
final SpecialBindingsMark mark = thread.markSpecialBindings();
thread.bindSpecial(_CURRENT_PRINT_LEVEL_, currentPrintLevel.incr());
try {
int count = 0;
boolean truncated = false;
sb.append('(');
if (count < maxLength) {
LispObject p = this;
sb.append(p.car().printObject());
++count;
while ((p = p.cdr()).isCons()) {
sb.append(' ');
if (count < maxLength) {
sb.append(p.car().printObject());
++count;
} else {
truncated = true;
break;
}
}
if (!truncated && p != NIL) {
sb.append(" . ");
sb.append(p.printObject());
}
} else truncated = true;
if (truncated) sb.append("...");
sb.append(')');
} finally {
thread.resetSpecialBindings(mark);
}
} else sb.append('#');
return new SimpleString(sb.toString());
}
@Override
public LispObject execute(LispObject first, LispObject second) {
return new StructureObject(checkSymbol(first), second.copyToArray());
}
@Override
public LispObject execute(LispObject loader, LispObject fnNumber) {
FaslClassLoader l = (FaslClassLoader) loader.javaInstance(FaslClassLoader.class);
return l.loadFunction(fnNumber.intValue());
}
