Changeset 6094


Ignore:
Timestamp:
03/05/04 18:56:02 (17 years ago)
Author:
piso
Message:

READTABLE-CASE, %SET-READTABLE-CASE

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/Readtable.java

    r5160 r6094  
    22 * Readtable.java
    33 *
    4  * Copyright (C) 2003 Peter Graves
    5  * $Id: Readtable.java,v 1.4 2003-12-16 03:13:22 piso Exp $
     4 * Copyright (C) 2003-2004 Peter Graves
     5 * $Id: Readtable.java,v 1.5 2004-03-05 18:56:02 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2626public final class Readtable extends LispObject
    2727{
    28     private ArrayList table;
     28    private final ArrayList table;
     29    private LispObject readtableCase;
    2930
    3031    public Readtable()
    3132    {
    3233        table = new ArrayList();
     34        readtableCase = Keyword.UPCASE;
    3335    }
    3436
     
    155157    // => function
    156158    private static final Primitive GET_DISPATCH_MACRO_CHARACTER =
    157         new Primitive("get-dispatch-macro-character", "disp-char sub-char &optional readtable")
     159        new Primitive("get-dispatch-macro-character",
     160                      "disp-char sub-char &optional readtable")
    158161    {
    159162        public LispObject execute(LispObject[] args) throws ConditionThrowable
     
    176179    // => t
    177180    private static final Primitive SET_DISPATCH_MACRO_CHARACTER =
    178         new Primitive("set-dispatch-macro-character", "disp-char sub-char new-function &optional readtable")
     181        new Primitive("set-dispatch-macro-character",
     182                      "disp-char sub-char new-function &optional readtable")
    179183    {
    180184        public LispObject execute(LispObject[] args) throws ConditionThrowable
     
    193197        }
    194198    };
     199
     200    // ### readtable-case readtable => mode
     201    private static final Primitive1 READTABLE_CASE =
     202        new Primitive1("readtable-case", "readtable")
     203    {
     204        public LispObject execute(LispObject arg) throws ConditionThrowable
     205        {
     206            try {
     207                return ((Readtable)arg).readtableCase;
     208            }
     209            catch (ClassCastException e) {
     210                return signal(new TypeError(arg, Symbol.READTABLE));
     211            }
     212        }
     213    };
     214
     215    // ### %set-readtable-case readtable new-mode => new-mode
     216    private static final Primitive2 _SET_READTABLE_CASE =
     217        new Primitive2("%set-readtable-case", PACKAGE_SYS, false,
     218                       "readtable new-mode")
     219    {
     220        public LispObject execute(LispObject first, LispObject second)
     221            throws ConditionThrowable
     222        {
     223            try {
     224                Readtable readtable = (Readtable) first;
     225                if (second == Keyword.UPCASE || second == Keyword.DOWNCASE ||
     226                    second == Keyword.INVERT || second == Keyword.PRESERVE)
     227                {
     228                    readtable.readtableCase = second;
     229                    return second;
     230                }
     231                return signal(new TypeError(second, list5(Symbol.MEMBER,
     232                                                          Keyword.INVERT,
     233                                                          Keyword.PRESERVE,
     234                                                          Keyword.DOWNCASE,
     235                                                          Keyword.UPCASE)));
     236            }
     237            catch (ClassCastException e) {
     238                return signal(new TypeError(first, Symbol.READTABLE));
     239            }
     240        }
     241    };
    195242}
Note: See TracChangeset for help on using the changeset viewer.