예제 #1
0
 @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;
   }
 }
예제 #2
0
  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;
  }
예제 #3
0
 @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;
 }
예제 #4
0
 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();
 }
예제 #5
0
 @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.
   }
 }
예제 #6
0
 @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;
 }
예제 #7
0
 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;
 }
예제 #8
0
 @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;
   }
 }
예제 #9
0
 @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;
 }
예제 #10
0
  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);
  }
예제 #11
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);
  }
예제 #12
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();
 }
예제 #13
0
 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;
 }
예제 #14
0
 @Override
 public final boolean constantp() {
   if (car == Symbol.QUOTE) {
     if (cdr.isCons()) if (((Cons) cdr).cdr == NIL) return true;
   }
   return false;
 }
예제 #15
0
  @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;
  }
예제 #16
0
 @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) + ".");
   }
 }
예제 #17
0
 @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();
 }
예제 #18
0
 @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;
 }
예제 #19
0
 @Override
 public LispObject execute(LispObject baseName) {
   return new FaslClassLoader(baseName.getStringValue()).boxedThis;
 }
예제 #20
0
 @Override
 public int hashCode() {
   return (car == null ? 0 : car.hashCode()) ^ (cdr == null ? 0 : cdr.hashCode());
 }
예제 #21
0
 @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());
 }
예제 #22
0
 @Override
 public LispObject execute(LispObject first, LispObject second) {
   return new StructureObject(checkSymbol(first), second.copyToArray());
 }
예제 #23
0
 @Override
 public LispObject execute(LispObject loader, LispObject fnNumber) {
   FaslClassLoader l = (FaslClassLoader) loader.javaInstance(FaslClassLoader.class);
   return l.loadFunction(fnNumber.intValue());
 }