001: /*
002: * Readtable.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: Readtable.java,v 1.32 2004/08/10 03:28:06 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: import java.util.ArrayList;
025:
026: public final class Readtable extends LispObject {
027: public static final byte ATTR_CONSTITUENT = 0;
028: public static final byte ATTR_WHITESPACE = 1;
029: public static final byte ATTR_TERMINATING_MACRO = 2;
030: public static final byte ATTR_NON_TERMINATING_MACRO = 3;
031: public static final byte ATTR_SINGLE_ESCAPE = 4;
032: public static final byte ATTR_MULTIPLE_ESCAPE = 5;
033: public static final byte ATTR_INVALID = 6;
034:
035: private final byte[] attributes = new byte[CHAR_MAX];
036: private final LispObject[] readerMacroFunctions = new LispObject[CHAR_MAX];
037: private final DispatchTable[] dispatchTables = new DispatchTable[CHAR_MAX];
038:
039: private LispObject readtableCase;
040:
041: public Readtable() {
042: attributes[9] = ATTR_WHITESPACE; // tab
043: attributes[10] = ATTR_WHITESPACE; // linefeed
044: attributes[12] = ATTR_WHITESPACE; // form feed
045: attributes[13] = ATTR_WHITESPACE; // return
046: attributes[' '] = ATTR_WHITESPACE;
047:
048: attributes['"'] = ATTR_TERMINATING_MACRO;
049: attributes['\''] = ATTR_TERMINATING_MACRO;
050: attributes['('] = ATTR_TERMINATING_MACRO;
051: attributes[')'] = ATTR_TERMINATING_MACRO;
052: attributes[','] = ATTR_TERMINATING_MACRO;
053: attributes[';'] = ATTR_TERMINATING_MACRO;
054: attributes['`'] = ATTR_TERMINATING_MACRO;
055:
056: attributes['#'] = ATTR_NON_TERMINATING_MACRO;
057:
058: attributes['\\'] = ATTR_SINGLE_ESCAPE;
059: attributes['|'] = ATTR_MULTIPLE_ESCAPE;
060:
061: readerMacroFunctions[';'] = LispReader.READ_COMMENT;
062: readerMacroFunctions['"'] = LispReader.READ_STRING;
063: readerMacroFunctions['('] = LispReader.READ_LIST;
064: readerMacroFunctions[')'] = LispReader.READ_RIGHT_PAREN;
065: readerMacroFunctions['\''] = LispReader.READ_QUOTE;
066: readerMacroFunctions['#'] = LispReader.READ_DISPATCH_CHAR;
067: readerMacroFunctions['`'] = LispReader.BACKQUOTE_MACRO;
068: readerMacroFunctions[','] = LispReader.COMMA_MACRO;
069:
070: DispatchTable dt = new DispatchTable();
071: dt.functions['('] = LispReader.SHARP_LEFT_PAREN;
072: dt.functions['*'] = LispReader.SHARP_STAR;
073: dt.functions['.'] = LispReader.SHARP_DOT;
074: dt.functions[':'] = LispReader.SHARP_COLON;
075: dt.functions['A'] = LispReader.SHARP_A;
076: dt.functions['B'] = LispReader.SHARP_B;
077: dt.functions['C'] = LispReader.SHARP_C;
078: dt.functions['O'] = LispReader.SHARP_O;
079: dt.functions['P'] = LispReader.SHARP_P;
080: dt.functions['R'] = LispReader.SHARP_R;
081: dt.functions['S'] = LispReader.SHARP_S;
082: dt.functions['X'] = LispReader.SHARP_X;
083: dt.functions['\''] = LispReader.SHARP_QUOTE;
084: dt.functions['\\'] = LispReader.SHARP_BACKSLASH;
085: dt.functions['|'] = LispReader.SHARP_VERTICAL_BAR;
086: dt.functions[')'] = LispReader.SHARP_ILLEGAL;
087: dt.functions['<'] = LispReader.SHARP_ILLEGAL;
088: dt.functions[' '] = LispReader.SHARP_ILLEGAL;
089: dt.functions[8] = LispReader.SHARP_ILLEGAL; // backspace
090: dt.functions[9] = LispReader.SHARP_ILLEGAL; // tab
091: dt.functions[10] = LispReader.SHARP_ILLEGAL; // newline, linefeed
092: dt.functions[12] = LispReader.SHARP_ILLEGAL; // page
093: dt.functions[13] = LispReader.SHARP_ILLEGAL; // return
094: dispatchTables['#'] = dt;
095:
096: readtableCase = Keyword.UPCASE;
097: }
098:
099: public Readtable(LispObject obj) throws ConditionThrowable {
100: Readtable rt;
101: if (obj == NIL)
102: rt = checkReadtable(_STANDARD_READTABLE_.symbolValue());
103: else
104: rt = checkReadtable(obj);
105: synchronized (rt) {
106: System.arraycopy(rt.attributes, 0, attributes, 0, CHAR_MAX);
107: System.arraycopy(rt.readerMacroFunctions, 0,
108: readerMacroFunctions, 0, CHAR_MAX);
109: // Deep copy.
110: for (int i = dispatchTables.length; i-- > 0;) {
111: DispatchTable dt = rt.dispatchTables[i];
112: if (dt != null)
113: dispatchTables[i] = new DispatchTable(dt);
114: }
115: readtableCase = rt.readtableCase;
116: }
117: }
118:
119: // FIXME synchronization
120: private static void copyReadtable(Readtable from, Readtable to) {
121: System
122: .arraycopy(from.attributes, 0, to.attributes, 0,
123: CHAR_MAX);
124: System.arraycopy(from.readerMacroFunctions, 0,
125: to.readerMacroFunctions, 0, CHAR_MAX);
126: for (int i = from.dispatchTables.length; i-- > 0;) {
127: DispatchTable dt = from.dispatchTables[i];
128: if (dt != null)
129: to.dispatchTables[i] = new DispatchTable(dt);
130: else
131: to.dispatchTables[i] = null;
132: }
133: to.readtableCase = from.readtableCase;
134: }
135:
136: public LispObject typeOf() {
137: return Symbol.READTABLE;
138: }
139:
140: public LispClass classOf() {
141: return BuiltInClass.READTABLE;
142: }
143:
144: public LispObject typep(LispObject type) throws ConditionThrowable {
145: if (type == Symbol.READTABLE)
146: return T;
147: if (type == BuiltInClass.READTABLE)
148: return T;
149: return super .typep(type);
150: }
151:
152: public String toString() {
153: return unreadableString("READTABLE");
154: }
155:
156: public LispObject getReadtableCase() {
157: return readtableCase;
158: }
159:
160: public boolean isWhitespace(char c) {
161: if (c < CHAR_MAX)
162: return attributes[c] == ATTR_WHITESPACE;
163: return false;
164: }
165:
166: public byte getAttribute(char c) {
167: if (c < CHAR_MAX)
168: return attributes[c];
169: return ATTR_CONSTITUENT;
170: }
171:
172: public LispObject getReaderMacroFunction(char c) {
173: if (c < CHAR_MAX)
174: return readerMacroFunctions[c];
175: else
176: return null;
177: }
178:
179: private LispObject getMacroCharacter(char c)
180: throws ConditionThrowable {
181: LispObject function = getReaderMacroFunction(c);
182: LispObject non_terminating_p;
183: if (function != null) {
184: byte attribute = attributes[c];
185: if (attribute == ATTR_NON_TERMINATING_MACRO)
186: non_terminating_p = T;
187: else
188: non_terminating_p = NIL;
189: } else {
190: function = NIL;
191: non_terminating_p = NIL;
192: }
193: return LispThread.currentThread().setValues(function,
194: non_terminating_p);
195: }
196:
197: private void makeDispatchMacroCharacter(char dispChar,
198: LispObject non_terminating_p) {
199: byte attribute;
200: if (non_terminating_p != NIL)
201: attribute = ATTR_NON_TERMINATING_MACRO;
202: else
203: attribute = ATTR_TERMINATING_MACRO;
204: // FIXME synchronization
205: attributes[dispChar] = attribute;
206: readerMacroFunctions[dispChar] = LispReader.READ_DISPATCH_CHAR;
207: dispatchTables[dispChar] = new DispatchTable();
208: }
209:
210: public LispObject getDispatchMacroCharacter(char dispChar,
211: char subChar) throws ConditionThrowable {
212: DispatchTable dispatchTable = dispatchTables[dispChar];
213: if (dispatchTable == null) {
214: LispCharacter c = LispCharacter.getInstance(dispChar);
215: return signal(new LispError(String.valueOf(c)
216: + " is not a dispatch character."));
217: }
218: LispObject function = dispatchTable.functions[Utilities
219: .toUpperCase(subChar)];
220: return (function != null) ? function : NIL;
221: }
222:
223: public void setDispatchMacroCharacter(char dispChar, char subChar,
224: LispObject function) throws ConditionThrowable {
225: DispatchTable dispatchTable = dispatchTables[dispChar];
226: if (dispatchTable == null) {
227: LispCharacter c = LispCharacter.getInstance(dispChar);
228: signal(new LispError(String.valueOf(c)
229: + " is not a dispatch character."));
230: }
231: dispatchTable.functions[Utilities.toUpperCase(subChar)] = function;
232: }
233:
234: private static class DispatchTable {
235: public LispObject[] functions = new LispObject[CHAR_MAX];
236:
237: public DispatchTable() {
238: }
239:
240: public DispatchTable(DispatchTable dt) {
241: for (int i = 0; i < functions.length; i++)
242: functions[i] = dt.functions[i];
243: }
244: }
245:
246: // ### readtablep
247: private static final Primitive1 READTABLEP = new Primitive1(
248: "readtablep", "object") {
249: public LispObject execute(LispObject arg) {
250: return arg instanceof Readtable ? T : NIL;
251: }
252: };
253:
254: // ### *standard-readtable*
255: // internal symbol
256: public static final Symbol _STANDARD_READTABLE_ = internSpecial(
257: "*STANDARD-READTABLE*", PACKAGE_SYS, new Readtable());
258:
259: // ### copy-readtable
260: private static final Primitive COPY_READTABLE = new Primitive(
261: "copy-readtable", "&optional from-readtable to-readtable") {
262: public LispObject execute() throws ConditionThrowable {
263: return new Readtable(currentReadtable());
264: }
265:
266: public LispObject execute(LispObject arg)
267: throws ConditionThrowable {
268: return new Readtable(arg);
269: }
270:
271: public LispObject execute(LispObject first, LispObject second)
272: throws ConditionThrowable {
273: Readtable from;
274: if (first == NIL)
275: from = checkReadtable(_STANDARD_READTABLE_
276: .symbolValue());
277: else
278: from = checkReadtable(first);
279: if (second == NIL)
280: return new Readtable(from);
281: Readtable to = checkReadtable(second);
282: copyReadtable(from, to);
283: return to;
284: }
285: };
286:
287: // ### get-macro-character char &optional readtable
288: // => function, non-terminating-p
289: private static final Primitive GET_MACRO_CHARACTER = new Primitive(
290: "get-macro-character", "char &optional readtable") {
291: public LispObject execute(LispObject arg)
292: throws ConditionThrowable {
293: char c = LispCharacter.getValue(arg);
294: Readtable rt = currentReadtable();
295: return rt.getMacroCharacter(c);
296: }
297:
298: public LispObject execute(LispObject first, LispObject second)
299: throws ConditionThrowable {
300: char c = LispCharacter.getValue(first);
301: Readtable rt;
302: if (second == NIL)
303: rt = new Readtable(NIL);
304: else
305: rt = checkReadtable(second);
306: return rt.getMacroCharacter(c);
307: }
308: };
309:
310: // ### set-macro-character char new-function &optional non-terminating-p readtable
311: // => t
312: private static final Primitive SET_MACRO_CHARACTER = new Primitive(
313: "set-macro-character",
314: "char new-function &optional non-terminating-p readtable") {
315: public LispObject execute(LispObject first, LispObject second)
316: throws ConditionThrowable {
317: char c = LispCharacter.getValue(first);
318: Readtable rt = currentReadtable();
319: // FIXME synchronization
320: rt.attributes[c] = ATTR_TERMINATING_MACRO;
321: rt.readerMacroFunctions[c] = coerceToFunction(second);
322: return T;
323: }
324:
325: public LispObject execute(LispObject first, LispObject second,
326: LispObject third) throws ConditionThrowable {
327: char c = LispCharacter.getValue(first);
328: Readtable rt = currentReadtable();
329: byte attribute;
330: if (third != NIL)
331: attribute = ATTR_NON_TERMINATING_MACRO;
332: else
333: attribute = ATTR_TERMINATING_MACRO;
334: // FIXME synchronization
335: rt.attributes[c] = attribute;
336: rt.readerMacroFunctions[c] = coerceToFunction(second);
337: return T;
338: }
339:
340: public LispObject execute(LispObject[] args)
341: throws ConditionThrowable {
342: if (args.length != 4)
343: return signal(new WrongNumberOfArgumentsException(this ));
344: char c = LispCharacter.getValue(args[0]);
345: byte attribute;
346: if (args[2] != NIL)
347: attribute = ATTR_NON_TERMINATING_MACRO;
348: else
349: attribute = ATTR_TERMINATING_MACRO;
350: Readtable rt = checkReadtable(args[3]);
351: // FIXME synchronization
352: rt.attributes[c] = attribute;
353: rt.readerMacroFunctions[c] = coerceToFunction(args[1]);
354: return T;
355: }
356: };
357:
358: // ### make-dispatch-macro-character char &optional non-terminating-p readtable
359: // => t
360: private static final Primitive MAKE_DISPATCH_MACRO_CHARACTER = new Primitive(
361: "make-dispatch-macro-character",
362: "char &optional non-terminating-p readtable") {
363: public LispObject execute(LispObject[] args)
364: throws ConditionThrowable {
365: if (args.length < 1 || args.length > 3)
366: return signal(new WrongNumberOfArgumentsException(this ));
367: char dispChar = LispCharacter.getValue(args[0]);
368: LispObject non_terminating_p;
369: if (args.length > 1)
370: non_terminating_p = args[1];
371: else
372: non_terminating_p = NIL;
373: Readtable readtable;
374: if (args.length > 2)
375: readtable = checkReadtable(args[2]);
376: else
377: readtable = currentReadtable();
378: readtable.makeDispatchMacroCharacter(dispChar,
379: non_terminating_p);
380: return T;
381: }
382: };
383:
384: // ### get-dispatch-macro-character
385: // get-dispatch-macro-character disp-char sub-char &optional readtable
386: // => function
387: private static final Primitive GET_DISPATCH_MACRO_CHARACTER = new Primitive(
388: "get-dispatch-macro-character",
389: "disp-char sub-char &optional readtable") {
390: public LispObject execute(LispObject[] args)
391: throws ConditionThrowable {
392: if (args.length < 2 || args.length > 3)
393: return signal(new WrongNumberOfArgumentsException(this ));
394: char dispChar = LispCharacter.getValue(args[0]);
395: char subChar = LispCharacter.getValue(args[1]);
396: Readtable readtable;
397: if (args.length == 3)
398: readtable = checkReadtable(args[2]);
399: else
400: readtable = currentReadtable();
401: return readtable.getDispatchMacroCharacter(dispChar,
402: subChar);
403: }
404: };
405:
406: // ### set-dispatch-macro-character
407: // set-dispatch-macro-character disp-char sub-char new-function &optional readtable
408: // => t
409: private static final Primitive SET_DISPATCH_MACRO_CHARACTER = new Primitive(
410: "set-dispatch-macro-character",
411: "disp-char sub-char new-function &optional readtable") {
412: public LispObject execute(LispObject[] args)
413: throws ConditionThrowable {
414: if (args.length < 3 || args.length > 4)
415: return signal(new WrongNumberOfArgumentsException(this ));
416: char dispChar = LispCharacter.getValue(args[0]);
417: char subChar = LispCharacter.getValue(args[1]);
418: LispObject function = coerceToFunction(args[2]);
419: Readtable readtable;
420: if (args.length == 4)
421: readtable = checkReadtable(args[3]);
422: else
423: readtable = currentReadtable();
424: readtable.setDispatchMacroCharacter(dispChar, subChar,
425: function);
426: return T;
427: }
428: };
429:
430: // ### set-syntax-from-char
431: // to-char from-char &optional to-readtable from-readtable => t
432: private static final Primitive SET_SYNTAX_FROM_CHAR = new Primitive(
433: "set-syntax-from-char",
434: "to-char from-char &optional to-readtable from-readtable") {
435: public LispObject execute(LispObject[] args)
436: throws ConditionThrowable {
437: if (args.length < 2 || args.length > 4)
438: return signal(new WrongNumberOfArgumentsException(this ));
439: char toChar = LispCharacter.getValue(args[0]);
440: char fromChar = LispCharacter.getValue(args[1]);
441: Readtable toReadtable;
442: if (args.length > 2)
443: toReadtable = checkReadtable(args[2]);
444: else
445: toReadtable = currentReadtable();
446: Readtable fromReadtable;
447: if (args.length > 3)
448: fromReadtable = checkReadtable(args[3]);
449: else
450: fromReadtable = new Readtable(NIL);
451: // FIXME synchronization
452: toReadtable.attributes[toChar] = fromReadtable.attributes[fromChar];
453: toReadtable.readerMacroFunctions[toChar] = fromReadtable.readerMacroFunctions[fromChar];
454: return T;
455: }
456: };
457:
458: // ### readtable-case readtable => mode
459: private static final Primitive1 READTABLE_CASE = new Primitive1(
460: "readtable-case", "readtable") {
461: public LispObject execute(LispObject arg)
462: throws ConditionThrowable {
463: try {
464: return ((Readtable) arg).readtableCase;
465: } catch (ClassCastException e) {
466: return signal(new TypeError(arg, Symbol.READTABLE));
467: }
468: }
469: };
470:
471: // ### %set-readtable-case readtable new-mode => new-mode
472: private static final Primitive2 _SET_READTABLE_CASE = new Primitive2(
473: "%set-readtable-case", PACKAGE_SYS, false,
474: "readtable new-mode") {
475: public LispObject execute(LispObject first, LispObject second)
476: throws ConditionThrowable {
477: try {
478: Readtable readtable = (Readtable) first;
479: if (second == Keyword.UPCASE
480: || second == Keyword.DOWNCASE
481: || second == Keyword.INVERT
482: || second == Keyword.PRESERVE) {
483: readtable.readtableCase = second;
484: return second;
485: }
486: return signal(new TypeError(second, list5(
487: Symbol.MEMBER, Keyword.INVERT,
488: Keyword.PRESERVE, Keyword.DOWNCASE,
489: Keyword.UPCASE)));
490: } catch (ClassCastException e) {
491: return signal(new TypeError(first, Symbol.READTABLE));
492: }
493: }
494: };
495: }
|