source: branches/0.17.x/abcl/src/org/armedbear/lisp/Readtable.java

Last change on this file was 12254, checked in by ehuelsmann, 16 years ago

Remove 'throws ConditionThrowable?' method annotations:

it's an unchecked exception now, so no need to declare it thrown.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 19.2 KB
Line 
1/*
2 * Readtable.java
3 *
4 * Copyright (C) 2003-2007 Peter Graves
5 * $Id: Readtable.java 12254 2009-11-06 20:07:54Z ehuelsmann $
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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, 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
34package org.armedbear.lisp;
35import java.util.Iterator;
36
37public class Readtable extends LispObject
38{
39  public static final byte SYNTAX_TYPE_CONSTITUENT           = 0;
40  public static final byte SYNTAX_TYPE_WHITESPACE            = 1;
41  public static final byte SYNTAX_TYPE_TERMINATING_MACRO     = 2;
42  public static final byte SYNTAX_TYPE_NON_TERMINATING_MACRO = 3;
43  public static final byte SYNTAX_TYPE_SINGLE_ESCAPE         = 4;
44  public static final byte SYNTAX_TYPE_MULTIPLE_ESCAPE       = 5;
45
46  protected final CharHashMap<Byte> syntax = new CharHashMap<Byte>(Byte.class,SYNTAX_TYPE_CONSTITUENT);
47  protected final CharHashMap<LispObject> readerMacroFunctions = new CharHashMap<LispObject>(LispObject.class,null);
48  protected final CharHashMap<DispatchTable> dispatchTables = new CharHashMap<DispatchTable>(DispatchTable.class,null);
49
50  protected LispObject readtableCase;
51
52  public Readtable()
53  {
54    initialize();
55  }
56
57  protected void initialize()
58  {
59    Byte[] syntax = this.syntax.constants;
60    syntax[9]    = SYNTAX_TYPE_WHITESPACE; // tab
61    syntax[10]   = SYNTAX_TYPE_WHITESPACE; // linefeed
62    syntax[12]   = SYNTAX_TYPE_WHITESPACE; // form feed
63    syntax[13]   = SYNTAX_TYPE_WHITESPACE; // return
64    syntax[' ']  = SYNTAX_TYPE_WHITESPACE;
65
66    syntax['"']  = SYNTAX_TYPE_TERMINATING_MACRO;
67    syntax['\''] = SYNTAX_TYPE_TERMINATING_MACRO;
68    syntax['(']  = SYNTAX_TYPE_TERMINATING_MACRO;
69    syntax[')']  = SYNTAX_TYPE_TERMINATING_MACRO;
70    syntax[',']  = SYNTAX_TYPE_TERMINATING_MACRO;
71    syntax[';']  = SYNTAX_TYPE_TERMINATING_MACRO;
72    syntax['`']  = SYNTAX_TYPE_TERMINATING_MACRO;
73
74    syntax['#']  = SYNTAX_TYPE_NON_TERMINATING_MACRO;
75
76    syntax['\\'] = SYNTAX_TYPE_SINGLE_ESCAPE;
77    syntax['|']  = SYNTAX_TYPE_MULTIPLE_ESCAPE;
78
79    LispObject[] readerMacroFunctions = this.readerMacroFunctions.constants;
80    readerMacroFunctions[';']  = LispReader.READ_COMMENT;
81    readerMacroFunctions['"']  = LispReader.READ_STRING;
82    readerMacroFunctions['(']  = LispReader.READ_LIST;
83    readerMacroFunctions[')']  = LispReader.READ_RIGHT_PAREN;
84    readerMacroFunctions['\''] = LispReader.READ_QUOTE;
85    readerMacroFunctions['#']  = LispReader.READ_DISPATCH_CHAR;
86
87    // BACKQUOTE-MACRO and COMMA-MACRO are defined in backquote.lisp.
88    readerMacroFunctions['`']  = Symbol.BACKQUOTE_MACRO;
89    readerMacroFunctions[',']  = Symbol.COMMA_MACRO;
90
91    DispatchTable dt = new DispatchTable();
92    LispObject[] dtfunctions = dt.functions.constants;
93    dtfunctions['(']  = LispReader.SHARP_LEFT_PAREN;
94    dtfunctions['*']  = LispReader.SHARP_STAR;
95    dtfunctions['.']  = LispReader.SHARP_DOT;
96    dtfunctions[':']  = LispReader.SHARP_COLON;
97    dtfunctions['A']  = LispReader.SHARP_A;
98    dtfunctions['B']  = LispReader.SHARP_B;
99    dtfunctions['C']  = LispReader.SHARP_C;
100    dtfunctions['O']  = LispReader.SHARP_O;
101    dtfunctions['P']  = LispReader.SHARP_P;
102    dtfunctions['R']  = LispReader.SHARP_R;
103    dtfunctions['S']  = LispReader.SHARP_S;
104    dtfunctions['X']  = LispReader.SHARP_X;
105    dtfunctions['\''] = LispReader.SHARP_QUOTE;
106    dtfunctions['\\'] = LispReader.SHARP_BACKSLASH;
107    dtfunctions['|']  = LispReader.SHARP_VERTICAL_BAR;
108    dtfunctions[')']  = LispReader.SHARP_ILLEGAL;
109    dtfunctions['<']  = LispReader.SHARP_ILLEGAL;
110    dtfunctions[' ']  = LispReader.SHARP_ILLEGAL;
111    dtfunctions[8]    = LispReader.SHARP_ILLEGAL; // backspace
112    dtfunctions[9]    = LispReader.SHARP_ILLEGAL; // tab
113    dtfunctions[10]   = LispReader.SHARP_ILLEGAL; // newline, linefeed
114    dtfunctions[12]   = LispReader.SHARP_ILLEGAL; // page
115    dtfunctions[13]   = LispReader.SHARP_ILLEGAL; // return
116
117    dispatchTables.constants['#'] = dt;
118
119    readtableCase = Keyword.UPCASE;
120  }
121
122  public Readtable(LispObject obj)
123  {
124    Readtable rt;
125    if (obj == NIL)
126      rt = checkReadtable(STANDARD_READTABLE.symbolValue());
127    else
128      rt = checkReadtable(obj);
129    synchronized (rt)
130      {
131        copyReadtable(rt, this);
132      }
133  }
134
135  // FIXME synchronization
136  private static void copyReadtable(Readtable from, Readtable to)
137  {
138    Iterator<Character> charIterator = from.syntax.getCharIterator();
139      while (charIterator.hasNext()) {
140        char c = charIterator.next();
141          Byte dt = from.syntax.get(c);
142          if (dt!=null) {
143              to.syntax.put(c, dt);         
144          } else {
145              to.syntax.put(c, null);         
146          }     
147      }     
148      charIterator = from.readerMacroFunctions.getCharIterator();
149      while (charIterator.hasNext()) {
150        char c = charIterator.next();
151          LispObject dt = from.readerMacroFunctions.get(c);
152          if (dt!=null) {
153              to.readerMacroFunctions.put(c, dt);         
154          } else {
155              to.readerMacroFunctions.put(c, null);         
156          }     
157      }
158      charIterator = from.dispatchTables.getCharIterator();
159      while (charIterator.hasNext()) {
160        char c = charIterator.next();
161          DispatchTable dt = from.dispatchTables.get(c);
162          if (dt!=null) {
163              to.dispatchTables.put(c, new DispatchTable(dt));         
164          } else {
165              to.dispatchTables.put(c, null);         
166          }     
167      }
168      to.readtableCase = from.readtableCase;
169  }
170
171  @Override
172  public LispObject typeOf()
173  {
174    return Symbol.READTABLE;
175  }
176
177  @Override
178  public LispObject classOf()
179  {
180    return BuiltInClass.READTABLE;
181  }
182
183  @Override
184  public LispObject typep(LispObject type)
185  {
186    if (type == Symbol.READTABLE)
187      return T;
188    if (type == BuiltInClass.READTABLE)
189      return T;
190    return super.typep(type);
191  }
192
193  @Override
194  public String toString()
195  {
196    return unreadableString("READTABLE");
197  }
198
199  public LispObject getReadtableCase()
200  {
201    return readtableCase;
202  }
203
204  public boolean isWhitespace(char c)
205  {
206    return getSyntaxType(c) == SYNTAX_TYPE_WHITESPACE;
207  }
208
209  public byte getSyntaxType(char c)
210  {
211    return syntax.get(c);
212  }
213
214  public boolean isInvalid(char c)
215  {
216    switch (c)
217      {
218      case 8:
219      case 9:
220      case 10:
221      case 12:
222      case 13:
223      case 32:
224      case 127:
225        return true;
226      default:
227        return false;
228      }
229  }
230
231  public void checkInvalid(char c, Stream stream)
232  {
233    // "... no mechanism is provided for changing the constituent trait of a
234    // character." (2.1.4.2)
235    if (isInvalid(c))
236      {
237        String name = LispCharacter.charToName(c);
238        FastStringBuffer sb = new FastStringBuffer("Invalid character");
239        if (name != null)
240          {
241            sb.append(" #\\");
242            sb.append(name);
243          }
244        error(new ReaderError(sb.toString(), stream));
245      }
246  }
247
248  public LispObject getReaderMacroFunction(char c)
249  {
250    return readerMacroFunctions.get(c);
251  }
252
253  private LispObject getMacroCharacter(char c)
254  {
255    LispObject function = getReaderMacroFunction(c);
256    LispObject non_terminating_p;
257    if (function != null)
258      {
259        if (syntax.get(c) == SYNTAX_TYPE_NON_TERMINATING_MACRO)
260          non_terminating_p = T;
261        else
262          non_terminating_p = NIL;
263      }
264    else
265      {
266        function = NIL;
267        non_terminating_p = NIL;
268      }
269    return LispThread.currentThread().setValues(function, non_terminating_p);
270  }
271
272  private void makeDispatchMacroCharacter(char dispChar, LispObject non_terminating_p)
273  {
274    byte syntaxType;
275    if (non_terminating_p != NIL)
276      syntaxType = SYNTAX_TYPE_NON_TERMINATING_MACRO;
277    else
278      syntaxType = SYNTAX_TYPE_TERMINATING_MACRO;
279    // FIXME synchronization
280    syntax.put(dispChar,syntaxType);
281    readerMacroFunctions.put(dispChar, LispReader.READ_DISPATCH_CHAR);
282    dispatchTables.put(dispChar, new DispatchTable());
283  }
284
285  public LispObject getDispatchMacroCharacter(char dispChar, char subChar)
286
287  {
288    DispatchTable dispatchTable = dispatchTables.get(dispChar);
289    if (dispatchTable == null)
290      {
291        LispCharacter c = LispCharacter.getInstance(dispChar);
292        return error(new LispError(c.writeToString() +
293                                    " is not a dispatch character."));
294      }
295    LispObject function =
296      dispatchTable.functions.get(LispCharacter.toUpperCase(subChar));
297    return (function != null) ? function : NIL;
298  }
299
300  public void setDispatchMacroCharacter(char dispChar, char subChar,
301                                        LispObject function)
302
303  {
304    DispatchTable dispatchTable = dispatchTables.get(dispChar);
305    if (dispatchTable == null)
306      {
307        LispCharacter c = LispCharacter.getInstance(dispChar);
308        error(new LispError(c.writeToString() +
309                             " is not a dispatch character."));
310      }
311    dispatchTable.functions.put(LispCharacter.toUpperCase(subChar), function);
312  }
313
314  protected static class DispatchTable
315  {
316  protected final CharHashMap<LispObject> functions;
317
318    public DispatchTable()
319    {
320      functions = new CharHashMap<LispObject>(LispObject.class,null);
321    }
322
323    @SuppressWarnings("unchecked")
324    public DispatchTable(DispatchTable dt)
325    {
326      functions = (CharHashMap<LispObject>) dt.functions.clone();
327    }
328  }
329
330  // ### readtablep
331  private static final Primitive READTABLEP =
332    new Primitive("readtablep", "object")
333    {
334      @Override
335      public LispObject execute(LispObject arg)
336      {
337        return arg instanceof Readtable ? T : NIL;
338      }
339    };
340
341  // ### copy-readtable
342  private static final Primitive COPY_READTABLE =
343    new Primitive("copy-readtable", "&optional from-readtable to-readtable")
344    {
345      @Override
346      public LispObject execute()
347      {
348        return new Readtable(currentReadtable());
349      }
350
351      @Override
352      public LispObject execute(LispObject arg)
353      {
354        return new Readtable(arg);
355      }
356
357      @Override
358      public LispObject execute(LispObject first, LispObject second)
359
360      {
361        Readtable from = designator_readtable(first);
362        if (second == NIL)
363          return new Readtable(from);
364        Readtable to = checkReadtable(second);
365        copyReadtable(from, to);
366        return to;
367      }
368    };
369
370  // ### get-macro-character char &optional readtable
371  // => function, non-terminating-p
372  private static final Primitive GET_MACRO_CHARACTER =
373    new Primitive("get-macro-character", "char &optional readtable")
374    {
375      @Override
376      public LispObject execute(LispObject arg)
377      {
378        char c = LispCharacter.getValue(arg);
379        Readtable rt = currentReadtable();
380        return rt.getMacroCharacter(c);
381      }
382
383      @Override
384      public LispObject execute(LispObject first, LispObject second)
385
386      {
387        char c = LispCharacter.getValue(first);
388        Readtable rt = designator_readtable(second);
389        return rt.getMacroCharacter(c);
390      }
391    };
392
393  // ### set-macro-character char new-function &optional non-terminating-p readtable
394  // => t
395  private static final Primitive SET_MACRO_CHARACTER =
396    new Primitive("set-macro-character",
397                  "char new-function &optional non-terminating-p readtable")
398    {
399      @Override
400      public LispObject execute(LispObject first, LispObject second)
401
402      {
403        return execute(first, second, NIL, currentReadtable());
404      }
405
406      @Override
407      public LispObject execute(LispObject first, LispObject second,
408                                LispObject third)
409
410      {
411        return execute(first, second, third, currentReadtable());
412      }
413
414      @Override
415      public LispObject execute(LispObject first, LispObject second,
416                                LispObject third, LispObject fourth)
417
418      {
419        char c = LispCharacter.getValue(first);
420        final LispObject designator;
421        if (second instanceof Function
422            || second instanceof StandardGenericFunction)
423          designator = second;
424        else if (second instanceof Symbol)
425          designator = second;
426        else
427          return error(new LispError(second.writeToString() +
428                                      " does not designate a function."));
429        byte syntaxType;
430        if (third != NIL)
431          syntaxType = SYNTAX_TYPE_NON_TERMINATING_MACRO;
432        else
433          syntaxType = SYNTAX_TYPE_TERMINATING_MACRO;
434        Readtable rt = designator_readtable(fourth);
435        // REVIEW synchronization
436        rt.syntax.put(c, syntaxType);
437        rt.readerMacroFunctions.put(c, designator);
438        return T;
439      }
440    };
441
442  // ### make-dispatch-macro-character char &optional non-terminating-p readtable
443  // => t
444  private static final Primitive MAKE_DISPATCH_MACRO_CHARACTER =
445    new Primitive("make-dispatch-macro-character",
446                  "char &optional non-terminating-p readtable")
447    {
448      @Override
449      public LispObject execute(LispObject[] args)
450      {
451        if (args.length < 1 || args.length > 3)
452          return error(new WrongNumberOfArgumentsException(this));
453        char dispChar = LispCharacter.getValue(args[0]);
454        LispObject non_terminating_p;
455        if (args.length > 1)
456          non_terminating_p = args[1];
457        else
458          non_terminating_p = NIL;
459        Readtable readtable;
460        if (args.length == 3)
461          readtable = checkReadtable(args[2]);
462        else
463          readtable = currentReadtable();
464        readtable.makeDispatchMacroCharacter(dispChar, non_terminating_p);
465        return T;
466      }
467    };
468
469  // ### get-dispatch-macro-character disp-char sub-char &optional readtable
470  // => function
471  private static final Primitive GET_DISPATCH_MACRO_CHARACTER =
472    new Primitive("get-dispatch-macro-character",
473                  "disp-char sub-char &optional readtable")
474    {
475      @Override
476      public LispObject execute(LispObject[] args)
477      {
478        if (args.length < 2 || args.length > 3)
479          return error(new WrongNumberOfArgumentsException(this));
480        char dispChar = LispCharacter.getValue(args[0]);
481        char subChar = LispCharacter.getValue(args[1]);
482        Readtable readtable;
483        if (args.length == 3)
484          readtable = designator_readtable(args[2]);
485        else
486          readtable = currentReadtable();
487        return readtable.getDispatchMacroCharacter(dispChar, subChar);
488      }
489    };
490
491  // ### set-dispatch-macro-character disp-char sub-char new-function &optional readtable
492  // => t
493  private static final Primitive SET_DISPATCH_MACRO_CHARACTER =
494    new Primitive("set-dispatch-macro-character",
495                  "disp-char sub-char new-function &optional readtable")
496    {
497      @Override
498      public LispObject execute(LispObject[] args)
499      {
500        if (args.length < 3 || args.length > 4)
501          return error(new WrongNumberOfArgumentsException(this));
502        char dispChar = LispCharacter.getValue(args[0]);
503        char subChar = LispCharacter.getValue(args[1]);
504        LispObject function = coerceToFunction(args[2]);
505        Readtable readtable;
506        if (args.length == 4)
507          readtable = designator_readtable(args[3]);
508        else
509          readtable = currentReadtable();
510        readtable.setDispatchMacroCharacter(dispChar, subChar, function);
511        return T;
512      }
513    };
514
515  // ### set-syntax-from-char to-char from-char &optional to-readtable from-readtable
516  // => t
517  private static final Primitive SET_SYNTAX_FROM_CHAR =
518    new Primitive("set-syntax-from-char",
519                  "to-char from-char &optional to-readtable from-readtable")
520    {
521      @Override
522      public LispObject execute(LispObject[] args)
523      {
524        if (args.length < 2 || args.length > 4)
525          return error(new WrongNumberOfArgumentsException(this));
526        char toChar = LispCharacter.getValue(args[0]);
527        char fromChar = LispCharacter.getValue(args[1]);
528        Readtable toReadtable;
529        if (args.length > 2)
530          toReadtable = checkReadtable(args[2]);
531        else
532          toReadtable = currentReadtable();
533        Readtable fromReadtable;
534        if (args.length > 3)
535          fromReadtable = designator_readtable(args[3]);
536        else
537          fromReadtable = checkReadtable(STANDARD_READTABLE.symbolValue());
538        // REVIEW synchronization
539        toReadtable.syntax.put(toChar, fromReadtable.syntax.get(fromChar));
540        toReadtable.readerMacroFunctions.put(toChar,
541            fromReadtable.readerMacroFunctions.get(fromChar));
542        // "If the character is a dispatching macro character, its entire
543        // dispatch table of reader macro functions is copied."
544        DispatchTable found = fromReadtable.dispatchTables.get(fromChar);
545        if (found!=null)
546          toReadtable.dispatchTables.put(toChar, new DispatchTable(found));         
547        else
548            // Don't leave behind dispatch tables when fromChar
549            // doesn't have one
550          toReadtable.dispatchTables.put(toChar, null);
551        return T;
552      }
553    };
554
555  // ### readtable-case readtable => mode
556  private static final Primitive READTABLE_CASE =
557    new Primitive("readtable-case", "readtable")
558    {
559      @Override
560      public LispObject execute(LispObject arg)
561      {
562          return checkReadtable(arg).readtableCase;
563      }
564    };
565
566  // ### %set-readtable-case readtable new-mode => new-mode
567  private static final Primitive _SET_READTABLE_CASE =
568    new Primitive("%set-readtable-case", PACKAGE_SYS, false,
569                  "readtable new-mode")
570    {
571      @Override
572      public LispObject execute(LispObject first, LispObject second)
573
574      {
575            final Readtable readtable = checkReadtable(first);
576            if (second == Keyword.UPCASE || second == Keyword.DOWNCASE ||
577                second == Keyword.INVERT || second == Keyword.PRESERVE)
578              {
579                readtable.readtableCase = second;
580                return second;
581              }
582            return type_error(second, list(Symbol.MEMBER,
583                                                 Keyword.INVERT,
584                                                 Keyword.PRESERVE,
585                                                 Keyword.DOWNCASE,
586                                                 Keyword.UPCASE));
587      }
588    };
589}
Note: See TracBrowser for help on using the repository browser.