1 /* 2 * LispObject.java 3 * 4 * Copyright (C) 2002-2007 Peter Graves 5 * $Id$ 6 * 7 * This program is free software; you can redistribute it and/or 8 * modify it under the terms of the GNU General Public License 9 * as published by the Free Software Foundation; either version 2 10 * of the License, or (at your option) any later version. 11 * 12 * This program is distributed in the hope that it will be useful, 13 * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 * GNU General Public License for more details. 16 * 17 * You should have received a copy of the GNU General Public License 18 * along with this program; if not, write to the Free Software 19 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 20 * 21 * As a special exception, the copyright holders of this library give you 22 * permission to link this library with independent modules to produce an 23 * executable, regardless of the license terms of these independent 24 * modules, and to copy and distribute the resulting executable under 25 * terms of your choice, provided that you also meet, for each linked 26 * independent module, the terms and conditions of the license of that 27 * module. An independent module is a module which is not derived from 28 * or based on this library. If you modify this library, you may extend 29 * this exception to your version of the library, but you are not 30 * obligated to do so. If you do not wish to do so, delete this 31 * exception statement from your version. 32 */ 33 34 package org.armedbear.lisp; 35 36 import static org.armedbear.lisp.Lisp.*; 37 import java.util.WeakHashMap; 38 39 public class LispObject //extends Lisp 40 { 41 42 /** Function to allow objects to return the value 43 * "they stand for". Used by AutoloadedFunctionProxy to return 44 * the function it is proxying. 45 */ resolve()46 public LispObject resolve() 47 { 48 return this; 49 } 50 typeOf()51 public LispObject typeOf() 52 { 53 return T; 54 } 55 getInstance(boolean b)56 static public LispObject getInstance(boolean b) { 57 return b ? T : NIL; 58 } 59 classOf()60 public LispObject classOf() 61 { 62 return BuiltInClass.CLASS_T; 63 } 64 getDescription()65 public LispObject getDescription() 66 { 67 StringBuilder sb = new StringBuilder("An object of type "); 68 sb.append(typeOf().princToString()); 69 sb.append(" at #x"); 70 sb.append(Integer.toHexString(System.identityHashCode(this)).toUpperCase()); 71 return new SimpleString(sb); 72 } 73 74 /** 75 * Implementing the getParts() protocol will allow INSPECT to 76 * return information about the substructure of a descendent of 77 * LispObject. 78 * 79 * The protocol is to return a List of Cons pairs, where the car of 80 * each pair contains a decriptive string, and the cdr returns a 81 * subobject for inspection. 82 */ getParts()83 public LispObject getParts() 84 { 85 return NIL; 86 } 87 getBooleanValue()88 public boolean getBooleanValue() 89 { 90 return true; 91 } 92 typep(LispObject typeSpecifier)93 public LispObject typep(LispObject typeSpecifier) 94 { 95 if (typeSpecifier == T) 96 return T; 97 if (typeSpecifier == BuiltInClass.CLASS_T) 98 return T; 99 if (typeSpecifier == Symbol.ATOM) 100 return T; 101 return NIL; 102 } 103 constantp()104 public boolean constantp() 105 { 106 return true; 107 } 108 CONSTANTP()109 public final LispObject CONSTANTP() 110 { 111 return constantp() ? T : NIL; 112 } 113 ATOM()114 public final LispObject ATOM() 115 { 116 return atom() ? T : NIL; 117 } 118 atom()119 public boolean atom() 120 { 121 return true; 122 } 123 javaInstance()124 public Object javaInstance() 125 { 126 return this; 127 } 128 javaInstance(Class<?> c)129 public Object javaInstance(Class<?> c) 130 { 131 if (c.isAssignableFrom(getClass())) { 132 return this; 133 } 134 135 if (c == Boolean.class || c == boolean.class) 136 return Boolean.TRUE; 137 138 return error(new LispError("The value " + princToString() + 139 " is not of class " + c.getName())); 140 } 141 142 /** This method returns 'this' by default, but allows 143 * objects to return different values to increase Java 144 * interoperability 145 * 146 * @return An object to be used with synchronized, wait, notify, etc 147 */ lockableInstance()148 public Object lockableInstance() 149 { 150 return this; 151 } 152 153 car()154 public final LispObject car() 155 { 156 if (this instanceof Cons) { 157 return ((Cons)this).car; 158 } else if (this instanceof Nil) { 159 return NIL; 160 } 161 return type_error(this, Symbol.LIST); 162 } 163 setCar(LispObject obj)164 public final void setCar(LispObject obj) 165 { 166 if (this instanceof Cons) { 167 ((Cons)this).car = obj; 168 return; 169 } 170 type_error(this, Symbol.CONS); 171 } 172 RPLACA(LispObject obj)173 public LispObject RPLACA(LispObject obj) 174 { 175 return type_error(this, Symbol.CONS); 176 } 177 cdr()178 public final LispObject cdr() 179 { 180 if (this instanceof Cons) { 181 return ((Cons)this).cdr; 182 } else if (this instanceof Nil) { 183 return NIL; 184 } 185 return type_error(this, Symbol.LIST); 186 } 187 setCdr(LispObject obj)188 public final void setCdr(LispObject obj) 189 { 190 if (this instanceof Cons) { 191 ((Cons)this).cdr = obj; 192 return; 193 } 194 195 type_error(this, Symbol.CONS); 196 } 197 RPLACD(LispObject obj)198 public LispObject RPLACD(LispObject obj) 199 { 200 return type_error(this, Symbol.CONS); 201 } 202 cadr()203 public final LispObject cadr() 204 { 205 LispObject tail = cdr(); 206 if (!(tail instanceof Nil)) { 207 return tail.car(); 208 } else 209 return NIL; 210 } 211 cddr()212 public final LispObject cddr() 213 { 214 LispObject tail = cdr(); 215 if (!(tail instanceof Nil)) { 216 return tail.cdr(); 217 } else 218 return NIL; 219 } 220 caddr()221 public final LispObject caddr() 222 { 223 LispObject tail = cddr(); 224 if (!(tail instanceof Nil)) { 225 return tail.car(); 226 } else 227 return NIL; 228 } 229 nthcdr(int n)230 public final LispObject nthcdr(int n) 231 { 232 if (n < 0) 233 return type_error(Fixnum.getInstance(n), 234 list(Symbol.INTEGER, Fixnum.ZERO)); 235 if (this instanceof Cons) { 236 LispObject result = this; 237 for (int i = n; i-- > 0;) { 238 result = result.cdr(); 239 if (result == NIL) 240 break; 241 } 242 return result; 243 } else if (this instanceof Nil) { 244 return NIL; 245 } 246 return type_error(this, Symbol.LIST); 247 } 248 push(LispObject obj)249 public final LispObject push(LispObject obj) 250 { 251 if (this instanceof Cons) { 252 return new Cons(obj, this); 253 } else if (this instanceof Nil) { 254 return new Cons(obj); 255 } 256 return type_error(this, Symbol.LIST); 257 } 258 EQ(LispObject obj)259 final public LispObject EQ(LispObject obj) 260 { 261 return this == obj ? T : NIL; 262 } 263 eql(char c)264 public boolean eql(char c) 265 { 266 return false; 267 } 268 eql(int n)269 public boolean eql(int n) 270 { 271 return false; 272 } 273 eql(LispObject obj)274 public boolean eql(LispObject obj) 275 { 276 return this == obj; 277 } 278 EQL(LispObject obj)279 public final LispObject EQL(LispObject obj) 280 { 281 return eql(obj) ? T : NIL; 282 } 283 EQUAL(LispObject obj)284 public final LispObject EQUAL(LispObject obj) 285 { 286 return equal(obj) ? T : NIL; 287 } 288 equal(int n)289 public boolean equal(int n) 290 { 291 return false; 292 } 293 equal(LispObject obj)294 public boolean equal(LispObject obj) 295 { 296 return this == obj; 297 } 298 equalp(int n)299 public boolean equalp(int n) 300 { 301 return false; 302 } 303 equalp(LispObject obj)304 public boolean equalp(LispObject obj) 305 { 306 return this == obj; 307 } 308 ABS()309 public LispObject ABS() 310 { 311 return type_error(this, Symbol.NUMBER); 312 } 313 NUMERATOR()314 public LispObject NUMERATOR() 315 { 316 return type_error(this, Symbol.RATIONAL); 317 } 318 DENOMINATOR()319 public LispObject DENOMINATOR() 320 { 321 return type_error(this, Symbol.RATIONAL); 322 } 323 EVENP()324 public final LispObject EVENP() 325 { 326 return evenp() ? T : NIL; 327 } 328 evenp()329 public boolean evenp() 330 { 331 type_error(this, Symbol.INTEGER); 332 // Not reached. 333 return false; 334 } 335 ODDP()336 public final LispObject ODDP() 337 { 338 return oddp() ? T : NIL; 339 } 340 oddp()341 public boolean oddp() 342 { 343 type_error(this, Symbol.INTEGER); 344 // Not reached. 345 return false; 346 } 347 PLUSP()348 public final LispObject PLUSP() 349 { 350 return plusp() ? T : NIL; 351 } 352 plusp()353 public boolean plusp() 354 { 355 type_error(this, Symbol.REAL); 356 // Not reached. 357 return false; 358 } 359 MINUSP()360 public final LispObject MINUSP() 361 { 362 return minusp() ? T : NIL; 363 } 364 minusp()365 public boolean minusp() 366 { 367 type_error(this, Symbol.REAL); 368 // Not reached. 369 return false; 370 } 371 NUMBERP()372 public final LispObject NUMBERP() 373 { 374 return numberp() ? T : NIL; 375 } 376 numberp()377 public boolean numberp() 378 { 379 return false; 380 } 381 ZEROP()382 public final LispObject ZEROP() 383 { 384 return zerop() ? T : NIL; 385 } 386 zerop()387 public boolean zerop() 388 { 389 type_error(this, Symbol.NUMBER); 390 // Not reached. 391 return false; 392 } 393 COMPLEXP()394 public LispObject COMPLEXP() 395 { 396 return NIL; 397 } 398 FLOATP()399 public final LispObject FLOATP() 400 { 401 return floatp() ? T : NIL; 402 } 403 floatp()404 public boolean floatp() 405 { 406 return false; 407 } 408 INTEGERP()409 public final LispObject INTEGERP() 410 { 411 return integerp() ? T : NIL; 412 } 413 integerp()414 public boolean integerp() 415 { 416 return false; 417 } 418 RATIONALP()419 public final LispObject RATIONALP() 420 { 421 return rationalp() ? T : NIL; 422 } 423 rationalp()424 public boolean rationalp() 425 { 426 return false; 427 } 428 REALP()429 public final LispObject REALP() 430 { 431 return realp() ? T : NIL; 432 } 433 realp()434 public boolean realp() 435 { 436 return false; 437 } 438 STRINGP()439 public final LispObject STRINGP() 440 { 441 return stringp() ? T : NIL; 442 } 443 stringp()444 public boolean stringp() 445 { 446 return false; 447 } 448 SIMPLE_STRING_P()449 public LispObject SIMPLE_STRING_P() 450 { 451 return NIL; 452 } 453 VECTORP()454 public final LispObject VECTORP() 455 { 456 return vectorp() ? T : NIL; 457 } 458 vectorp()459 public boolean vectorp() 460 { 461 return false; 462 } 463 CHARACTERP()464 public final LispObject CHARACTERP() 465 { 466 return characterp() ? T : NIL; 467 } 468 characterp()469 public boolean characterp() 470 { 471 return false; 472 } 473 length()474 public int length() 475 { 476 type_error(this, Symbol.SEQUENCE); 477 // Not reached. 478 return 0; 479 } 480 LENGTH()481 public final LispObject LENGTH() 482 { 483 return Fixnum.getInstance(length()); 484 } 485 CHAR(int index)486 public LispObject CHAR(int index) 487 { 488 return type_error(this, Symbol.STRING); 489 } 490 SCHAR(int index)491 public LispObject SCHAR(int index) 492 { 493 return type_error(this, Symbol.SIMPLE_STRING); 494 } 495 NTH(int index)496 public LispObject NTH(int index) 497 { 498 return type_error(this, Symbol.LIST); 499 } 500 NTH(LispObject arg)501 public final LispObject NTH(LispObject arg) 502 { 503 return NTH(Fixnum.getValue(arg)); 504 } 505 elt(int index)506 public LispObject elt(int index) 507 { 508 return type_error(this, Symbol.SEQUENCE); 509 } 510 reverse()511 public LispObject reverse() 512 { 513 return type_error(this, Symbol.SEQUENCE); 514 } 515 nreverse()516 public LispObject nreverse() 517 { 518 return type_error(this, Symbol.SEQUENCE); 519 } 520 aref_long(int index)521 public long aref_long(int index) 522 { 523 return AREF(index).longValue(); 524 } 525 aref(int index)526 public int aref(int index) 527 { 528 return AREF(index).intValue(); 529 } 530 AREF(int index)531 public LispObject AREF(int index) 532 { 533 return type_error(this, Symbol.ARRAY); 534 } 535 AREF(LispObject index)536 public final LispObject AREF(LispObject index) 537 { 538 return AREF(Fixnum.getValue(index)); 539 } 540 aset(int index, int n)541 public void aset(int index, int n) 542 543 { 544 aset(index, Fixnum.getInstance(n)); 545 } 546 aset(int index, LispObject newValue)547 public void aset(int index, LispObject newValue) 548 549 { 550 type_error(this, Symbol.ARRAY); 551 } 552 aset(LispObject index, LispObject newValue)553 public final void aset(LispObject index, LispObject newValue) 554 555 { 556 aset(Fixnum.getValue(index), newValue); 557 } 558 SVREF(int index)559 public LispObject SVREF(int index) 560 { 561 return type_error(this, Symbol.SIMPLE_VECTOR); 562 } 563 svset(int index, LispObject newValue)564 public void svset(int index, LispObject newValue) 565 { 566 type_error(this, Symbol.SIMPLE_VECTOR); 567 } 568 vectorPushExtend(LispObject element)569 public void vectorPushExtend(LispObject element) 570 571 { 572 noFillPointer(); 573 } 574 VECTOR_PUSH_EXTEND(LispObject element)575 public LispObject VECTOR_PUSH_EXTEND(LispObject element) 576 577 { 578 return noFillPointer(); 579 } 580 VECTOR_PUSH_EXTEND(LispObject element, LispObject extension)581 public LispObject VECTOR_PUSH_EXTEND(LispObject element, LispObject extension) 582 583 { 584 return noFillPointer(); 585 } 586 noFillPointer()587 public final LispObject noFillPointer() 588 { 589 return type_error(this, list(Symbol.AND, Symbol.VECTOR, 590 list(Symbol.SATISFIES, 591 Symbol.ARRAY_HAS_FILL_POINTER_P))); 592 } 593 copyToArray()594 public LispObject[] copyToArray() 595 { 596 type_error(this, Symbol.LIST); 597 // Not reached. 598 return null; 599 } 600 SYMBOLP()601 public final LispObject SYMBOLP() 602 { 603 return (this instanceof Symbol) ? T : NIL; 604 } 605 listp()606 public final boolean listp() 607 { 608 return (this instanceof Cons) || (this instanceof Nil); 609 } 610 LISTP()611 public final LispObject LISTP() 612 { 613 return listp() ? T : NIL; 614 } 615 endp()616 public final boolean endp() 617 { 618 if (this instanceof Cons) 619 return false; 620 else if (this instanceof Nil) 621 return true; 622 type_error(this, Symbol.LIST); 623 // Not reached. 624 return false; 625 } 626 ENDP()627 public final LispObject ENDP() 628 { 629 return endp() ? T : NIL; 630 } 631 NOT()632 public LispObject NOT() 633 { 634 return NIL; 635 } 636 isSpecialOperator()637 public boolean isSpecialOperator() 638 { 639 type_error(this, Symbol.SYMBOL); 640 // Not reached. 641 return false; 642 } 643 isSpecialVariable()644 public boolean isSpecialVariable() 645 { 646 return false; 647 } 648 649 private static final WeakHashMap<LispObject, LispObject> 650 documentationHashTable = new WeakHashMap<LispObject, LispObject>(); 651 getDocumentation(LispObject docType)652 public LispObject getDocumentation(LispObject docType) 653 654 { 655 LispObject alist; 656 synchronized (documentationHashTable) { 657 alist = documentationHashTable.get(this); 658 } 659 if (alist != null) 660 { 661 LispObject entry = assq(docType, alist); 662 if (entry instanceof Cons) 663 return ((Cons)entry).cdr; 664 } 665 if(docType == Symbol.FUNCTION && this instanceof Symbol) { 666 LispObject fn = ((Symbol)this).getSymbolFunction(); 667 if(fn instanceof Function) { 668 DocString ds = fn.getClass().getAnnotation(DocString.class); 669 if(ds != null) { 670 String arglist = ds.args(); 671 String docstring = ds.doc(); 672 if(arglist.length() != 0) 673 ((Function)fn).setLambdaList(new SimpleString(arglist)); 674 if(docstring.length() != 0) { 675 SimpleString doc = new SimpleString(docstring); 676 ((Symbol)this).setDocumentation(Symbol.FUNCTION, doc); 677 return doc; 678 } else if (fn.typep(Symbol.STANDARD_GENERIC_FUNCTION) != NIL) { 679 return Symbol.SLOT_VALUE.execute(fn, Symbol._DOCUMENTATION); 680 } 681 } 682 } 683 } 684 return NIL; 685 } 686 setDocumentation(LispObject docType, LispObject documentation)687 public void setDocumentation(LispObject docType, LispObject documentation) 688 689 { 690 synchronized (documentationHashTable) { 691 LispObject alist = documentationHashTable.get(this); 692 if (alist == null) 693 alist = NIL; 694 LispObject entry = assq(docType, alist); 695 if (entry instanceof Cons) 696 { 697 ((Cons)entry).cdr = documentation; 698 } 699 else 700 { 701 alist = alist.push(new Cons(docType, documentation)); 702 documentationHashTable.put(this, alist); 703 } 704 } 705 } 706 getPropertyList()707 public LispObject getPropertyList() 708 { 709 return null; 710 } 711 setPropertyList(LispObject obj)712 public void setPropertyList(LispObject obj) 713 { 714 } 715 getSymbolValue()716 public LispObject getSymbolValue() 717 { 718 return type_error(this, Symbol.SYMBOL); 719 } 720 getSymbolFunction()721 public LispObject getSymbolFunction() 722 { 723 return type_error(this, Symbol.SYMBOL); 724 } 725 getSymbolFunctionOrDie()726 public LispObject getSymbolFunctionOrDie() 727 { 728 return type_error(this, Symbol.SYMBOL); 729 } 730 getSymbolSetfFunction()731 public LispObject getSymbolSetfFunction() 732 { 733 return type_error(this, Symbol.SYMBOL); 734 } 735 getSymbolSetfFunctionOrDie()736 public LispObject getSymbolSetfFunctionOrDie() 737 { 738 return type_error(this, Symbol.SYMBOL); 739 } 740 741 /** PRINC-TO-STRING function to be used with Java objects 742 * 743 * @return A string in human-readable format, as per PRINC definition 744 */ princToString()745 public String princToString() 746 { 747 LispThread thread = LispThread.currentThread(); 748 SpecialBindingsMark mark = thread.markSpecialBindings(); 749 try { 750 thread.bindSpecial(Symbol.PRINT_READABLY, NIL); 751 thread.bindSpecial(Symbol.PRINT_ESCAPE, NIL); 752 return printObject(); 753 } 754 finally { 755 thread.resetSpecialBindings(mark); 756 } 757 } 758 printObject()759 public String printObject() 760 { 761 return unreadableString(toString(), false); 762 } 763 764 /** Calls unreadableString(String s, boolean identity) with a default 765 * identity value of 'true'. 766 * 767 * This function is a helper for printObject() 768 * 769 * @param s String representation of this object. 770 * @return String enclosed in the non-readable #< ... > markers 771 */ unreadableString(String s)772 public final String unreadableString(String s) { 773 return unreadableString(s, true); 774 } 775 776 /** Creates a non-readably (as per CLHS terminology) representation 777 * of the 'this' object, using string 's'. 778 * 779 * If the current value of the variable *PRINT-READABLY* is T, a 780 * Lisp error is thrown and no value is returned. 781 * 782 * This function is a helper for printObject() 783 * 784 * @param s 785 * @param identity when 'true', includes Java's identityHash for the object 786 * in the output. 787 * @return a non reabable string (i.e. one enclosed in the #< > markers) 788 */ unreadableString(String s, boolean identity)789 public final String unreadableString(String s, boolean identity) 790 { 791 if (Symbol.PRINT_READABLY.symbolValue() != NIL) { 792 error(new PrintNotReadable(list(Keyword.OBJECT, this))); 793 return null; // not reached 794 } 795 StringBuilder sb = new StringBuilder("#<"); 796 sb.append(s); 797 if (identity) { 798 sb.append(" {"); 799 sb.append(Integer.toHexString(System.identityHashCode(this)).toUpperCase()); 800 sb.append("}"); 801 } 802 sb.append(">"); 803 return sb.toString(); 804 } 805 806 // Special operator execute(LispObject args, Environment env)807 public LispObject execute(LispObject args, Environment env) 808 809 { 810 return error(new LispError()); 811 } 812 execute()813 public LispObject execute() 814 { 815 return type_error(this, Symbol.FUNCTION); 816 } 817 execute(LispObject arg)818 public LispObject execute(LispObject arg) 819 { 820 return type_error(this, Symbol.FUNCTION); 821 } 822 execute(LispObject first, LispObject second)823 public LispObject execute(LispObject first, LispObject second) 824 825 { 826 return type_error(this, Symbol.FUNCTION); 827 } 828 execute(LispObject first, LispObject second, LispObject third)829 public LispObject execute(LispObject first, LispObject second, 830 LispObject third) 831 832 { 833 return type_error(this, Symbol.FUNCTION); 834 } 835 execute(LispObject first, LispObject second, LispObject third, LispObject fourth)836 public LispObject execute(LispObject first, LispObject second, 837 LispObject third, LispObject fourth) 838 839 { 840 return type_error(this, Symbol.FUNCTION); 841 } 842 execute(LispObject first, LispObject second, LispObject third, LispObject fourth, LispObject fifth)843 public LispObject execute(LispObject first, LispObject second, 844 LispObject third, LispObject fourth, 845 LispObject fifth) 846 847 { 848 return type_error(this, Symbol.FUNCTION); 849 } 850 execute(LispObject first, LispObject second, LispObject third, LispObject fourth, LispObject fifth, LispObject sixth)851 public LispObject execute(LispObject first, LispObject second, 852 LispObject third, LispObject fourth, 853 LispObject fifth, LispObject sixth) 854 855 { 856 return type_error(this, Symbol.FUNCTION); 857 } 858 execute(LispObject first, LispObject second, LispObject third, LispObject fourth, LispObject fifth, LispObject sixth, LispObject seventh)859 public LispObject execute(LispObject first, LispObject second, 860 LispObject third, LispObject fourth, 861 LispObject fifth, LispObject sixth, 862 LispObject seventh) 863 864 { 865 return type_error(this, Symbol.FUNCTION); 866 } 867 execute(LispObject first, LispObject second, LispObject third, LispObject fourth, LispObject fifth, LispObject sixth, LispObject seventh, LispObject eighth)868 public LispObject execute(LispObject first, LispObject second, 869 LispObject third, LispObject fourth, 870 LispObject fifth, LispObject sixth, 871 LispObject seventh, LispObject eighth) 872 873 { 874 return type_error(this, Symbol.FUNCTION); 875 } 876 execute(LispObject[] args)877 public LispObject execute(LispObject[] args) 878 { 879 return type_error(this, Symbol.FUNCTION); 880 } 881 882 // Used by COMPILE-MULTIPLE-VALUE-CALL. dispatch(LispObject[] args)883 public LispObject dispatch(LispObject[] args) 884 { 885 switch (args.length) 886 { 887 case 0: 888 return execute(); 889 case 1: 890 return execute(args[0]); 891 case 2: 892 return execute(args[0], args[1]); 893 case 3: 894 return execute(args[0], args[1], args[2]); 895 case 4: 896 return execute(args[0], args[1], args[2], args[3]); 897 case 5: 898 return execute(args[0], args[1], args[2], args[3], args[4]); 899 case 6: 900 return execute(args[0], args[1], args[2], args[3], args[4], 901 args[5]); 902 case 7: 903 return execute(args[0], args[1], args[2], args[3], args[4], 904 args[5], args[6]); 905 case 8: 906 return execute(args[0], args[1], args[2], args[3], args[4], 907 args[5], args[6], args[7]); 908 default: 909 return execute(args); 910 } 911 } 912 intValue()913 public int intValue() 914 { 915 type_error(this, Symbol.INTEGER); 916 // Not reached. 917 return 0; 918 } 919 longValue()920 public long longValue() 921 { 922 type_error(this, Symbol.INTEGER); 923 // Not reached. 924 return 0; 925 } 926 floatValue()927 public float floatValue() 928 { 929 type_error(this, Symbol.SINGLE_FLOAT); 930 // Not reached 931 return 0; 932 } 933 doubleValue()934 public double doubleValue() 935 { 936 type_error(this, Symbol.DOUBLE_FLOAT); 937 // Not reached 938 return 0; 939 } 940 incr()941 public LispObject incr() 942 { 943 return type_error(this, Symbol.NUMBER); 944 } 945 decr()946 public LispObject decr() 947 { 948 return type_error(this, Symbol.NUMBER); 949 } 950 negate()951 public LispObject negate() 952 { 953 return Fixnum.ZERO.subtract(this); 954 } 955 add(int n)956 public LispObject add(int n) 957 { 958 return add(Fixnum.getInstance(n)); 959 } 960 add(LispObject obj)961 public LispObject add(LispObject obj) 962 { 963 return type_error(this, Symbol.NUMBER); 964 } 965 subtract(int n)966 public LispObject subtract(int n) 967 { 968 return subtract(Fixnum.getInstance(n)); 969 } 970 subtract(LispObject obj)971 public LispObject subtract(LispObject obj) 972 { 973 return type_error(this, Symbol.NUMBER); 974 } 975 multiplyBy(int n)976 public LispObject multiplyBy(int n) 977 { 978 return multiplyBy(Fixnum.getInstance(n)); 979 } 980 multiplyBy(LispObject obj)981 public LispObject multiplyBy(LispObject obj) 982 { 983 return type_error(this, Symbol.NUMBER); 984 } 985 divideBy(LispObject obj)986 public LispObject divideBy(LispObject obj) 987 { 988 return type_error(this, Symbol.NUMBER); 989 } 990 isEqualTo(int n)991 public boolean isEqualTo(int n) 992 { 993 return isEqualTo(Fixnum.getInstance(n)); 994 } 995 isEqualTo(LispObject obj)996 public boolean isEqualTo(LispObject obj) 997 { 998 type_error(this, Symbol.NUMBER); 999 // Not reached. 1000 return false; 1001 } 1002 IS_E(LispObject obj)1003 public final LispObject IS_E(LispObject obj) 1004 { 1005 return isEqualTo(obj) ? T : NIL; 1006 } 1007 isNotEqualTo(int n)1008 public boolean isNotEqualTo(int n) 1009 { 1010 return isNotEqualTo(Fixnum.getInstance(n)); 1011 } 1012 isNotEqualTo(LispObject obj)1013 public boolean isNotEqualTo(LispObject obj) 1014 { 1015 type_error(this, Symbol.NUMBER); 1016 // Not reached. 1017 return false; 1018 } 1019 IS_NE(LispObject obj)1020 public final LispObject IS_NE(LispObject obj) 1021 { 1022 return isNotEqualTo(obj) ? T : NIL; 1023 } 1024 isLessThan(int n)1025 public boolean isLessThan(int n) 1026 { 1027 return isLessThan(Fixnum.getInstance(n)); 1028 } 1029 isLessThan(LispObject obj)1030 public boolean isLessThan(LispObject obj) 1031 { 1032 type_error(this, Symbol.REAL); 1033 // Not reached. 1034 return false; 1035 } 1036 IS_LT(LispObject obj)1037 public final LispObject IS_LT(LispObject obj) 1038 { 1039 return isLessThan(obj) ? T : NIL; 1040 } 1041 isGreaterThan(int n)1042 public boolean isGreaterThan(int n) 1043 { 1044 return isGreaterThan(Fixnum.getInstance(n)); 1045 } 1046 isGreaterThan(LispObject obj)1047 public boolean isGreaterThan(LispObject obj) 1048 { 1049 type_error(this, Symbol.REAL); 1050 // Not reached. 1051 return false; 1052 } 1053 IS_GT(LispObject obj)1054 public final LispObject IS_GT(LispObject obj) 1055 { 1056 return isGreaterThan(obj) ? T : NIL; 1057 } 1058 isLessThanOrEqualTo(int n)1059 public boolean isLessThanOrEqualTo(int n) 1060 { 1061 return isLessThanOrEqualTo(Fixnum.getInstance(n)); 1062 } 1063 isLessThanOrEqualTo(LispObject obj)1064 public boolean isLessThanOrEqualTo(LispObject obj) 1065 { 1066 type_error(this, Symbol.REAL); 1067 // Not reached. 1068 return false; 1069 } 1070 IS_LE(LispObject obj)1071 public final LispObject IS_LE(LispObject obj) 1072 { 1073 return isLessThanOrEqualTo(obj) ? T : NIL; 1074 } 1075 isGreaterThanOrEqualTo(int n)1076 public boolean isGreaterThanOrEqualTo(int n) 1077 { 1078 return isGreaterThanOrEqualTo(Fixnum.getInstance(n)); 1079 } 1080 isGreaterThanOrEqualTo(LispObject obj)1081 public boolean isGreaterThanOrEqualTo(LispObject obj) 1082 { 1083 type_error(this, Symbol.REAL); 1084 // Not reached. 1085 return false; 1086 } 1087 IS_GE(LispObject obj)1088 public final LispObject IS_GE(LispObject obj) 1089 { 1090 return isGreaterThanOrEqualTo(obj) ? T : NIL; 1091 } 1092 truncate(LispObject obj)1093 public LispObject truncate(LispObject obj) 1094 { 1095 return type_error(this, Symbol.REAL); 1096 } 1097 MOD(LispObject divisor)1098 public LispObject MOD(LispObject divisor) 1099 { 1100 truncate(divisor); 1101 final LispThread thread = LispThread.currentThread(); 1102 LispObject remainder = thread._values[1]; 1103 thread.clearValues(); 1104 if (!remainder.zerop()) 1105 { 1106 if (divisor.minusp()) 1107 { 1108 if (plusp()) 1109 return remainder.add(divisor); 1110 } 1111 else 1112 { 1113 if (minusp()) 1114 return remainder.add(divisor); 1115 } 1116 } 1117 return remainder; 1118 } 1119 MOD(int divisor)1120 public LispObject MOD(int divisor) 1121 { 1122 return MOD(Fixnum.getInstance(divisor)); 1123 } 1124 ash(int shift)1125 public LispObject ash(int shift) 1126 { 1127 return ash(Fixnum.getInstance(shift)); 1128 } 1129 ash(LispObject obj)1130 public LispObject ash(LispObject obj) 1131 { 1132 return type_error(this, Symbol.INTEGER); 1133 } 1134 LOGNOT()1135 public LispObject LOGNOT() 1136 { 1137 return type_error(this, Symbol.INTEGER); 1138 } 1139 LOGAND(int n)1140 public LispObject LOGAND(int n) 1141 { 1142 return LOGAND(Fixnum.getInstance(n)); 1143 } 1144 LOGAND(LispObject obj)1145 public LispObject LOGAND(LispObject obj) 1146 { 1147 return type_error(this, Symbol.INTEGER); 1148 } 1149 LOGIOR(int n)1150 public LispObject LOGIOR(int n) 1151 { 1152 return LOGIOR(Fixnum.getInstance(n)); 1153 } 1154 LOGIOR(LispObject obj)1155 public LispObject LOGIOR(LispObject obj) 1156 { 1157 return type_error(this, Symbol.INTEGER); 1158 } 1159 LOGXOR(int n)1160 public LispObject LOGXOR(int n) 1161 { 1162 return LOGXOR(Fixnum.getInstance(n)); 1163 } 1164 LOGXOR(LispObject obj)1165 public LispObject LOGXOR(LispObject obj) 1166 { 1167 return type_error(this, Symbol.INTEGER); 1168 } 1169 LDB(int size, int position)1170 public LispObject LDB(int size, int position) 1171 { 1172 return type_error(this, Symbol.INTEGER); 1173 } 1174 sxhash()1175 public int sxhash() 1176 { 1177 return hashCode() & 0x7fffffff; 1178 } 1179 1180 // For EQUALP hash tables. psxhash()1181 public int psxhash() 1182 { 1183 return sxhash(); 1184 } 1185 psxhash(int depth)1186 public int psxhash(int depth) 1187 { 1188 return psxhash(); 1189 } 1190 STRING()1191 public LispObject STRING() 1192 { 1193 return error(new TypeError(princToString() + " cannot be coerced to a string.")); 1194 } 1195 chars()1196 public char[] chars() 1197 { 1198 type_error(this, Symbol.STRING); 1199 // Not reached. 1200 return null; 1201 } 1202 getStringChars()1203 public char[] getStringChars() 1204 { 1205 type_error(this, Symbol.STRING); 1206 // Not reached. 1207 return null; 1208 } 1209 1210 /** Returns a string representing the value 1211 * of a 'string designator', if the instance is one. 1212 * 1213 * Throws an error if the instance isn't a string designator. 1214 */ getStringValue()1215 public String getStringValue() 1216 { 1217 type_error(this, Symbol.STRING); 1218 // Not reached. 1219 return null; 1220 } 1221 getSlotValue_0()1222 public LispObject getSlotValue_0() 1223 { 1224 return type_error(this, Symbol.STRUCTURE_OBJECT); 1225 } 1226 getSlotValue_1()1227 public LispObject getSlotValue_1() 1228 { 1229 return type_error(this, Symbol.STRUCTURE_OBJECT); 1230 } 1231 getSlotValue_2()1232 public LispObject getSlotValue_2() 1233 { 1234 return type_error(this, Symbol.STRUCTURE_OBJECT); 1235 } 1236 getSlotValue_3()1237 public LispObject getSlotValue_3() 1238 { 1239 return type_error(this, Symbol.STRUCTURE_OBJECT); 1240 } 1241 getSlotValue(int index)1242 public LispObject getSlotValue(int index) 1243 { 1244 return type_error(this, Symbol.STRUCTURE_OBJECT); 1245 } 1246 getFixnumSlotValue(int index)1247 public int getFixnumSlotValue(int index) 1248 { 1249 type_error(this, Symbol.STRUCTURE_OBJECT); 1250 // Not reached. 1251 return 0; 1252 } 1253 getSlotValueAsBoolean(int index)1254 public boolean getSlotValueAsBoolean(int index) 1255 { 1256 type_error(this, Symbol.STRUCTURE_OBJECT); 1257 // Not reached. 1258 return false; 1259 } 1260 setSlotValue_0(LispObject value)1261 public void setSlotValue_0(LispObject value) 1262 1263 { 1264 type_error(this, Symbol.STRUCTURE_OBJECT); 1265 } 1266 setSlotValue_1(LispObject value)1267 public void setSlotValue_1(LispObject value) 1268 1269 { 1270 type_error(this, Symbol.STRUCTURE_OBJECT); 1271 } 1272 setSlotValue_2(LispObject value)1273 public void setSlotValue_2(LispObject value) 1274 1275 { 1276 type_error(this, Symbol.STRUCTURE_OBJECT); 1277 } 1278 setSlotValue_3(LispObject value)1279 public void setSlotValue_3(LispObject value) 1280 1281 { 1282 type_error(this, Symbol.STRUCTURE_OBJECT); 1283 } 1284 setSlotValue(int index, LispObject value)1285 public void setSlotValue(int index, LispObject value) 1286 1287 { 1288 type_error(this, Symbol.STRUCTURE_OBJECT); 1289 } 1290 SLOT_VALUE(LispObject slotName)1291 public LispObject SLOT_VALUE(LispObject slotName) 1292 { 1293 return type_error(this, Symbol.STANDARD_OBJECT); 1294 } 1295 setSlotValue(LispObject slotName, LispObject newValue)1296 public void setSlotValue(LispObject slotName, LispObject newValue) 1297 1298 { 1299 type_error(this, Symbol.STANDARD_OBJECT); 1300 } 1301 1302 // Profiling. getCallCount()1303 public int getCallCount() 1304 { 1305 return 0; 1306 } 1307 setCallCount(int n)1308 public void setCallCount(int n) 1309 { 1310 } 1311 incrementCallCount()1312 public void incrementCallCount() 1313 { 1314 } 1315 getHotCount()1316 public int getHotCount() 1317 { 1318 return 0; 1319 } 1320 setHotCount(int n)1321 public void setHotCount(int n) 1322 { 1323 } 1324 incrementHotCount()1325 public void incrementHotCount() 1326 { 1327 } 1328 } 1329