source: branches/0.15.x/abcl/src/org/armedbear/lisp/FaslReader.java

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

Fix fasl reader special bindings leak.

  • Bind the *FASL-ANONYMOUS-PACKAGE* to the outer most scope which needs one, instead of binding it upon first use. Specials shouldn't be bound with indefinite extent: some other code might limit the extent by unbinding its specials.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 16.7 KB
Line 
1/*
2 * FaslReader.java
3 *
4 * Copyright (C) 2005 Peter Graves
5 * $Id: FaslReader.java 11783 2009-04-25 14:19:51Z 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;
35
36public final class FaslReader extends Lisp
37{
38    // ### fasl-read-comment
39    public static final ReaderMacroFunction FASL_READ_COMMENT =
40        new ReaderMacroFunction("fasl-read-comment", PACKAGE_SYS, false,
41                                "stream character")
42    {
43        @Override
44        public LispObject execute(Stream stream, char ignored)
45            throws ConditionThrowable
46        {
47            while (true) {
48                int n = stream._readChar();
49                if (n < 0)
50                    return null;
51                if (n == '\n')
52                    return null;
53            }
54        }
55    };
56
57    // ### fasl-read-string
58    public static final ReaderMacroFunction FASL_READ_STRING =
59        new ReaderMacroFunction("fasl-read-string", PACKAGE_SYS, false,
60                                "stream character")
61    {
62        @Override
63        public LispObject execute(Stream stream, char terminator)
64            throws ConditionThrowable
65        {
66            final Readtable rt = FaslReadtable.getInstance();
67            FastStringBuffer sb = new FastStringBuffer();
68            while (true) {
69                int n = stream._readChar();
70                if (n < 0) {
71                    error(new EndOfFile(stream));
72                    // Not reached.
73                    return null;
74                }
75                char c = (char) n;
76                if (rt.getSyntaxType(c) == Readtable.SYNTAX_TYPE_SINGLE_ESCAPE) {
77                    // Single escape.
78                    n = stream._readChar();
79                    if (n < 0) {
80                        error(new EndOfFile(stream));
81                        // Not reached.
82                        return null;
83                    }
84                    sb.append((char)n);
85                    continue;
86                }
87                if (Utilities.isPlatformWindows) {
88                    if (c == '\r') {
89                        n = stream._readChar();
90                        if (n < 0) {
91                            error(new EndOfFile(stream));
92                            // Not reached.
93                            return null;
94                        }
95                        if (n == '\n') {
96                            sb.append('\n');
97                        } else {
98                            // '\r' was not followed by '\n'.
99                            stream._unreadChar(n);
100                            sb.append('\r');
101                        }
102                        continue;
103                    }
104                }
105                if (c == terminator)
106                    break;
107                // Default.
108                sb.append(c);
109            }
110            return new SimpleString(sb);
111        }
112    };
113
114    // ### fasl-read-list
115    public static final ReaderMacroFunction FASL_READ_LIST =
116        new ReaderMacroFunction("fasl-read-list", PACKAGE_SYS, false,
117                                "stream character")
118    {
119        @Override
120        public LispObject execute(Stream stream, char ignored)
121            throws ConditionThrowable
122        {
123            return stream.readList(false, true);
124        }
125    };
126
127    // ### fasl-read-right-paren
128    public static final ReaderMacroFunction FASL_READ_RIGHT_PAREN =
129        new ReaderMacroFunction("fasl-read-right-paren", PACKAGE_SYS, false,
130                                "stream character")
131    {
132        @Override
133        public LispObject execute(Stream stream, char ignored)
134            throws ConditionThrowable
135        {
136            return error(new ReaderError("Unmatched right parenthesis.", stream));
137        }
138    };
139
140    // ### fasl-read-quote
141    public static final ReaderMacroFunction FASL_READ_QUOTE =
142        new ReaderMacroFunction("fasl-read-quote", PACKAGE_SYS, false,
143                                "stream character")
144    {
145        @Override
146        public LispObject execute(Stream stream, char ignored)
147            throws ConditionThrowable
148        {
149            return new Cons(Symbol.QUOTE,
150                            new Cons(stream.faslRead(true, NIL, true,
151                                                     LispThread.currentThread())));
152        }
153    };
154
155    // ### fasl-read-dispatch-char
156    public static final ReaderMacroFunction FASL_READ_DISPATCH_CHAR =
157        new ReaderMacroFunction("fasl-read-dispatch-char", PACKAGE_SYS, false,
158                                "stream character")
159    {
160        @Override
161        public LispObject execute(Stream stream, char c)
162            throws ConditionThrowable
163        {
164            return stream.readDispatchChar(c, true);
165        }
166    };
167
168    // ### fasl-sharp-left-paren
169    public static final DispatchMacroFunction FASL_SHARP_LEFT_PAREN =
170        new DispatchMacroFunction("fasl-sharp-left-paren", PACKAGE_SYS, false,
171                                  "stream sub-char numarg")
172    {
173        @Override
174        public LispObject execute(Stream stream, char c, int n)
175            throws ConditionThrowable
176        {
177            final LispThread thread = LispThread.currentThread();
178            LispObject list = stream.readList(true, true);
179            if (_BACKQUOTE_COUNT_.symbolValue(thread).zerop()) {
180                if (n >= 0) {
181                    LispObject[] array = new LispObject[n];
182                    for (int i = 0; i < n; i++) {
183                        array[i] = list.car();
184                        if (list.cdr() != NIL)
185                            list = list.cdr();
186                    }
187                    return new SimpleVector(array);
188                } else
189                    return new SimpleVector(list);
190            }
191            return new Cons(_BQ_VECTOR_FLAG_.symbolValue(thread), list);
192        }
193    };
194
195    // ### fasl-sharp-star
196    public static final DispatchMacroFunction FASL_SHARP_STAR =
197        new DispatchMacroFunction("fasl-sharp-star", PACKAGE_SYS, false,
198                                  "stream sub-char numarg")
199    {
200        @Override
201        public LispObject execute(Stream stream, char ignored, int n)
202            throws ConditionThrowable
203        {
204            final LispThread thread = LispThread.currentThread();
205            final Readtable rt = FaslReadtable.getInstance();
206            final boolean suppress =
207                (Symbol.READ_SUPPRESS.symbolValue(thread) != NIL);
208            FastStringBuffer sb = new FastStringBuffer();
209            while (true) {
210                int ch = stream._readChar();
211                if (ch < 0)
212                    break;
213                char c = (char) ch;
214                if (c == '0' || c == '1')
215                    sb.append(c);
216                else {
217                    int syntaxType = rt.getSyntaxType(c);
218                    if (syntaxType == Readtable.SYNTAX_TYPE_WHITESPACE ||
219                        syntaxType == Readtable.SYNTAX_TYPE_TERMINATING_MACRO) {
220                        stream._unreadChar(c);
221                        break;
222                    } else if (!suppress) {
223                        String name = LispCharacter.charToName(c);
224                        if (name == null)
225                            name = "#\\" + c;
226                        error(new ReaderError("Illegal element for bit-vector: " + name,
227                                               stream));
228                    }
229                }
230            }
231            if (suppress)
232                return NIL;
233            if (n >= 0) {
234                // n was supplied.
235                final int length = sb.length();
236                if (length == 0) {
237                    if (n > 0)
238                        return error(new ReaderError("No element specified for bit vector of length " +
239                                                      n + '.',
240                                                      stream));
241                }
242                if (n > length) {
243                    final char c = sb.charAt(length - 1);
244                    for (int i = length; i < n; i++)
245                        sb.append(c);
246                } else if (n < length) {
247                    return error(new ReaderError("Bit vector is longer than specified length: #" +
248                                                  n + '*' + sb.toString(),
249                                                  stream));
250                }
251            }
252            return new SimpleBitVector(sb.toString());
253        }
254    };
255
256    // ### fasl-sharp-dot
257    public static final DispatchMacroFunction FASL_SHARP_DOT =
258        new DispatchMacroFunction("fasl-sharp-dot", PACKAGE_SYS, false,
259                                  "stream sub-char numarg")
260    {
261        @Override
262        public LispObject execute(Stream stream, char c, int n)
263            throws ConditionThrowable
264        {
265            final LispThread thread = LispThread.currentThread();
266            if (Symbol.READ_EVAL.symbolValue(thread) == NIL)
267                return error(new ReaderError("Can't read #. when *READ-EVAL* is NIL.",
268                                              stream));
269            else
270                return eval(stream.faslRead(true, NIL, true, thread),
271                            new Environment(), thread);
272        }
273    };
274
275    // ### fasl-sharp-colon
276    public static final DispatchMacroFunction FASL_SHARP_COLON =
277        new DispatchMacroFunction("fasl-sharp-colon", PACKAGE_SYS, false,
278                                  "stream sub-char numarg")
279    {
280        @Override
281        public LispObject execute(Stream stream, char c, int n)
282            throws ConditionThrowable
283        {
284            LispThread thread = LispThread.currentThread();
285            Symbol symbol = (Symbol) stream.readSymbol(FaslReadtable.getInstance());
286            LispObject pkg = Load._FASL_ANONYMOUS_PACKAGE_.symbolValue(thread);
287            Debug.assertTrue(pkg != NIL);
288            symbol = ((Package)pkg).intern(symbol.getName());
289            symbol.setPackage(NIL);
290            return symbol;
291        }
292    };
293
294    // ### fasl-sharp-a
295    public static final DispatchMacroFunction FASL_SHARP_A =
296        new DispatchMacroFunction("fasl-sharp-a", PACKAGE_SYS, false,
297                                  "stream sub-char numarg")
298    {
299        @Override
300        public LispObject execute(Stream stream, char c, int n)
301            throws ConditionThrowable
302        {
303            return stream.faslReadArray(n);
304        }
305    };
306
307    // ### fasl-sharp-b
308    public static final DispatchMacroFunction FASL_SHARP_B =
309        new DispatchMacroFunction("fasl-sharp-b", PACKAGE_SYS, false,
310                                  "stream sub-char numarg")
311    {
312        @Override
313        public LispObject execute(Stream stream, char c, int n)
314            throws ConditionThrowable
315        {
316            return stream.faslReadRadix(2);
317        }
318    };
319
320    // ### fasl-sharp-c
321    public static final DispatchMacroFunction FASL_SHARP_C =
322        new DispatchMacroFunction("fasl-sharp-c", PACKAGE_SYS, false,
323                                  "stream sub-char numarg")
324    {
325        @Override
326        public LispObject execute(Stream stream, char c, int n)
327            throws ConditionThrowable
328        {
329            return stream.faslReadComplex();
330        }
331    };
332
333    // ### fasl-sharp-o
334    public static final DispatchMacroFunction FASL_SHARP_O =
335        new DispatchMacroFunction("fasl-sharp-o", PACKAGE_SYS, false,
336                                  "stream sub-char numarg")
337    {
338        @Override
339        public LispObject execute(Stream stream, char c, int n)
340            throws ConditionThrowable
341        {
342            return stream.faslReadRadix(8);
343        }
344    };
345
346    // ### fasl-sharp-p
347    public static final DispatchMacroFunction FASL_SHARP_P =
348        new DispatchMacroFunction("fasl-sharp-p", PACKAGE_SYS, false,
349                                  "stream sub-char numarg")
350    {
351        @Override
352        public LispObject execute(Stream stream, char c, int n)
353            throws ConditionThrowable
354        {
355            return stream.faslReadPathname();
356        }
357    };
358
359    // ### fasl-sharp-r
360    public static final DispatchMacroFunction FASL_SHARP_R =
361        new DispatchMacroFunction("fasl-sharp-r", PACKAGE_SYS, false,
362                                  "stream sub-char numarg")
363    {
364        @Override
365        public LispObject execute(Stream stream, char c, int n)
366            throws ConditionThrowable
367        {
368            return stream.faslReadRadix(n);
369        }
370    };
371
372    // ### fasl-sharp-s
373    public static final DispatchMacroFunction FASL_SHARP_S =
374        new DispatchMacroFunction("fasl-sharp-s", PACKAGE_SYS, false,
375                                  "stream sub-char numarg")
376    {
377        @Override
378        public LispObject execute(Stream stream, char c, int n)
379            throws ConditionThrowable
380        {
381            return stream.readStructure();
382        }
383    };
384
385    // ### fasl-sharp-x
386    public static final DispatchMacroFunction FASL_SHARP_X =
387        new DispatchMacroFunction("fasl-sharp-x", PACKAGE_SYS, false,
388                                  "stream sub-char numarg")
389    {
390        @Override
391        public LispObject execute(Stream stream, char c, int n)
392            throws ConditionThrowable
393        {
394            return stream.faslReadRadix(16);
395        }
396    };
397
398    // ### fasl-sharp-quote
399    public static final DispatchMacroFunction FASL_SHARP_QUOTE =
400        new DispatchMacroFunction("fasl-sharp-quote", PACKAGE_SYS, false,
401                                  "stream sub-char numarg")
402    {
403        @Override
404        public LispObject execute(Stream stream, char c, int n)
405            throws ConditionThrowable
406        {
407            return new Cons(Symbol.FUNCTION,
408                            new Cons(stream.faslRead(true, NIL, true,
409                                                     LispThread.currentThread())));
410        }
411    };
412
413    // ### fasl-sharp-backslash
414    public static final DispatchMacroFunction FASL_SHARP_BACKSLASH =
415        new DispatchMacroFunction("fasl-sharp-backslash", PACKAGE_SYS, false,
416                                  "stream sub-char numarg")
417    {
418        @Override
419        public LispObject execute(Stream stream, char c, int n)
420            throws ConditionThrowable
421        {
422            return stream.readCharacterLiteral(FaslReadtable.getInstance(),
423                                               LispThread.currentThread());
424        }
425    };
426
427    // ### fasl-sharp-vertical-bar
428    public static final DispatchMacroFunction FASL_SHARP_VERTICAL_BAR =
429        new DispatchMacroFunction("sharp-vertical-bar", PACKAGE_SYS, false,
430                                  "stream sub-char numarg")
431    {
432        @Override
433        public LispObject execute(Stream stream, char c, int n)
434            throws ConditionThrowable
435        {
436            stream.skipBalancedComment();
437            return null;
438        }
439    };
440
441    // ### fasl-sharp-illegal
442    public static final DispatchMacroFunction FASL_SHARP_ILLEGAL =
443        new DispatchMacroFunction("fasl-sharp-illegal", PACKAGE_SYS, false,
444                                  "stream sub-char numarg")
445    {
446        @Override
447        public LispObject execute(Stream stream, char c, int n)
448            throws ConditionThrowable
449        {
450            FastStringBuffer sb =
451                new FastStringBuffer("Illegal # macro character: #\\");
452            String s = LispCharacter.charToName(c);
453            if (s != null)
454                sb.append(s);
455            else
456                sb.append(c);
457            return error(new ReaderError(sb.toString(), stream));
458        }
459    };
460}
Note: See TracBrowser for help on using the repository browser.