001: /*
002: * Symbol.java
003: *
004: * Copyright (C) 2002-2004 Peter Graves
005: * $Id: Symbol.java,v 1.146 2004/09/20 18:43:02 piso Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: public class Symbol extends LispObject {
025: public static final Symbol AND_ALLOW_OTHER_KEYS = PACKAGE_CL
026: .addExternalSymbol("&ALLOW-OTHER-KEYS");
027: public static final Symbol AND_AUX = PACKAGE_CL
028: .addExternalSymbol("&AUX");
029: public static final Symbol AND_BODY = PACKAGE_CL
030: .addExternalSymbol("&BODY");
031: public static final Symbol AND_ENVIRONMENT = PACKAGE_CL
032: .addExternalSymbol("&ENVIRONMENT");
033: public static final Symbol AND_KEY = PACKAGE_CL
034: .addExternalSymbol("&KEY");
035: public static final Symbol AND_OPTIONAL = PACKAGE_CL
036: .addExternalSymbol("&OPTIONAL");
037: public static final Symbol AND_REST = PACKAGE_CL
038: .addExternalSymbol("&REST");
039: public static final Symbol AND_WHOLE = PACKAGE_CL
040: .addExternalSymbol("&WHOLE");
041: public static final Symbol APPLY = PACKAGE_CL
042: .addExternalSymbol("APPLY");
043: public static final Symbol BLOCK = PACKAGE_CL
044: .addExternalSymbol("BLOCK");
045: public static final Symbol BREAK = PACKAGE_CL
046: .addExternalSymbol("BREAK");
047: public static final Symbol CDR = PACKAGE_CL
048: .addExternalSymbol("CDR");
049: public static final Symbol DECLARE = PACKAGE_CL
050: .addExternalSymbol("DECLARE");
051: public static final Symbol DOCUMENTATION = PACKAGE_CL
052: .addExternalSymbol("DOCUMENTATION");
053: public static final Symbol EQ = PACKAGE_CL.addExternalSymbol("EQ");
054: public static final Symbol EQL = PACKAGE_CL
055: .addExternalSymbol("EQL");
056: public static final Symbol EQUAL = PACKAGE_CL
057: .addExternalSymbol("EQUAL");
058: public static final Symbol EQUALP = PACKAGE_CL
059: .addExternalSymbol("EQUALP");
060: public static final Symbol EVAL = PACKAGE_CL
061: .addExternalSymbol("EVAL");
062: public static final Symbol FLET = PACKAGE_CL
063: .addExternalSymbol("FLET");
064: public static final Symbol FORMAT = PACKAGE_CL
065: .addExternalSymbol("FORMAT");
066: public static final Symbol FUNCALL = PACKAGE_CL
067: .addExternalSymbol("FUNCALL");
068: public static final Symbol GO = PACKAGE_CL.addExternalSymbol("GO");
069: public static final Symbol LAMBDA = PACKAGE_CL
070: .addExternalSymbol("LAMBDA");
071: public static final Symbol LET = PACKAGE_CL
072: .addExternalSymbol("LET");
073: public static final Symbol LOAD = PACKAGE_CL
074: .addExternalSymbol("LOAD");
075: public static final Symbol OTHERWISE = PACKAGE_CL
076: .addExternalSymbol("OTHERWISE");
077: public static final Symbol QUOTE = PACKAGE_CL
078: .addExternalSymbol("QUOTE");
079: public static final Symbol SETF = PACKAGE_CL
080: .addExternalSymbol("SETF");
081: public static final Symbol SIGNAL = PACKAGE_CL
082: .addExternalSymbol("SIGNAL");
083: public static final Symbol SPECIAL = PACKAGE_CL
084: .addExternalSymbol("SPECIAL");
085:
086: // Type specifiers.
087: public static final Symbol AND = PACKAGE_CL
088: .addExternalSymbol("AND");
089: public static final Symbol ARRAY = PACKAGE_CL
090: .addExternalSymbol("ARRAY");
091: public static final Symbol ATOM = PACKAGE_CL
092: .addExternalSymbol("ATOM");
093: public static final Symbol BASE_CHAR = PACKAGE_CL
094: .addExternalSymbol("BASE-CHAR");
095: public static final Symbol BASE_STRING = PACKAGE_CL
096: .addExternalSymbol("BASE-STRING");
097: public static final Symbol BIGNUM = PACKAGE_CL
098: .addExternalSymbol("BIGNUM");
099: public static final Symbol BIT = PACKAGE_CL
100: .addExternalSymbol("BIT");
101: public static final Symbol BIT_VECTOR = PACKAGE_CL
102: .addExternalSymbol("BIT-VECTOR");
103: public static final Symbol BOOLEAN = PACKAGE_CL
104: .addExternalSymbol("BOOLEAN");
105: public static final Symbol BROADCAST_STREAM = PACKAGE_CL
106: .addExternalSymbol("BROADCAST-STREAM");
107: public static final Symbol BUILT_IN_CLASS = PACKAGE_CL
108: .addExternalSymbol("BUILT-IN-CLASS");
109: public static final Symbol CELL_ERROR = PACKAGE_CL
110: .addExternalSymbol("CELL-ERROR");
111: public static final Symbol CHARACTER = PACKAGE_CL
112: .addExternalSymbol("CHARACTER");
113: public static final Symbol CLASS = PACKAGE_CL
114: .addExternalSymbol("CLASS");
115: public static final Symbol COMPILED_FUNCTION = PACKAGE_CL
116: .addExternalSymbol("COMPILED-FUNCTION");
117: public static final Symbol COMPLEX = PACKAGE_CL
118: .addExternalSymbol("COMPLEX");
119: public static final Symbol CONCATENATED_STREAM = PACKAGE_CL
120: .addExternalSymbol("CONCATENATED-STREAM");
121: public static final Symbol CONS = PACKAGE_CL
122: .addExternalSymbol("CONS");
123: public static final Symbol DOUBLE_FLOAT = PACKAGE_CL
124: .addExternalSymbol("DOUBLE-FLOAT");
125: public static final Symbol ECHO_STREAM = PACKAGE_CL
126: .addExternalSymbol("ECHO-STREAM");
127: public static final Symbol EXTENDED_CHAR = PACKAGE_CL
128: .addExternalSymbol("EXTENDED-CHAR");
129: public static final Symbol FILE_STREAM = PACKAGE_CL
130: .addExternalSymbol("FILE-STREAM");
131: public static final Symbol FIXNUM = PACKAGE_CL
132: .addExternalSymbol("FIXNUM");
133: public static final Symbol FLOAT = PACKAGE_CL
134: .addExternalSymbol("FLOAT");
135: public static final Symbol FUNCTION = PACKAGE_CL
136: .addExternalSymbol("FUNCTION");
137: public static final Symbol GENERIC_FUNCTION = PACKAGE_CL
138: .addExternalSymbol("GENERIC-FUNCTION");
139: public static final Symbol HASH_TABLE = PACKAGE_CL
140: .addExternalSymbol("HASH-TABLE");
141: public static final Symbol INTEGER = PACKAGE_CL
142: .addExternalSymbol("INTEGER");
143: public static final Symbol KEYWORD = PACKAGE_CL
144: .addExternalSymbol("KEYWORD");
145: public static final Symbol LIST = PACKAGE_CL
146: .addExternalSymbol("LIST");
147: public static final Symbol LOGICAL_PATHNAME = PACKAGE_CL
148: .addExternalSymbol("LOGICAL-PATHNAME");
149: public static final Symbol LONG_FLOAT = PACKAGE_CL
150: .addExternalSymbol("LONG-FLOAT");
151: public static final Symbol MEMBER = PACKAGE_CL
152: .addExternalSymbol("MEMBER");
153: public static final Symbol METHOD = PACKAGE_CL
154: .addExternalSymbol("METHOD");
155: public static final Symbol METHOD_COMBINATION = PACKAGE_CL
156: .addExternalSymbol("METHOD-COMBINATION");
157: public static final Symbol NOT = PACKAGE_CL
158: .addExternalSymbol("NOT");
159: public static final Symbol NULL = PACKAGE_CL
160: .addExternalSymbol("NULL");
161: public static final Symbol NUMBER = PACKAGE_CL
162: .addExternalSymbol("NUMBER");
163: public static final Symbol OR = PACKAGE_CL.addExternalSymbol("OR");
164: public static final Symbol PACKAGE = PACKAGE_CL
165: .addExternalSymbol("PACKAGE");
166: public static final Symbol PATHNAME = PACKAGE_CL
167: .addExternalSymbol("PATHNAME");
168: public static final Symbol RANDOM_STATE = PACKAGE_CL
169: .addExternalSymbol("RANDOM-STATE");
170: public static final Symbol RATIO = PACKAGE_CL
171: .addExternalSymbol("RATIO");
172: public static final Symbol RATIONAL = PACKAGE_CL
173: .addExternalSymbol("RATIONAL");
174: public static final Symbol REAL = PACKAGE_CL
175: .addExternalSymbol("REAL");
176: public static final Symbol READTABLE = PACKAGE_CL
177: .addExternalSymbol("READTABLE");
178: public static final Symbol RESTART = PACKAGE_CL
179: .addExternalSymbol("RESTART");
180: public static final Symbol SEQUENCE = PACKAGE_CL
181: .addExternalSymbol("SEQUENCE");
182: public static final Symbol SHORT_FLOAT = PACKAGE_CL
183: .addExternalSymbol("SHORT-FLOAT");
184: public static final Symbol SIGNED_BYTE = PACKAGE_CL
185: .addExternalSymbol("SIGNED-BYTE");
186: public static final Symbol SIMPLE_ARRAY = PACKAGE_CL
187: .addExternalSymbol("SIMPLE-ARRAY");
188: public static final Symbol SIMPLE_BASE_STRING = PACKAGE_CL
189: .addExternalSymbol("SIMPLE-BASE-STRING");
190: public static final Symbol SIMPLE_BIT_VECTOR = PACKAGE_CL
191: .addExternalSymbol("SIMPLE-BIT-VECTOR");
192: public static final Symbol SIMPLE_STRING = PACKAGE_CL
193: .addExternalSymbol("SIMPLE-STRING");
194: public static final Symbol SIMPLE_VECTOR = PACKAGE_CL
195: .addExternalSymbol("SIMPLE-VECTOR");
196: public static final Symbol SINGLE_FLOAT = PACKAGE_CL
197: .addExternalSymbol("SINGLE-FLOAT");
198: public static final Symbol STANDARD_CHAR = PACKAGE_CL
199: .addExternalSymbol("STANDARD-CHAR");
200: public static final Symbol STANDARD_CLASS = PACKAGE_CL
201: .addExternalSymbol("STANDARD-CLASS");
202: public static final Symbol STANDARD_GENERIC_FUNCTION = PACKAGE_CL
203: .addExternalSymbol("STANDARD-GENERIC-FUNCTION");
204: public static final Symbol STANDARD_METHOD = PACKAGE_CL
205: .addExternalSymbol("STANDARD-METHOD");
206: public static final Symbol STANDARD_OBJECT = PACKAGE_CL
207: .addExternalSymbol("STANDARD-OBJECT");
208: public static final Symbol STREAM = PACKAGE_CL
209: .addExternalSymbol("STREAM");
210: public static final Symbol STRING = PACKAGE_CL
211: .addExternalSymbol("STRING");
212: public static final Symbol STRING_STREAM = PACKAGE_CL
213: .addExternalSymbol("STRING-STREAM");
214: public static final Symbol STRUCTURE_CLASS = PACKAGE_CL
215: .addExternalSymbol("STRUCTURE-CLASS");
216: public static final Symbol STRUCTURE_OBJECT = PACKAGE_CL
217: .addExternalSymbol("STRUCTURE-OBJECT");
218: public static final Symbol SYMBOL = PACKAGE_CL
219: .addExternalSymbol("SYMBOL");
220: public static final Symbol SYNONYM_STREAM = PACKAGE_CL
221: .addExternalSymbol("SYNONYM-STREAM");
222: public static final Symbol TWO_WAY_STREAM = PACKAGE_CL
223: .addExternalSymbol("TWO-WAY-STREAM");
224: public static final Symbol UNSIGNED_BYTE = PACKAGE_CL
225: .addExternalSymbol("UNSIGNED-BYTE");
226: public static final Symbol VECTOR = PACKAGE_CL
227: .addExternalSymbol("VECTOR");
228:
229: public static final Symbol CASE_FROB_STREAM = PACKAGE_SYS
230: .addInternalSymbol("CASE-FROB-STREAM");
231: public static final Symbol NIL_VECTOR = PACKAGE_SYS
232: .addInternalSymbol("NIL-VECTOR");
233: public static final Symbol SOCKET_STREAM = PACKAGE_SYS
234: .addInternalSymbol("SOCKET-STREAM");
235: public static final Symbol STRING_INPUT_STREAM = PACKAGE_SYS
236: .addInternalSymbol("STRING-INPUT-STREAM");
237: public static final Symbol STRING_OUTPUT_STREAM = PACKAGE_SYS
238: .addInternalSymbol("STRING-OUTPUT-STREAM");
239:
240: public static final Symbol UNSPECIFIED = PACKAGE_CL
241: .addExternalSymbol("*");
242:
243: // Condition types.
244: public static final Symbol ARITHMETIC_ERROR = PACKAGE_CL
245: .addExternalSymbol("ARITHMETIC-ERROR");
246: public static final Symbol CONDITION = PACKAGE_CL
247: .addExternalSymbol("CONDITION");
248: public static final Symbol CONTROL_ERROR = PACKAGE_CL
249: .addExternalSymbol("CONTROL-ERROR");
250: public static final Symbol DIVISION_BY_ZERO = PACKAGE_CL
251: .addExternalSymbol("DIVISION-BY-ZERO");
252: public static final Symbol END_OF_FILE = PACKAGE_CL
253: .addExternalSymbol("END-OF-FILE");
254: public static final Symbol ERROR = PACKAGE_CL
255: .addExternalSymbol("ERROR");
256: public static final Symbol FILE_ERROR = PACKAGE_CL
257: .addExternalSymbol("FILE-ERROR");
258: public static final Symbol FLOATING_POINT_INEXACT = PACKAGE_CL
259: .addExternalSymbol("FLOATING-POINT-INEXACT");
260: public static final Symbol FLOATING_POINT_INVALID_OPERATION = PACKAGE_CL
261: .addExternalSymbol("FLOATING-POINT-INVALID-OPERATION");
262: public static final Symbol FLOATING_POINT_OVERFLOW = PACKAGE_CL
263: .addExternalSymbol("FLOATING-POINT-OVERFLOW");
264: public static final Symbol FLOATING_POINT_UNDERFLOW = PACKAGE_CL
265: .addExternalSymbol("FLOATING-POINT-UNDERFLOW");
266: public static final Symbol PACKAGE_ERROR = PACKAGE_CL
267: .addExternalSymbol("PACKAGE-ERROR");
268: public static final Symbol PARSE_ERROR = PACKAGE_CL
269: .addExternalSymbol("PARSE-ERROR");
270: public static final Symbol PRINT_NOT_READABLE = PACKAGE_CL
271: .addExternalSymbol("PRINT-NOT-READABLE");
272: public static final Symbol PROGRAM_ERROR = PACKAGE_CL
273: .addExternalSymbol("PROGRAM-ERROR");
274: public static final Symbol READER_ERROR = PACKAGE_CL
275: .addExternalSymbol("READER-ERROR");
276: public static final Symbol SERIOUS_CONDITION = PACKAGE_CL
277: .addExternalSymbol("SERIOUS-CONDITION");
278: public static final Symbol SIMPLE_CONDITION = PACKAGE_CL
279: .addExternalSymbol("SIMPLE-CONDITION");
280: public static final Symbol SIMPLE_ERROR = PACKAGE_CL
281: .addExternalSymbol("SIMPLE-ERROR");
282: public static final Symbol SIMPLE_TYPE_ERROR = PACKAGE_CL
283: .addExternalSymbol("SIMPLE-TYPE-ERROR");
284: public static final Symbol SIMPLE_WARNING = PACKAGE_CL
285: .addExternalSymbol("SIMPLE-WARNING");
286: public static final Symbol STORAGE_CONDITION = PACKAGE_CL
287: .addExternalSymbol("STORAGE-CONDITION");
288: public static final Symbol STREAM_ERROR = PACKAGE_CL
289: .addExternalSymbol("STREAM-ERROR");
290: public static final Symbol STYLE_WARNING = PACKAGE_CL
291: .addExternalSymbol("STYLE-WARNING");
292: public static final Symbol TYPE_ERROR = PACKAGE_CL
293: .addExternalSymbol("TYPE-ERROR");
294: public static final Symbol UNBOUND_SLOT = PACKAGE_CL
295: .addExternalSymbol("UNBOUND-SLOT");
296: public static final Symbol UNBOUND_VARIABLE = PACKAGE_CL
297: .addExternalSymbol("UNBOUND-VARIABLE");
298: public static final Symbol UNDEFINED_FUNCTION = PACKAGE_CL
299: .addExternalSymbol("UNDEFINED-FUNCTION");
300: public static final Symbol WARNING = PACKAGE_CL
301: .addExternalSymbol("WARNING");
302:
303: // Internal symbols.
304: public static final Symbol BACKQUOTE = PACKAGE_CL
305: .addInternalSymbol("BACKQUOTE");
306: public static final Symbol COMMA = PACKAGE_CL
307: .addInternalSymbol("COMMA");
308: public static final Symbol COMMA_ATSIGN = PACKAGE_CL
309: .addInternalSymbol("COMMA-ATSIGN");
310: public static final Symbol COMMA_DOT = PACKAGE_CL
311: .addInternalSymbol("COMMA-DOT");
312: public static final Symbol MACROEXPAND_MACRO = PACKAGE_SYS
313: .addInternalSymbol("MACROEXPAND-MACRO");
314: public static final Symbol _SETF_FUNCTION = PACKAGE_SYS
315: .addInternalSymbol("%SETF-FUNCTION");
316: public static final Symbol _SOURCE = PACKAGE_SYS
317: .addInternalSymbol("%SOURCE");
318:
319: public static final Symbol DOUBLE_FLOAT_POSITIVE_INFINITY = PACKAGE_EXT
320: .addExternalSymbol("DOUBLE-FLOAT-POSITIVE-INFINITY");
321: public static final Symbol DOUBLE_FLOAT_NEGATIVE_INFINITY = PACKAGE_EXT
322: .addExternalSymbol("DOUBLE-FLOAT-NEGATIVE-INFINITY");
323:
324: // Bit flags.
325: private static final int FLAG_SPECIAL = 0x0001;
326: private static final int FLAG_CONSTANT = 0x0002;
327: private static final int FLAG_BUILT_IN_FUNCTION = 0x0004;
328:
329: public static final Symbol addFunction(String name, LispObject obj) {
330: Symbol symbol = PACKAGE_CL.intern(name);
331: try {
332: PACKAGE_CL.export(symbol); // FIXME Inefficient!
333: } catch (ConditionThrowable t) {
334: Debug.trace(t);
335: }
336: symbol.function = obj;
337: return symbol;
338: }
339:
340: private final String name;
341: private LispObject pkg;
342: private LispObject value;
343: private LispObject function;
344: private LispObject propertyList;
345: private int flags;
346:
347: // Construct an uninterned symbol.
348: public Symbol(String name) {
349: this .name = name;
350: pkg = NIL;
351: }
352:
353: public Symbol(String name, Package pkg) {
354: this .name = name;
355: this .pkg = pkg;
356: }
357:
358: public LispObject typeOf() {
359: if (pkg == PACKAGE_KEYWORD)
360: return Symbol.KEYWORD;
361: else
362: return Symbol.SYMBOL;
363: }
364:
365: public LispClass classOf() {
366: return BuiltInClass.SYMBOL;
367: }
368:
369: public LispObject getDescription() {
370: StringBuffer sb = new StringBuffer("The symbol ");
371: sb.append(name);
372: return new SimpleString(sb);
373: }
374:
375: public LispObject typep(LispObject type) throws ConditionThrowable {
376: if (type == Symbol.SYMBOL)
377: return T;
378: if (type == BuiltInClass.SYMBOL)
379: return T;
380: if (type == Symbol.KEYWORD)
381: return pkg == PACKAGE_KEYWORD ? T : NIL;
382: if (type == Symbol.BOOLEAN)
383: return this == T ? T : NIL;
384: return super .typep(type);
385: }
386:
387: public final LispObject SYMBOLP() {
388: return T;
389: }
390:
391: public boolean constantp() {
392: return (flags & FLAG_CONSTANT) != 0;
393: }
394:
395: public final LispObject STRING() {
396: return new SimpleString(name);
397: }
398:
399: public final LispObject getPackage() {
400: return pkg;
401: }
402:
403: public final void setPackage(LispObject obj) {
404: pkg = obj;
405: }
406:
407: public final boolean isSpecialVariable() {
408: return (flags & FLAG_SPECIAL) != 0;
409: }
410:
411: public final void setSpecial(boolean b) {
412: if (b)
413: flags |= FLAG_SPECIAL;
414: else
415: flags &= ~FLAG_SPECIAL;
416: }
417:
418: public final boolean isConstant() {
419: return (flags & FLAG_CONSTANT) != 0;
420: }
421:
422: public final void setConstant(boolean b) {
423: if (b)
424: flags |= FLAG_CONSTANT;
425: else
426: flags &= ~FLAG_CONSTANT;
427: }
428:
429: public final boolean isBuiltInFunction() {
430: return (flags & FLAG_BUILT_IN_FUNCTION) != 0;
431: }
432:
433: public final void setBuiltInFunction(boolean b) {
434: if (b)
435: flags |= FLAG_BUILT_IN_FUNCTION;
436: else
437: flags &= ~FLAG_BUILT_IN_FUNCTION;
438: }
439:
440: public final String getName() {
441: return name;
442: }
443:
444: public final String getQualifiedName() {
445: if (pkg == NIL)
446: return ("#:".concat(name));
447: if (pkg == PACKAGE_KEYWORD)
448: return ":".concat(name);
449: StringBuffer sb = new StringBuffer(pkg.getName());
450: if (((Package) pkg).findExternalSymbol(name) != null)
451: sb.append(':');
452: else
453: sb.append("::");
454: sb.append(name);
455: return sb.toString();
456: }
457:
458: // Raw accessor.
459: public LispObject getSymbolValue() {
460: return value;
461: }
462:
463: public final void setSymbolValue(LispObject value) {
464: this .value = value;
465: }
466:
467: public final LispObject symbolValue() throws ConditionThrowable {
468: LispObject val = LispThread.currentThread().lookupSpecial(this );
469: if (val != null)
470: return val;
471: if (value != null)
472: return value;
473: return signal(new UnboundVariable(this ));
474: }
475:
476: public final LispObject symbolValue(LispThread thread)
477: throws ConditionThrowable {
478: LispObject val = thread.lookupSpecial(this );
479: if (val != null)
480: return val;
481: if (value != null)
482: return value;
483: return signal(new UnboundVariable(this ));
484: }
485:
486: public final LispObject symbolValueNoThrow() {
487: if ((flags & FLAG_SPECIAL) != 0) {
488: LispObject val = LispThread.currentThread().lookupSpecial(
489: this );
490: if (val != null)
491: return val;
492: }
493: return value;
494: }
495:
496: public final LispObject symbolValueNoThrow(LispThread thread) {
497: if ((flags & FLAG_SPECIAL) != 0) {
498: LispObject val = thread.lookupSpecial(this );
499: if (val != null)
500: return val;
501: }
502: return value;
503: }
504:
505: public LispObject getSymbolFunction() {
506: return function;
507: }
508:
509: public final LispObject getSymbolFunctionOrDie()
510: throws ConditionThrowable {
511: if (function == null)
512: return signal(new UndefinedFunction(this ));
513: if (function instanceof Autoload) {
514: Autoload autoload = (Autoload) function;
515: autoload.load();
516: }
517: return function;
518: }
519:
520: public final LispObject getSymbolSetfFunctionOrDie()
521: throws ConditionThrowable {
522: LispObject obj = get(this , Symbol._SETF_FUNCTION);
523: if (obj == null)
524: return signal(new LispError("The function (SETF " + name
525: + ") is undefined."));
526: return obj;
527: }
528:
529: public final void setSymbolFunction(LispObject obj) {
530: this .function = obj;
531: }
532:
533: public final LispObject getPropertyList() {
534: return propertyList != null ? propertyList : NIL;
535: }
536:
537: public final void setPropertyList(LispObject obj) {
538: if (obj == null)
539: throw new NullPointerException();
540: propertyList = obj;
541: }
542:
543: private static final Symbol _FUNCTION_DOCUMENTATION = PACKAGE_SYS
544: .intern("%FUNCTION-DOCUMENTATION");
545:
546: private static final Symbol _VARIABLE_DOCUMENTATION = PACKAGE_SYS
547: .intern("%VARIABLE-DOCUMENTATION");
548:
549: // Returns null if there is no function documentation.
550: public final LispObject getFunctionDocumentation()
551: throws ConditionThrowable {
552: return get(this , _FUNCTION_DOCUMENTATION);
553: }
554:
555: public final void setFunctionDocumentation(String docstring)
556: throws ConditionThrowable {
557: put(this , _FUNCTION_DOCUMENTATION, new SimpleString(docstring));
558: }
559:
560: public final void setFunctionDocumentation(LispObject documentation)
561: throws ConditionThrowable {
562: put(this , _FUNCTION_DOCUMENTATION, documentation);
563: }
564:
565: public final void setVariableDocumentation(LispObject documentation)
566: throws ConditionThrowable {
567: put(this , _VARIABLE_DOCUMENTATION, documentation);
568: }
569:
570: public String writeToString() throws ConditionThrowable {
571: final LispThread thread = LispThread.currentThread();
572: boolean printEscape = (_PRINT_ESCAPE_.symbolValue(thread) != NIL);
573: LispObject printCase = _PRINT_CASE_.symbolValue(thread);
574: LispObject readtableCase = currentReadtable()
575: .getReadtableCase();
576: boolean printReadably = (_PRINT_READABLY_.symbolValue(thread) != NIL);
577: if (printReadably) {
578: if (readtableCase != Keyword.UPCASE
579: || printCase != Keyword.UPCASE) {
580: StringBuffer sb = new StringBuffer();
581: if (pkg == PACKAGE_KEYWORD) {
582: sb.append(':');
583: } else if (pkg != NIL) {
584: sb.append(multipleEscape(pkg.getName()));
585: sb.append("::");
586: } else {
587: sb.append("#:");
588: }
589: sb.append(multipleEscape(name));
590: return sb.toString();
591: } else
592: printEscape = true;
593: }
594: if (!printEscape) {
595: if (pkg == PACKAGE_KEYWORD) {
596: if (printCase == Keyword.DOWNCASE)
597: return name.toLowerCase();
598: if (printCase == Keyword.CAPITALIZE)
599: return capitalize(name, readtableCase);
600: return name;
601: }
602: // Printer escaping is disabled.
603: if (readtableCase == Keyword.UPCASE) {
604: if (printCase == Keyword.DOWNCASE)
605: return name.toLowerCase();
606: if (printCase == Keyword.CAPITALIZE)
607: return capitalize(name, readtableCase);
608: return name;
609: } else if (readtableCase == Keyword.DOWNCASE) {
610: // "When the readtable case is :DOWNCASE, uppercase characters
611: // are printed in their own case, and lowercase characters are
612: // printed in the case specified by *PRINT-CASE*." (22.1.3.3.2)
613: if (printCase == Keyword.DOWNCASE)
614: return name;
615: if (printCase == Keyword.UPCASE)
616: return name.toUpperCase();
617: if (printCase == Keyword.CAPITALIZE)
618: return capitalize(name, readtableCase);
619: return name;
620: } else if (readtableCase == Keyword.PRESERVE) {
621: return name;
622: } else
623: // INVERT
624: return invert(name);
625: }
626: // Printer escaping is enabled.
627: final boolean escape = needsEscape(name, readtableCase, thread);
628: String s = escape ? multipleEscape(name) : name;
629: if (!escape) {
630: if (readtableCase == Keyword.PRESERVE)
631: ;
632: else if (readtableCase == Keyword.INVERT)
633: s = invert(s);
634: else if (printCase == Keyword.DOWNCASE)
635: s = s.toLowerCase();
636: else if (printCase == Keyword.UPCASE)
637: s = s.toUpperCase();
638: else if (printCase == Keyword.CAPITALIZE)
639: s = capitalize(s, readtableCase);
640: }
641: if (pkg == NIL) {
642: if (printReadably
643: || _PRINT_GENSYM_.symbolValue(thread) != NIL)
644: return "#:".concat(s);
645: else
646: return s;
647: }
648: if (pkg == PACKAGE_KEYWORD)
649: return ":".concat(s);
650: // "Package prefixes are printed if necessary." (22.1.3.3.1)
651: final Package currentPackage = (Package) _PACKAGE_
652: .symbolValue(thread);
653: if (pkg == currentPackage)
654: return s;
655: if (currentPackage != null && currentPackage.uses(pkg)) {
656: // Check for name conflict in current package.
657: if (currentPackage.findExternalSymbol(name) == null)
658: if (currentPackage.findInternalSymbol(name) == null)
659: if (((Package) pkg).findExternalSymbol(name) != null)
660: return s;
661: }
662: // Has this symbol been imported into the current package?
663: if (currentPackage.findExternalSymbol(name) == this )
664: return s;
665: if (currentPackage.findInternalSymbol(name) == this )
666: return s;
667: // Package prefix is necessary.
668: String packageName = pkg.getName();
669: if (needsEscape(packageName, readtableCase, thread))
670: packageName = multipleEscape(packageName);
671: else if (printCase == Keyword.DOWNCASE)
672: packageName = packageName.toLowerCase();
673: StringBuffer sb = new StringBuffer(packageName);
674: if (((Package) pkg).findExternalSymbol(name) != null)
675: sb.append(':');
676: else
677: sb.append("::");
678: sb.append(s);
679: return sb.toString();
680: }
681:
682: private static final boolean needsEscape(String s,
683: LispObject readtableCase, LispThread thread)
684: throws ConditionThrowable {
685: boolean escape = false;
686: final int length = s.length();
687: if (length == 0)
688: return true;
689: if (s.charAt(0) == '#')
690: return true;
691: int radix;
692: try {
693: radix = ((Fixnum) _PRINT_BASE_.symbolValue(thread)).value;
694: } catch (ClassCastException e) {
695: signal(new TypeError(
696: "The value of *PRINT-BASE* is not of type (INTEGER 2 36)."));
697: // Not reached.
698: return false;
699: }
700: if (radix < 2 || radix > 36) {
701: signal(new TypeError(
702: "The value of *PRINT-BASE* is not of type (INTEGER 2 36)."));
703: // Not reached.
704: return false;
705: }
706: boolean seenNonDigit = false;
707: for (int i = length; i-- > 0;) {
708: char c = s.charAt(i);
709: if ("(),|\\`'\";:".indexOf(c) >= 0)
710: return true;
711: if (Character.isWhitespace(c))
712: return true;
713: if (readtableCase == Keyword.UPCASE) {
714: if (Character.isLowerCase(c))
715: return true;
716: } else if (readtableCase == Keyword.DOWNCASE) {
717: if (Character.isUpperCase(c))
718: return true;
719: }
720: if (!escape && !seenNonDigit) {
721: if (Character.digit(c, radix) < 0)
722: seenNonDigit = true;
723: }
724: }
725: if (!seenNonDigit)
726: return true;
727: if (s.length() > 0 && s.charAt(0) == '.') {
728: boolean allDots = true;
729: for (int i = s.length(); i-- > 1;) {
730: if (s.charAt(i) != '.') {
731: allDots = false;
732: break;
733: }
734: }
735: if (allDots)
736: return true;
737: }
738: return false;
739: }
740:
741: private static final String multipleEscape(String s) {
742: StringBuffer sb = new StringBuffer("|");
743: final int limit = s.length();
744: for (int i = 0; i < limit; i++) {
745: char c = s.charAt(i);
746: if (c == '|' || c == '\\')
747: sb.append('\\');
748: sb.append(c);
749: }
750: sb.append('|');
751: return sb.toString();
752: }
753:
754: private static final String capitalize(String s,
755: LispObject readtableCase) {
756: if (readtableCase == Keyword.INVERT
757: || readtableCase == Keyword.PRESERVE)
758: return s;
759: final int limit = s.length();
760: StringBuffer sb = new StringBuffer(limit);
761: boolean lastCharWasAlphanumeric = false;
762: for (int i = 0; i < limit; i++) {
763: char c = s.charAt(i);
764: if (Character.isLowerCase(c)) {
765: if (readtableCase == Keyword.UPCASE)
766: sb.append(c);
767: else
768: // DOWNCASE
769: sb.append(lastCharWasAlphanumeric ? c : Utilities
770: .toUpperCase(c));
771: lastCharWasAlphanumeric = true;
772: } else if (Character.isUpperCase(c)) {
773: if (readtableCase == Keyword.UPCASE)
774: sb.append(lastCharWasAlphanumeric ? Utilities
775: .toLowerCase(c) : c);
776: else
777: // DOWNCASE
778: sb.append(c);
779: lastCharWasAlphanumeric = true;
780: } else {
781: sb.append(c);
782: lastCharWasAlphanumeric = Character.isDigit(c);
783: }
784: }
785: return sb.toString();
786: }
787:
788: public LispObject getParts() throws ConditionThrowable {
789: LispObject result = NIL;
790: result = result.push(new Cons(new SimpleString("name"),
791: new SimpleString(name)));
792: result = result
793: .push(new Cons(new SimpleString("package"), pkg));
794: result = result.push(new Cons(new SimpleString("value"),
795: value != null ? value : UNBOUND));
796: result = result.push(new Cons(new SimpleString("function"),
797: function != null ? function : UNBOUND));
798: result = result.push(new Cons(new SimpleString("plist"),
799: getPropertyList()));
800: return result.nreverse();
801: }
802:
803: public final int hashCode() {
804: return name.hashCode();
805: }
806:
807: public final boolean equals(Object obj) {
808: return this == obj;
809: }
810:
811: // ### symbol-name
812: public static final Primitive1 SYMBOL_NAME = new Primitive1(
813: "symbol-name", "symbol") {
814: public LispObject execute(LispObject arg)
815: throws ConditionThrowable {
816: try {
817: return new SimpleString(((Symbol) arg).name);
818: } catch (ClassCastException e) {
819: return signal(new TypeError(arg, Symbol.SYMBOL));
820: }
821: }
822: };
823:
824: // ### symbol-package
825: public static final Primitive1 SYMBOL_PACKAGE = new Primitive1(
826: "symbol-package", "symbol") {
827: public LispObject execute(LispObject arg)
828: throws ConditionThrowable {
829: try {
830: return ((Symbol) arg).pkg;
831: } catch (ClassCastException e) {
832: return signal(new TypeError(arg, Symbol.SYMBOL));
833: }
834: }
835: };
836:
837: // ### symbol-function
838: public static final Primitive1 SYMBOL_FUNCTION = new Primitive1(
839: "symbol-function", "symbol") {
840: public LispObject execute(LispObject arg)
841: throws ConditionThrowable {
842: try {
843: LispObject function = ((Symbol) arg).function;
844: if (function != null)
845: return function;
846: return signal(new UndefinedFunction(arg));
847: } catch (ClassCastException e) {
848: return signal(new TypeError(arg, Symbol.SYMBOL));
849: }
850: }
851: };
852:
853: // ### symbol-plist
854: public static final Primitive1 SYMBOL_PLIST = new Primitive1(
855: "symbol-plist", "symbol") {
856: public LispObject execute(LispObject arg)
857: throws ConditionThrowable {
858: try {
859: LispObject propertyList = ((Symbol) arg).propertyList;
860: return propertyList != null ? propertyList : NIL;
861: } catch (ClassCastException e) {
862: return signal(new TypeError(arg, Symbol.SYMBOL));
863: }
864: }
865: };
866:
867: // ### keywordp
868: public static final Primitive1 KEYWORDP = new Primitive1(
869: "keywordp", "object") {
870: public LispObject execute(LispObject arg)
871: throws ConditionThrowable {
872: if (arg instanceof Symbol) {
873: if (((Symbol) arg).pkg == PACKAGE_KEYWORD)
874: return T;
875: }
876: return NIL;
877: }
878: };
879:
880: // ### make-symbol
881: public static final Primitive1 MAKE_SYMBOL = new Primitive1(
882: "make-symbol", "name") {
883: public LispObject execute(LispObject arg)
884: throws ConditionThrowable {
885: return new Symbol(arg.getStringValue());
886: }
887: };
888:
889: // makunbound
890: public static final Primitive1 MAKUNBOUND = new Primitive1(
891: "makunbound", "symbol") {
892: public LispObject execute(LispObject arg)
893: throws ConditionThrowable {
894: try {
895: ((Symbol) arg).value = null;
896: return arg;
897: } catch (ClassCastException e) {
898: return signal(new TypeError(arg, "symbol"));
899: }
900: }
901: };
902: }
|