コード例 #1
0
ファイル: Cons.java プロジェクト: rritoch/jrelisp-abcl
 @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
ファイル: StructureObject.java プロジェクト: symeonn/test
 private LispObject badIndex(int n) {
   StringBuilder sb = new StringBuilder("Invalid slot index ");
   sb.append(Fixnum.getInstance(n).princToString());
   sb.append(" for ");
   sb.append(princToString());
   return error(new LispError(sb.toString()));
 }
コード例 #3
0
ファイル: StructureObject.java プロジェクト: symeonn/test
 @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.
   }
 }
コード例 #4
0
ファイル: StructureObject.java プロジェクト: symeonn/test
 @Override
 public int getFixnumSlotValue(int index) {
   try {
     return Fixnum.getValue(slots[index]);
   } catch (ArrayIndexOutOfBoundsException e) {
     badIndex(index);
     // Not reached.
     return 0;
   }
 }
コード例 #5
0
ファイル: StructureObject.java プロジェクト: symeonn/test
 @Override
 public LispObject execute(LispObject first, LispObject second) {
   if (first instanceof StructureObject)
     try {
       return ((StructureObject) first).slots[Fixnum.getValue(second)];
     } catch (ArrayIndexOutOfBoundsException e) {
       // Shouldn't happen.
       return error(new LispError("Internal error."));
     }
   return type_error(first, Symbol.STRUCTURE_OBJECT);
 }
コード例 #6
0
ファイル: Cons.java プロジェクト: rritoch/jrelisp-abcl
 @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;
   }
 }
コード例 #7
0
 @Override
 public LispObject getDimensions() {
   LispObject result = NIL;
   for (int i = dimv.length; i-- > 0; ) result = new Cons(Fixnum.getInstance(dimv[i]), result);
   return result;
 }
コード例 #8
0
ファイル: Cons.java プロジェクト: rritoch/jrelisp-abcl
 @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());
 }
コード例 #9
0
ファイル: StructureObject.java プロジェクト: symeonn/test
 @Override
 public LispObject execute(LispObject arg) {
   if (arg instanceof StructureObject)
     return Fixnum.getInstance(((StructureObject) arg).slots.length);
   return type_error(arg, Symbol.STRUCTURE_OBJECT);
 }