|
1
21
22 package org.armedbear.lisp;
23
24 import java.util.ArrayList  ;
25
26 public final class Readtable extends LispObject
27 {
28 public static final byte ATTR_CONSTITUENT = 0;
29 public static final byte ATTR_WHITESPACE = 1;
30 public static final byte ATTR_TERMINATING_MACRO = 2;
31 public static final byte ATTR_NON_TERMINATING_MACRO = 3;
32 public static final byte ATTR_SINGLE_ESCAPE = 4;
33 public static final byte ATTR_MULTIPLE_ESCAPE = 5;
34 public static final byte ATTR_INVALID = 6;
35
36 private final byte[] attributes = new byte[CHAR_MAX];
37 private final LispObject[] readerMacroFunctions = new LispObject[CHAR_MAX];
38 private final DispatchTable[] dispatchTables = new DispatchTable[CHAR_MAX];
39
40 private LispObject readtableCase;
41
42 public Readtable()
43 {
44 attributes[9] = ATTR_WHITESPACE; attributes[10] = ATTR_WHITESPACE; attributes[12] = ATTR_WHITESPACE; attributes[13] = ATTR_WHITESPACE; attributes[' '] = ATTR_WHITESPACE;
49
50 attributes['"'] = ATTR_TERMINATING_MACRO;
51 attributes['\''] = ATTR_TERMINATING_MACRO;
52 attributes['('] = ATTR_TERMINATING_MACRO;
53 attributes[')'] = ATTR_TERMINATING_MACRO;
54 attributes[','] = ATTR_TERMINATING_MACRO;
55 attributes[';'] = ATTR_TERMINATING_MACRO;
56 attributes['`'] = ATTR_TERMINATING_MACRO;
57
58 attributes['#'] = ATTR_NON_TERMINATING_MACRO;
59
60 attributes['\\'] = ATTR_SINGLE_ESCAPE;
61 attributes['|'] = ATTR_MULTIPLE_ESCAPE;
62
63 readerMacroFunctions[';'] = LispReader.READ_COMMENT;
64 readerMacroFunctions['"'] = LispReader.READ_STRING;
65 readerMacroFunctions['('] = LispReader.READ_LIST;
66 readerMacroFunctions[')'] = LispReader.READ_RIGHT_PAREN;
67 readerMacroFunctions['\''] = LispReader.READ_QUOTE;
68 readerMacroFunctions['#'] = LispReader.READ_DISPATCH_CHAR;
69 readerMacroFunctions['`'] = LispReader.BACKQUOTE_MACRO;
70 readerMacroFunctions[','] = LispReader.COMMA_MACRO;
71
72 DispatchTable dt = new DispatchTable();
73 dt.functions['('] = LispReader.SHARP_LEFT_PAREN;
74 dt.functions['*'] = LispReader.SHARP_STAR;
75 dt.functions['.'] = LispReader.SHARP_DOT;
76 dt.functions[':'] = LispReader.SHARP_COLON;
77 dt.functions['A'] = LispReader.SHARP_A;
78 dt.functions['B'] = LispReader.SHARP_B;
79 dt.functions['C'] = LispReader.SHARP_C;
80 dt.functions['O'] = LispReader.SHARP_O;
81 dt.functions['P'] = LispReader.SHARP_P;
82 dt.functions['R'] = LispReader.SHARP_R;
83 dt.functions['S'] = LispReader.SHARP_S;
84 dt.functions['X'] = LispReader.SHARP_X;
85 dt.functions['\''] = LispReader.SHARP_QUOTE;
86 dt.functions['\\'] = LispReader.SHARP_BACKSLASH;
87 dt.functions['|'] = LispReader.SHARP_VERTICAL_BAR;
88 dt.functions[')'] = LispReader.SHARP_ILLEGAL;
89 dt.functions['<'] = LispReader.SHARP_ILLEGAL;
90 dt.functions[' '] = LispReader.SHARP_ILLEGAL;
91 dt.functions[8] = LispReader.SHARP_ILLEGAL; dt.functions[9] = LispReader.SHARP_ILLEGAL; dt.functions[10] = LispReader.SHARP_ILLEGAL; dt.functions[12] = LispReader.SHARP_ILLEGAL; dt.functions[13] = LispReader.SHARP_ILLEGAL; dispatchTables['#'] = dt;
97
98 readtableCase = Keyword.UPCASE;
99 }
100
101 public Readtable(LispObject obj) throws ConditionThrowable
102 {
103 Readtable rt;
104 if (obj == NIL)
105 rt = checkReadtable(_STANDARD_READTABLE_.symbolValue());
106 else
107 rt = checkReadtable(obj);
108 synchronized (rt) {
109 System.arraycopy(rt.attributes, 0, attributes, 0,
110 CHAR_MAX);
111 System.arraycopy(rt.readerMacroFunctions, 0, readerMacroFunctions, 0,
112 CHAR_MAX);
113 for (int i = dispatchTables.length; i-- > 0;) {
115 DispatchTable dt = rt.dispatchTables[i];
116 if (dt != null)
117 dispatchTables[i] = new DispatchTable(dt);
118 }
119 readtableCase = rt.readtableCase;
120 }
121 }
122
123 private static void copyReadtable(Readtable from, Readtable to)
125 {
126 System.arraycopy(from.attributes, 0, to.attributes, 0,
127 CHAR_MAX);
128 System.arraycopy(from.readerMacroFunctions, 0, to.readerMacroFunctions, 0,
129 CHAR_MAX);
130 for (int i = from.dispatchTables.length; i-- > 0;) {
131 DispatchTable dt = from.dispatchTables[i];
132 if (dt != null)
133 to.dispatchTables[i] = new DispatchTable(dt);
134 else
135 to.dispatchTables[i] = null;
136 }
137 to.readtableCase = from.readtableCase;
138 }
139
140 public LispObject typeOf()
141 {
142 return Symbol.READTABLE;
143 }
144
145 public LispClass classOf()
146 {
147 return BuiltInClass.READTABLE;
148 }
149
150 public LispObject typep(LispObject type) throws ConditionThrowable
151 {
152 if (type == Symbol.READTABLE)
153 return T;
154 if (type == BuiltInClass.READTABLE)
155 return T;
156 return super.typep(type);
157 }
158
159 public String toString()
160 {
161 return unreadableString("READTABLE");
162 }
163
164 public LispObject getReadtableCase()
165 {
166 return readtableCase;
167 }
168
169 public boolean isWhitespace(char c)
170 {
171 if (c < CHAR_MAX)
172 return attributes[c] == ATTR_WHITESPACE;
173 return false;
174 }
175
176 public byte getAttribute(char c)
177 {
178 if (c < CHAR_MAX)
179 return attributes[c];
180 return ATTR_CONSTITUENT;
181 }
182
183 public LispObject getReaderMacroFunction(char c)
184 {
185 if (c < CHAR_MAX)
186 return readerMacroFunctions[c];
187 else
188 return null;
189 }
190
191 private LispObject getMacroCharacter(char c) throws ConditionThrowable
192 {
193 LispObject function = getReaderMacroFunction(c);
194 LispObject non_terminating_p;
195 if (function != null) {
196 byte attribute = attributes[c];
197 if (attribute == ATTR_NON_TERMINATING_MACRO)
198 non_terminating_p = T;
199 else
200 non_terminating_p = NIL;
201 } else {
202 function = NIL;
203 non_terminating_p = NIL;
204 }
205 return LispThread.currentThread().setValues(function, non_terminating_p);
206 }
207
208 private void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)
209 {
210 byte attribute;
211 if (non_terminating_p != NIL)
212 attribute = ATTR_NON_TERMINATING_MACRO;
213 else
214 attribute = ATTR_TERMINATING_MACRO;
215 attributes[dispChar] = attribute;
217 readerMacroFunctions[dispChar] = LispReader.READ_DISPATCH_CHAR;
218 dispatchTables[dispChar] = new DispatchTable();
219 }
220
221 public LispObject getDispatchMacroCharacter(char dispChar, char subChar)
222 throws ConditionThrowable
223 {
224 DispatchTable dispatchTable = dispatchTables[dispChar];
225 if (dispatchTable == null) {
226 LispCharacter c = LispCharacter.getInstance(dispChar);
227 return signal(new LispError(String.valueOf(c) + " is not a dispatch character."));
228 }
229 LispObject function =
230 dispatchTable.functions[Utilities.toUpperCase(subChar)];
231 return (function != null) ? function : NIL;
232 }
233
234 public void setDispatchMacroCharacter(char dispChar, char subChar,
235 LispObject function)
236 throws ConditionThrowable
237 {
238 DispatchTable dispatchTable = dispatchTables[dispChar];
239 if (dispatchTable == null) {
240 LispCharacter c = LispCharacter.getInstance(dispChar);
241 signal(new LispError(String.valueOf(c) + " is not a dispatch character."));
242 }
243 dispatchTable.functions[Utilities.toUpperCase(subChar)] = function;
244 }
245
246 private static class DispatchTable
247 {
248 public LispObject[] functions = new LispObject[CHAR_MAX];
249
250 public DispatchTable()
251 {
252 }
253
254 public DispatchTable(DispatchTable dt)
255 {
256 for (int i = 0; i < functions.length; i++)
257 functions[i] = dt.functions[i];
258 }
259 }
260
261 private static final Primitive1 READTABLEP =
263 new Primitive1("readtablep", "object")
264 {
265 public LispObject execute(LispObject arg)
266 {
267 return arg instanceof Readtable ? T : NIL;
268 }
269 };
270
271 public static final Symbol _STANDARD_READTABLE_ =
274 internSpecial("*STANDARD-READTABLE*", PACKAGE_SYS, new Readtable());
275
276 private static final Primitive COPY_READTABLE =
278 new Primitive("copy-readtable", "&optional from-readtable to-readtable")
279 {
280 public LispObject execute() throws ConditionThrowable
281 {
282 return new Readtable(currentReadtable());
283 }
284
285 public LispObject execute(LispObject arg) throws ConditionThrowable
286 {
287 return new Readtable(arg);
288 }
289
290 public LispObject execute(LispObject first, LispObject second)
291 throws ConditionThrowable
292 {
293 Readtable from;
294 if (first == NIL)
295 from = checkReadtable(_STANDARD_READTABLE_.symbolValue());
296 else
297 from = checkReadtable(first);
298 if (second == NIL)
299 return new Readtable(from);
300 Readtable to = checkReadtable(second);
301 copyReadtable(from, to);
302 return to;
303 }
304 };
305
306 private static final Primitive GET_MACRO_CHARACTER =
309 new Primitive("get-macro-character", "char &optional readtable")
310 {
311 public LispObject execute(LispObject arg) throws ConditionThrowable
312 {
313 char c = LispCharacter.getValue(arg);
314 Readtable rt = currentReadtable();
315 return rt.getMacroCharacter(c);
316 }
317
318 public LispObject execute(LispObject first, LispObject second)
319 throws ConditionThrowable
320 {
321 char c = LispCharacter.getValue(first);
322 Readtable rt;
323 if (second == NIL)
324 rt = new Readtable(NIL);
325 else
326 rt = checkReadtable(second);
327 return rt.getMacroCharacter(c);
328 }
329 };
330
331 private static final Primitive SET_MACRO_CHARACTER =
334 new Primitive("set-macro-character",
335 "char new-function &optional non-terminating-p readtable")
336 {
337 public LispObject execute(LispObject first, LispObject second)
338 throws ConditionThrowable
339 {
340 char c = LispCharacter.getValue(first);
341 Readtable rt = currentReadtable();
342 rt.attributes[c] = ATTR_TERMINATING_MACRO;
344 rt.readerMacroFunctions[c] = coerceToFunction(second);
345 return T;
346 }
347
348 public LispObject execute(LispObject first, LispObject second,
349 LispObject third)
350 throws ConditionThrowable
351 {
352 char c = LispCharacter.getValue(first);
353 Readtable rt = currentReadtable();
354 byte attribute;
355 if (third != NIL)
356 attribute = ATTR_NON_TERMINATING_MACRO;
357 else
358 attribute = ATTR_TERMINATING_MACRO;
359 rt.attributes[c] = attribute;
361 rt.readerMacroFunctions[c] = coerceToFunction(second);
362 return T;
363 }
364
365 public LispObject execute(LispObject[] args) throws ConditionThrowable
366 {
367 if (args.length != 4)
368 return signal(new WrongNumberOfArgumentsException(this));
369 char c = LispCharacter.getValue(args[0]);
370 byte attribute;
371 if (args[2] != NIL)
372 attribute = ATTR_NON_TERMINATING_MACRO;
373 else
374 attribute = ATTR_TERMINATING_MACRO;
375 Readtable rt = checkReadtable(args[3]);
376 rt.attributes[c] = attribute;
378 rt.readerMacroFunctions[c] = coerceToFunction(args[1]);
379 return T;
380 }
381 };
382
383 private static final Primitive MAKE_DISPATCH_MACRO_CHARACTER =
386 new Primitive("make-dispatch-macro-character",
387 "char &optional non-terminating-p readtable")
388 {
389 public LispObject execute(LispObject[] args) throws ConditionThrowable
390 {
391 if (args.length < 1 || args.length > 3)
392 return signal(new WrongNumberOfArgumentsException(this));
393 char dispChar = LispCharacter.getValue(args[0]);
394 LispObject non_terminating_p;
395 if (args.length > 1)
396 non_terminating_p = args[1];
397 else
398 non_terminating_p = NIL;
399 Readtable readtable;
400 if (args.length > 2)
401 readtable = checkReadtable(args[2]);
402 else
403 readtable = currentReadtable();
404 readtable.makeDispatchMacroCharacter(dispChar, non_terminating_p);
405 return T;
406 }
407 };
408
409 private static final Primitive GET_DISPATCH_MACRO_CHARACTER =
413 new Primitive("get-dispatch-macro-character",
414 "disp-char sub-char &optional readtable")
415 {
416 public LispObject execute(LispObject[] args) throws ConditionThrowable
417 {
418 if (args.length < 2 || args.length > 3)
419 return signal(new WrongNumberOfArgumentsException(this));
420 char dispChar = LispCharacter.getValue(args[0]);
421 char subChar = LispCharacter.getValue(args[1]);
422 Readtable readtable;
423 if (args.length == 3)
424 readtable = checkReadtable(args[2]);
425 else
426 readtable = currentReadtable();
427 return readtable.getDispatchMacroCharacter(dispChar, subChar);
428 }
429 };
430
431 private static final Primitive SET_DISPATCH_MACRO_CHARACTER =
435 new Primitive("set-dispatch-macro-character",
436 "disp-char sub-char new-function &optional readtable")
437 {
438 public LispObject execute(LispObject[] args) throws ConditionThrowable
439 {
440 if (args.length < 3 || args.length > 4)
441 return signal(new WrongNumberOfArgumentsException(this));
442 char dispChar = LispCharacter.getValue(args[0]);
443 char subChar = LispCharacter.getValue(args[1]);
444 LispObject function = coerceToFunction(args[2]);
445 Readtable readtable;
446 if (args.length == 4)
447 readtable = checkReadtable(args[3]);
448 else
449 readtable = currentReadtable();
450 readtable.setDispatchMacroCharacter(dispChar, subChar, function);
451 return T;
452 }
453 };
454
455 private static final Primitive SET_SYNTAX_FROM_CHAR =
458 new Primitive("set-syntax-from-char",
459 "to-char from-char &optional to-readtable from-readtable")
460 {
461 public LispObject execute(LispObject[] args) throws ConditionThrowable
462 {
463 if (args.length < 2 || args.length > 4)
464 return signal(new WrongNumberOfArgumentsException(this));
465 char toChar = LispCharacter.getValue(args[0]);
466 char fromChar = LispCharacter.getValue(args[1]);
467 Readtable toReadtable;
468 if (args.length > 2)
469 toReadtable = checkReadtable(args[2]);
470 else
471 toReadtable = currentReadtable();
472 Readtable fromReadtable;
473 if (args.length > 3)
474 fromReadtable = checkReadtable(args[3]);
475 else
476 fromReadtable = new Readtable(NIL);
477 toReadtable.attributes[toChar] = fromReadtable.attributes[fromChar];
479 toReadtable.readerMacroFunctions[toChar] =
480 fromReadtable.readerMacroFunctions[fromChar];
481 return T;
482 }
483 };
484
485 private static final Primitive1 READTABLE_CASE =
487 new Primitive1("readtable-case", "readtable")
488 {
489 public LispObject execute(LispObject arg) throws ConditionThrowable
490 {
491 try {
492 return ((Readtable)arg).readtableCase;
493 }
494 catch (ClassCastException e) {
495 return signal(new TypeError(arg, Symbol.READTABLE));
496 }
497 }
498 };
499
500 private static final Primitive2 _SET_READTABLE_CASE =
502 new Primitive2("%set-readtable-case", PACKAGE_SYS, false,
503 "readtable new-mode")
504 {
505 public LispObject execute(LispObject first, LispObject second)
506 throws ConditionThrowable
507 {
508 try {
509 Readtable readtable = (Readtable) first;
510 if (second == Keyword.UPCASE || second == Keyword.DOWNCASE ||
511 second == Keyword.INVERT || second == Keyword.PRESERVE)
512 {
513 readtable.readtableCase = second;
514 return second;
515 }
516 return signal(new TypeError(second, list5(Symbol.MEMBER,
517 Keyword.INVERT,
518 Keyword.PRESERVE,
519 Keyword.DOWNCASE,
520 Keyword.UPCASE)));
521 }
522 catch (ClassCastException e) {
523 return signal(new TypeError(first, Symbol.READTABLE));
524 }
525 }
526 };
527 }
528 |
Popular Tags |
Java API By Example, From Geeks To Geeks.