Changeset 10195


Ignore:
Timestamp:
10/23/05 14:12:30 (16 years ago)
Author:
piso
Message:

Symbol refactoring (work in progress).

Location:
trunk/j/src/org/armedbear/lisp
Files:
5 edited

Legend:

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

    r9330 r10195  
    33 *
    44 * Copyright (C) 2002-2005 Peter Graves
    5  * $Id: Function.java,v 1.55 2005-06-09 11:49:06 piso Exp $
     5 * $Id: Function.java,v 1.56 2005-10-23 14:12:19 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    3737            setLambdaName(symbol);
    3838        }
     39    }
     40
     41    public Function(Symbol symbol, String arglist)
     42    {
     43        symbol.setSymbolFunction(this);
     44        if (cold)
     45            symbol.setBuiltInFunction(true);
     46        setLambdaName(symbol);
    3947    }
    4048
  • trunk/j/src/org/armedbear/lisp/Primitive.java

    r9330 r10195  
    33 *
    44 * Copyright (C) 2002-2005 Peter Graves
    5  * $Id: Primitive.java,v 1.18 2005-06-09 11:49:06 piso Exp $
     5 * $Id: Primitive.java,v 1.19 2005-10-23 14:12:11 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    3232    {
    3333        super(name);
     34    }
     35
     36    public Primitive(Symbol symbol, String arglist)
     37    {
     38        super(symbol, arglist);
    3439    }
    3540
  • trunk/j/src/org/armedbear/lisp/Primitives.java

    r10194 r10195  
    33 *
    44 * Copyright (C) 2002-2005 Peter Graves
    5  * $Id: Primitives.java,v 1.837 2005-10-23 13:05:23 piso Exp $
     5 * $Id: Primitives.java,v 1.838 2005-10-23 14:12:30 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2828{
    2929    // ### *
    30     public static final Primitive MULTIPLY = new Primitive("*", "&rest numbers")
     30    public static final Primitive MULTIPLY =
     31        new Primitive(Symbol.STAR, "&rest numbers")
    3132    {
    3233        public LispObject execute()
     
    3839            if (arg.numberp())
    3940                return arg;
    40             signal(new TypeError(arg, Symbol.NUMBER));
    41             return NIL;
     41            return signalTypeError(arg, Symbol.NUMBER);
    4242        }
    4343        public LispObject execute(LispObject first, LispObject second)
     
    5757    // ### /
    5858    public static final Primitive DIVIDE =
    59         new Primitive("/", "numerator &rest denominators")
     59        new Primitive(Symbol.SLASH, "numerator &rest denominators")
    6060    {
    6161        public LispObject execute() throws ConditionThrowable
     
    8383
    8484    // ### min
    85     public static final Primitive MIN = new Primitive("min", "&rest reals")
     85    public static final Primitive MIN =
     86        new Primitive(Symbol.MIN, "&rest reals")
    8687    {
    8788        public LispObject execute() throws ConditionThrowable
     
    9495            if (arg.realp())
    9596                return arg;
    96             return signal(new TypeError(arg, Symbol.REAL));
     97            return signalTypeError(arg, Symbol.REAL);
    9798        }
    9899        public LispObject execute(LispObject first, LispObject second)
     
    105106            LispObject result = args[0];
    106107            if (!result.realp())
    107                 signal(new TypeError(result, Symbol.REAL));
     108                signalTypeError(result, Symbol.REAL);
    108109            for (int i = 1; i < args.length; i++) {
    109110                if (args[i].isLessThan(result))
     
    115116
    116117    // ### max
    117     public static final Primitive MAX = new Primitive("max", "&rest reals")
     118    public static final Primitive MAX =
     119        new Primitive(Symbol.MAX, "&rest reals")
    118120    {
    119121        public LispObject execute() throws ConditionThrowable
     
    126128            if (arg.realp())
    127129                return arg;
    128             return signal(new TypeError(arg, Symbol.REAL));
     130            return signalTypeError(arg, Symbol.REAL);
    129131        }
    130132        public LispObject execute(LispObject first, LispObject second)
     
    147149
    148150    // ### identity
    149     private static final Primitive IDENTITY = new Primitive("identity", "object")
     151    private static final Primitive IDENTITY =
     152        new Primitive(Symbol.IDENTITY, "object")
    150153    {
    151154        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    157160    // ### compiled-function-p
    158161    private static final Primitive COMPILED_FUNCTION_P =
    159         new Primitive("compiled-function-p", "object")
     162        new Primitive(Symbol.COMPILED_FUNCTION_P, "object")
    160163    {
    161164        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    166169
    167170    // ### consp
    168     private static final Primitive CONSP = new Primitive("consp", "object")
     171    private static final Primitive CONSP =
     172        new Primitive(Symbol.CONSP, "object")
    169173    {
    170174        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    175179
    176180    // ### listp
    177     private static final Primitive LISTP = new Primitive("listp", "object")
     181    private static final Primitive LISTP =
     182        new Primitive(Symbol.LISTP, "object")
    178183    {
    179184        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    184189
    185190    // ### abs
    186     private static final Primitive ABS = new Primitive("abs", "number")
     191    private static final Primitive ABS =
     192        new Primitive(Symbol.ABS, "number")
    187193    {
    188194        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    193199
    194200    // ### arrayp
    195     private static final Primitive ARRAYP = new Primitive("arrayp", "object")
     201    private static final Primitive ARRAYP =
     202        new Primitive(Symbol.ARRAYP, "object")
    196203    {
    197204        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    203210    // ### array-has-fill-pointer-p
    204211    private static final Primitive ARRAY_HAS_FILL_POINTER_P =
    205         new Primitive("array-has-fill-pointer-p", "array")
     212        new Primitive(Symbol.ARRAY_HAS_FILL_POINTER_P, "array")
    206213    {
    207214        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    211218            }
    212219            catch (ClassCastException e) {
    213                 return signal(new TypeError(arg, Symbol.ARRAY));
     220                return signalTypeError(arg, Symbol.ARRAY);
    214221            }
    215222        }
     
    217224
    218225    // ### vectorp
    219     private static final Primitive VECTORP = new Primitive("vectorp", "object")
     226    private static final Primitive VECTORP =
     227        new Primitive(Symbol.VECTORP, "object")
    220228    {
    221229        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    227235    // ### simple-vector-p
    228236    private static final Primitive SIMPLE_VECTOR_P =
    229         new Primitive("simple-vector-p", "object")
     237        new Primitive(Symbol.SIMPLE_VECTOR_P, "object")
    230238    {
    231239        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    237245    // ### bit-vector-p
    238246    private static final Primitive BIT_VECTOR_P =
    239         new Primitive("bit-vector-p", "object")
     247        new Primitive(Symbol.BIT_VECTOR_P, "object")
    240248    {
    241249        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    247255    // ### simple-bit-vector-p
    248256    private static final Primitive SIMPLE_BIT_VECTOR_P =
    249         new Primitive("simple-bit-vector-p", "object")
     257        new Primitive(Symbol.SIMPLE_BIT_VECTOR_P, "object")
    250258    {
    251259        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    266274
    267275    // ### eq
    268     private static final Primitive EQ = new Primitive("eq", "x y")
     276    private static final Primitive EQ = new Primitive(Symbol.EQ, "x y")
    269277    {
    270278        public LispObject execute(LispObject first, LispObject second)
     
    276284
    277285    // ### eql
    278     private static final Primitive EQL = new Primitive("eql", "x y")
     286    private static final Primitive EQL = new Primitive(Symbol.EQL, "x y")
    279287    {
    280288        public LispObject execute(LispObject first, LispObject second)
     
    286294
    287295    // ### equal
    288     private static final Primitive EQUAL = new Primitive("equal", "x y")
     296    private static final Primitive EQUAL = new Primitive(Symbol.EQUAL, "x y")
    289297    {
    290298        public LispObject execute(LispObject first, LispObject second)
     
    296304
    297305    // ### equalp
    298     private static final Primitive EQUALP = new Primitive("equalp", "x y")
     306    private static final Primitive EQUALP = new Primitive(Symbol.EQUALP, "x y")
    299307    {
    300308        public LispObject execute(LispObject first, LispObject second)
     
    306314
    307315    // ### values
    308     private static final Primitive VALUES = new Primitive("values", "&rest object")
     316    private static final Primitive VALUES =
     317        new Primitive(Symbol.VALUES, "&rest object")
    309318    {
    310319        public LispObject execute()
     
    341350    // Returns the elements of the list as multiple values.
    342351    private static final Primitive VALUES_LIST =
    343         new Primitive("values-list", "list")
     352        new Primitive(Symbol.VALUES_LIST, "list")
    344353    {
    345354        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    355364    // ### cons
    356365    private static final Primitive CONS =
    357         new Primitive("cons", "object-1 object-2")
     366        new Primitive(Symbol.CONS, "object-1 object-2")
    358367    {
    359368        public LispObject execute(LispObject first, LispObject second)
     
    366375    // ### length
    367376    private static final Primitive LENGTH =
    368         new Primitive("length", "sequence")
     377        new Primitive(Symbol.LENGTH, "sequence")
    369378    {
    370379        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    376385    // ### elt
    377386    private static final Primitive ELT =
    378         new Primitive("elt", "sequence index")
     387        new Primitive(Symbol.ELT, "sequence index")
    379388    {
    380389        public LispObject execute(LispObject first, LispObject second)
     
    385394            }
    386395            catch (ClassCastException e) {
    387                 return signal(new TypeError(second, Symbol.FIXNUM));
     396                return signalTypeError(second, Symbol.FIXNUM);
    388397            }
    389398        }
     
    391400
    392401    // ### atom
    393     private static final Primitive ATOM = new Primitive("atom", "object")
     402    private static final Primitive ATOM = new Primitive(Symbol.ATOM, "object")
    394403    {
    395404        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    401410    // ### constantp
    402411    private static final Primitive CONSTANTP =
    403         new Primitive("constantp", "form &optional environment")
     412        new Primitive(Symbol.CONSTANTP, "form &optional environment")
    404413    {
    405414        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    416425    // ### functionp
    417426    private static final Primitive FUNCTIONP =
    418         new Primitive("functionp", "object")
     427        new Primitive(Symbol.FUNCTIONP, "object")
    419428    {
    420429        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    426435    // ### special-operator-p
    427436    private static final Primitive SPECIAL_OPERATOR_P =
    428         new Primitive("special-operator-p", "symbol")
     437        new Primitive(Symbol.SPECIAL_OPERATOR_P, "symbol")
    429438    {
    430439        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    435444
    436445    // ### symbolp
    437     private static final Primitive SYMBOLP = new Primitive("symbolp", "object")
     446    private static final Primitive SYMBOLP =
     447        new Primitive(Symbol.SYMBOLP, "object")
    438448    {
    439449        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    444454
    445455    // ### endp
    446     private static final Primitive ENDP = new Primitive("endp", "list")
     456    private static final Primitive ENDP = new Primitive(Symbol.ENDP, "list")
    447457    {
    448458        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    453463
    454464    // ### null
    455     private static final Primitive NULL = new Primitive("null", "object")
     465    private static final Primitive NULL = new Primitive(Symbol.NULL, "object")
    456466    {
    457467        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    462472
    463473    // ### not
    464     private static final Primitive NOT = new Primitive("not", "x")
     474    private static final Primitive NOT = new Primitive(Symbol.NOT, "x")
    465475    {
    466476        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    471481
    472482    // ### plusp
    473     private static final Primitive PLUSP = new Primitive("plusp", "real")
     483    private static final Primitive PLUSP = new Primitive(Symbol.PLUSP, "real")
    474484    {
    475485        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    480490
    481491    // ### minusp
    482     private static final Primitive MINUSP = new Primitive("minusp", "real")
     492    private static final Primitive MINUSP =
     493        new Primitive(Symbol.MINUSP, "real")
    483494    {
    484495        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    489500
    490501    // ### zerop
    491     private static final Primitive ZEROP = new Primitive("zerop","number") {
     502    private static final Primitive ZEROP =
     503        new Primitive(Symbol.ZEROP, "number")
     504    {
    492505        public LispObject execute(LispObject arg) throws ConditionThrowable
    493506        {
     
    498511    // ### fixnump
    499512    private static final Primitive FIXNUMP =
    500         new Primitive("fixnump", PACKAGE_EXT, true) {
     513        new Primitive("fixnump", PACKAGE_EXT, true)
     514    {
    501515        public LispObject execute(LispObject arg) throws ConditionThrowable
    502516        {
     
    507521    // ### symbol-value
    508522    private static final Primitive SYMBOL_VALUE =
    509         new Primitive("symbol-value", "symbol")
     523        new Primitive(Symbol.SYMBOL_VALUE, "symbol")
    510524    {
    511525        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    525539    };
    526540
    527     // ### set
    528     // set symbol value => value
    529     private static final Primitive SET = new Primitive("set", "symbol value")
     541    // ### set symbol value => value
     542    private static final Primitive SET =
     543        new Primitive(Symbol.SET, "symbol value")
    530544    {
    531545        public LispObject execute(LispObject first, LispObject second)
     
    537551            }
    538552            catch (ClassCastException e) {
    539                 return signal(new TypeError(first, Symbol.SYMBOL));
     553                return signalTypeError(first, Symbol.SYMBOL);
    540554            }
    541555        }
     
    544558    // ### rplaca
    545559    private static final Primitive RPLACA =
    546         new Primitive("rplaca", "cons object")
     560        new Primitive(Symbol.RPLACA, "cons object")
    547561    {
    548562        public LispObject execute(LispObject first, LispObject second)
     
    556570    // ### rplacd
    557571    private static final Primitive RPLACD =
    558         new Primitive("rplacd", "cons object")
     572        new Primitive(Symbol.RPLACD, "cons object")
    559573    {
    560574        public LispObject execute(LispObject first, LispObject second)
     
    567581
    568582    // ### +
    569     private static final Primitive ADD = new Primitive("+", "&rest numbers")
     583    private static final Primitive ADD =
     584        new Primitive(Symbol.PLUS, "&rest numbers")
    570585    {
    571586        public LispObject execute()
     
    577592            if (arg.numberp())
    578593                return arg;
    579             return signal(new TypeError(arg, Symbol.NUMBER));
     594            return signalTypeError(arg, Symbol.NUMBER);
    580595        }
    581596        public LispObject execute(LispObject first, LispObject second)
     
    601616
    602617    // ### 1+
    603     private static final Primitive ONE_PLUS = new Primitive("1+", "number")
     618    private static final Primitive ONE_PLUS =
     619        new Primitive(Symbol.ONE_PLUS, "number")
    604620    {
    605621        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    611627    // ### -
    612628    private static final Primitive SUBTRACT =
    613         new Primitive("-", "minuend &rest subtrahends")
     629        new Primitive(Symbol.MINUS, "minuend &rest subtrahends")
    614630    {
    615631        public LispObject execute() throws ConditionThrowable
     
    636652
    637653    // ### 1-
    638     private static final Primitive ONE_MINUS = new Primitive("1-", "number")
     654    private static final Primitive ONE_MINUS =
     655        new Primitive(Symbol.ONE_MINUS, "number")
    639656    {
    640657        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    645662
    646663    // ### when
    647     private static final SpecialOperator WHEN = new SpecialOperator("when")
     664    private static final SpecialOperator WHEN =
     665        new SpecialOperator(Symbol.WHEN)
    648666    {
    649667        public LispObject execute(LispObject args, Environment env)
     
    667685
    668686    // ### unless
    669     private static final SpecialOperator UNLESS = new SpecialOperator("unless")
     687    private static final SpecialOperator UNLESS =
     688        new SpecialOperator(Symbol.UNLESS)
    670689    {
    671690        public LispObject execute(LispObject args, Environment env)
     
    801820    // Determines only whether a symbol has a value in the global environment;
    802821    // any lexical bindings are ignored.
    803     private static final Primitive BOUNDP = new Primitive("boundp", "symbol")
     822    private static final Primitive BOUNDP =
     823        new Primitive(Symbol.BOUNDP, "symbol")
    804824    {
    805825        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    825845
    826846    // ### fboundp
    827     private static final Primitive FBOUNDP = new Primitive("fboundp", "name")
     847    private static final Primitive FBOUNDP =
     848        new Primitive(Symbol.FBOUNDP, "name")
    828849    {
    829850        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    841862    // ### fmakunbound name => name
    842863    private static final Primitive FMAKUNBOUND =
    843         new Primitive("fmakunbound", "name")
     864        new Primitive(Symbol.FMAKUNBOUND, "name")
    844865    {
    845866        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    853874                return arg;
    854875            }
    855             return signal(new TypeError(arg, FUNCTION_NAME));
     876            return signalTypeError(arg, FUNCTION_NAME);
    856877        }
    857878    };
     
    869890    // ### remprop
    870891    private static final Primitive REMPROP =
    871         new Primitive("remprop", "symbol indicator")
     892        new Primitive(Symbol.REMPROP, "symbol indicator")
    872893    {
    873894        public LispObject execute(LispObject first, LispObject second)
     
    880901    // ### append
    881902    public static final Primitive APPEND =
    882         new Primitive("append", "&rest lists")
     903        new Primitive(Symbol.APPEND, "&rest lists")
    883904    {
    884905        public LispObject execute()
     
    970991
    971992    // ### nconc
    972     private static final Primitive NCONC = new Primitive("nconc", "&rest lists")
     993    private static final Primitive NCONC =
     994        new Primitive(Symbol.NCONC, "&rest lists")
    973995    {
    974996        public LispObject execute()
     
    9951017                return result;
    9961018            }
    997             return signal(new TypeError(first, Symbol.LIST));
     1019            return signalTypeError(first, Symbol.LIST);
    9981020        }
    9991021        public LispObject execute(LispObject[] array) throws ConditionThrowable
     
    10301052                            }
    10311053                        } else
    1032                             signal(new TypeError(list, Symbol.LIST));
     1054                            signalTypeError(list, Symbol.LIST);
    10331055                    }
    10341056                    if (result == null)
     
    10431065    // ### =
    10441066    // Numeric equality.
    1045     private static final Primitive EQUALS = new Primitive("=", "&rest numbers")
     1067    private static final Primitive EQUALS =
     1068        new Primitive(Symbol.EQUALS, "&rest numbers")
    10461069    {
    10471070        public LispObject execute() throws ConditionThrowable
     
    10821105    // Returns true if no two numbers are the same; otherwise returns false.
    10831106    private static final Primitive NOT_EQUALS =
    1084         new Primitive("/=", "&rest numbers")
     1107        new Primitive(Symbol.NOT_EQUALS, "&rest numbers")
    10851108    {
    10861109        public LispObject execute() throws ConditionThrowable
     
    11251148    // ### <
    11261149    // Numeric comparison.
    1127     private static final Primitive LESS_THAN =
    1128         new Primitive("<", "&rest numbers")
     1150    private static final Primitive LT =
     1151        new Primitive(Symbol.LT, "&rest numbers")
    11291152    {
    11301153        public LispObject execute() throws ConditionThrowable
     
    11621185
    11631186    // ### <=
    1164     private static final Primitive LE = new Primitive("<=", "&rest numbers")
     1187    private static final Primitive LE =
     1188        new Primitive(Symbol.LE, "&rest numbers")
    11651189    {
    11661190        public LispObject execute() throws ConditionThrowable
     
    11981222
    11991223    // ### >
    1200     private static final Primitive GREATER_THAN =
    1201         new Primitive(">", "&rest numbers")
     1224    private static final Primitive GT =
     1225        new Primitive(Symbol.GT, "&rest numbers")
    12021226    {
    12031227        public LispObject execute() throws ConditionThrowable
     
    12351259
    12361260    // ### >=
    1237     private static final Primitive GE = new Primitive(">=", "&rest numbers")
     1261    private static final Primitive GE =
     1262        new Primitive(Symbol.GE, "&rest numbers")
    12381263    {
    12391264        public LispObject execute() throws ConditionThrowable
     
    12701295    };
    12711296
    1272     // ### assoc
    1273     // assoc item alist &key key test test-not => entry
    1274     // This is the bootstrap version (needed for %set-documentation).
    1275     // Redefined properly in assoc.lisp.
    1276     private static final Primitive ASSOC =
    1277         new Primitive("assoc", "item alist &key key test test-not")
    1278     {
    1279         public LispObject execute(LispObject[] args) throws ConditionThrowable
    1280         {
    1281             if (args.length != 2)
    1282                 signal(new WrongNumberOfArgumentsException(this));
    1283             LispObject item = args[0];
    1284             LispObject alist = args[1];
    1285             while (alist != NIL) {
    1286                 LispObject cons = alist.car();
    1287                 if (cons instanceof Cons) {
    1288                     if (cons.car().eql(item))
    1289                         return cons;
    1290                 } else if (cons != NIL)
    1291                     signal(new TypeError(cons, Symbol.LIST));
    1292                 alist = alist.cdr();
    1293             }
    1294             return NIL;
    1295         }
    1296     };
    1297 
    1298     // ### nth
    1299     // nth n list => object
    1300     private static final Primitive NTH = new Primitive("nth", "n list")
     1297    // ### nth n list => object
     1298    private static final Primitive NTH = new Primitive(Symbol.NTH, "n list")
    13011299    {
    13021300        public LispObject execute(LispObject first, LispObject second)
     
    13071305    };
    13081306
    1309     // ### %set-nth
    1310     // %setnth n list new-object => new-object
     1307    // ### %set-nth n list new-object => new-object
    13111308    private static final Primitive _SET_NTH =
    13121309        new Primitive("%set-nth", PACKAGE_SYS, false)
     
    13361333
    13371334    // ### nthcdr
    1338     private static final Primitive NTHCDR = new Primitive("nthcdr", "n list")
     1335    private static final Primitive NTHCDR =
     1336        new Primitive(Symbol.NTHCDR, "n list")
    13391337    {
    13401338        public LispObject execute(LispObject first, LispObject second)
     
    13621360    // ### error
    13631361    private static final Primitive ERROR =
    1364         new Primitive("error", "datum &rest arguments")
     1362        new Primitive(Symbol.ERROR, "datum &rest arguments")
    13651363    {
    13661364        public LispObject execute(LispObject[] args) throws ConditionThrowable
     
    14301428    // ### signal
    14311429    private static final Primitive SIGNAL =
    1432         new Primitive("signal", "datum &rest arguments")
     1430        new Primitive(Symbol.SIGNAL, "datum &rest arguments")
    14331431    {
    14341432        public LispObject execute(LispObject[] args) throws ConditionThrowable
     
    16031601    // ### macro-function
    16041602    private static final Primitive MACRO_FUNCTION =
    1605         new Primitive("macro-function", "symbol &optional environment")
     1603        new Primitive(Symbol.MACRO_FUNCTION, "symbol &optional environment")
    16061604    {
    16071605        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    16541652
    16551653    // ### defmacro
    1656     private static final SpecialOperator DEFMACRO = new SpecialOperator("defmacro")
     1654    private static final SpecialOperator DEFMACRO =
     1655        new SpecialOperator(Symbol.DEFMACRO)
    16571656    {
    16581657        public LispObject execute(LispObject args, Environment env)
     
    17581757
    17591758    // ### cond
    1760     private static final SpecialOperator COND = new SpecialOperator("cond", "&rest clauses") {
     1759    private static final SpecialOperator COND =
     1760        new SpecialOperator(Symbol.COND, "&rest clauses")
     1761    {
    17611762        public LispObject execute(LispObject args, Environment env)
    17621763            throws ConditionThrowable
     
    17831784
    17841785    // ### case
    1785     private static final SpecialOperator CASE = new SpecialOperator("case", "keyform &body cases")
     1786    private static final SpecialOperator CASE =
     1787        new SpecialOperator(Symbol.CASE, "keyform &body cases")
    17861788    {
    17871789        public LispObject execute(LispObject args, Environment env)
     
    18221824    // ### ecase
    18231825    private static final SpecialOperator ECASE =
    1824         new SpecialOperator("ecase", "keyform &body cases")
     1826        new SpecialOperator(Symbol.ECASE, "keyform &body cases")
    18251827    {
    18261828        public LispObject execute(LispObject args, Environment env)
     
    18731875    };
    18741876
    1875     // ### upgraded-array-element-type
    1876     // upgraded-array-element-type typespec &optional environment
     1877    // ### upgraded-array-element-type typespec &optional environment
    18771878    // => upgraded-typespec
    18781879    private static final Primitive UPGRADED_ARRAY_ELEMENT_TYPE =
    1879         new Primitive("upgraded-array-element-type",
     1880        new Primitive(Symbol.UPGRADED_ARRAY_ELEMENT_TYPE,
    18801881                      "typespec &optional environment")
    18811882    {
     
    18921893    };
    18931894
    1894     // ### array-rank
    1895     // array-rank array => rank
     1895    // ### array-rank array => rank
    18961896    private static final Primitive ARRAY_RANK =
    1897         new Primitive("array-rank", "array")
     1897        new Primitive(Symbol.ARRAY_RANK, "array")
    18981898    {
    18991899        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    19031903            }
    19041904            catch (ClassCastException e) {
    1905                 return signal(new TypeError(arg, Symbol.ARRAY));
    1906             }
    1907         }
    1908     };
    1909 
    1910     // ### array-dimensions
    1911     // array-dimensions array => dimensions
     1905                return signalTypeError(arg, Symbol.ARRAY);
     1906            }
     1907        }
     1908    };
     1909
     1910    // ### array-dimensions array => dimensions
    19121911    // Returns a list of integers. Fill pointer (if any) is ignored.
    19131912    private static final Primitive ARRAY_DIMENSIONS =
    1914         new Primitive("array-dimensions", "array")
     1913        new Primitive(Symbol.ARRAY_DIMENSIONS, "array")
    19151914    {
    19161915        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    19201919            }
    19211920            catch (ClassCastException e) {
    1922                 return signal(new TypeError(arg, Symbol.ARRAY));
    1923             }
    1924         }
    1925     };
    1926 
    1927     // ### array-dimension
    1928     // array-dimension array axis-number => dimension
     1921                return signalTypeError(arg, Symbol.ARRAY);
     1922            }
     1923        }
     1924    };
     1925
     1926    // ### array-dimension array axis-number => dimension
    19291927    private static final Primitive ARRAY_DIMENSION =
    1930         new Primitive("array-dimension", "array axis-number")
     1928        new Primitive(Symbol.ARRAY_DIMENSION, "array axis-number")
    19311929    {
    19321930        public LispObject execute(LispObject first, LispObject second)
     
    19381936            }
    19391937            catch (ClassCastException e) {
    1940                 return signal(new TypeError(first, Symbol.ARRAY));
     1938                return signalTypeError(first, Symbol.ARRAY);
    19411939            }
    19421940            final int n;
     
    19451943            }
    19461944            catch (ClassCastException e) {
    1947                 return signal(new TypeError(second, Symbol.FIXNUM));
     1945                return signalTypeError(second, Symbol.FIXNUM);
    19481946            }
    19491947            return new Fixnum(array.getDimension(n));
     
    19511949    };
    19521950
    1953     // ### array-total-size
    1954     // array-total-size array => size
     1951    // ### array-total-size array => size
    19551952    private static final Primitive ARRAY_TOTAL_SIZE =
    1956         new Primitive("array-total-size","array") {
    1957         public LispObject execute(LispObject arg) throws ConditionThrowable
    1958         {
    1959             return new Fixnum(checkArray(arg).getTotalSize());
     1953        new Primitive(Symbol.ARRAY_TOTAL_SIZE, "array")
     1954    {
     1955        public LispObject execute(LispObject arg) throws ConditionThrowable
     1956        {
     1957            try {
     1958                return new Fixnum(((AbstractArray)arg).getTotalSize());
     1959            }
     1960            catch (ClassCastException e) {
     1961                return signalTypeError(arg, Symbol.ARRAY);
     1962            }
    19601963        }
    19611964    };
     
    19651968    // array-element-type array => typespec
    19661969    private static final Primitive ARRAY_ELEMENT_TYPE =
    1967         new Primitive("array-element-type", "array")
     1970        new Primitive(Symbol.ARRAY_ELEMENT_TYPE, "array")
    19681971    {
    19691972        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    19731976            }
    19741977            catch (ClassCastException e) {
    1975                 return signal(new TypeError(arg, Symbol.ARRAY));
     1978                return signalTypeError(arg, Symbol.ARRAY);
    19761979            }
    19771980        }
     
    19801983    // ### adjustable-array-p
    19811984    private static final Primitive ADJUSTABLE_ARRAY_P =
    1982         new Primitive("adjustable-array-p", "array")
     1985        new Primitive(Symbol.ADJUSTABLE_ARRAY_P, "array")
    19831986    {
    19841987        public LispObject execute(LispObject arg) throws ConditionThrowable
     
    19881991            }
    19891992            catch (ClassCastException e) {
    1990                 return signal(new TypeError(arg, Symbol.ARRAY));
    1991             }
    1992         }
    1993     };
    1994 
    1995     // ### array-displacement
    1996     // array-displacement array => displaced-to, displaced-index-offset
     1993                return signalTypeError(arg, Symbol.ARRAY);
     1994            }
     1995        }
     1996    };
     1997
     1998    // ### array-displacement array => displaced-to, displaced-index-offset
    19971999    private static final Primitive ARRAY_DISPLACEMENT =
    1998         new Primitive("array-displacement", "array")
    1999     {
    2000         public LispObject execute(LispObject arg) throws ConditionThrowable
    2001         {
    2002             return checkArray(arg).arrayDisplacement();
    2003         }
    2004     };
    2005 
    2006     // ### array-in-bounds-p
    2007     // array-in-bounds-p array &rest subscripts => generalized-boolean
     2000        new Primitive(Symbol.ARRAY_DISPLACEMENT, "array")
     2001    {
     2002        public LispObject execute(LispObject arg) throws ConditionThrowable
     2003        {
     2004            try {
     2005                return ((AbstractArray)arg).arrayDisplacement();
     2006            }
     2007            catch (ClassCastException e) {
     2008                return signalTypeError(arg, Symbol.ARRAY);
     2009            }
     2010        }
     2011    };
     2012
     2013    // ### array-in-bounds-p array &rest subscripts => generalized-boolean
    20082014    private static final Primitive ARRAY_IN_BOUNDS_P =
    2009         new Primitive("array-in-bounds-p", "array &rest subscripts")
     2015        new Primitive(Symbol.ARRAY_IN_BOUNDS_P, "array &rest subscripts")
    20102016    {
    20112017        public LispObject execute(LispObject[] args) throws ConditionThrowable
     
    20132019            if (args.length < 1)
    20142020                signal(new WrongNumberOfArgumentsException(this));
    2015             AbstractArray array = checkArray(args[0]);
     2021//             AbstractArray array = checkArray(args[0]);
     2022            final AbstractArray array;
     2023            try {
     2024                array = (AbstractArray) args[0];
     2025            }
     2026            catch (ClassCastException e) {
     2027                return signalTypeError(args[0], Symbol.ARRAY);
     2028            }
    20162029            int rank = array.getRank();
    20172030            if (rank != args.length - 1) {
     
    20332046                    return NIL;
    20342047                } else
    2035                     signal(new TypeError(arg, Symbol.INTEGER));
     2048                    signalTypeError(arg, Symbol.INTEGER);
    20362049            }
    20372050            return T;
  • trunk/j/src/org/armedbear/lisp/SpecialOperator.java

    r9721 r10195  
    33 *
    44 * Copyright (C) 2002-2005 Peter Graves
    5  * $Id: SpecialOperator.java,v 1.19 2005-07-25 17:00:25 piso Exp $
     5 * $Id: SpecialOperator.java,v 1.20 2005-10-23 14:11:53 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2525{
    2626    private int callCount;
     27
     28    public SpecialOperator(Symbol symbol)
     29    {
     30        symbol.setSymbolFunction(this);
     31        setLambdaName(symbol);
     32    }
     33
     34    public SpecialOperator(Symbol symbol, String arglist)
     35    {
     36        symbol.setSymbolFunction(this);
     37        setLambdaName(symbol);
     38        setLambdaList(new SimpleString(arglist));
     39    }
    2740
    2841    public SpecialOperator(String name)
  • trunk/j/src/org/armedbear/lisp/Symbol.java

    r10190 r10195  
    33 *
    44 * Copyright (C) 2002-2005 Peter Graves
    5  * $Id: Symbol.java,v 1.214 2005-10-23 12:56:19 piso Exp $
     5 * $Id: Symbol.java,v 1.215 2005-10-23 14:11:26 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    918918    public static final Symbol ONE_MINUS =
    919919        PACKAGE_CL.addExternalSymbol("1-");
    920     public static final Symbol LESS_THAN =
     920    public static final Symbol LT =
    921921        PACKAGE_CL.addExternalSymbol("<");
    922     public static final Symbol LESS_THAN_OR_EQUAL =
     922    public static final Symbol LE =
    923923        PACKAGE_CL.addExternalSymbol("<=");
    924924    public static final Symbol EQUALS =
    925925        PACKAGE_CL.addExternalSymbol("=");
    926     public static final Symbol GREATER_THAN =
     926    public static final Symbol GT =
    927927        PACKAGE_CL.addExternalSymbol(">");
    928     public static final Symbol GREATER_THAN_OR_EQUAL =
     928    public static final Symbol GE =
    929929        PACKAGE_CL.addExternalSymbol(">=");
    930930    public static final Symbol ABORT =
Note: See TracChangeset for help on using the changeset viewer.