Changeset 5019


Ignore:
Timestamp:
12/08/03 04:49:13 (17 years ago)
Author:
piso
Message:

Converted remaining switch-dispatched primitives.

File:
1 edited

Legend:

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

    r5018 r5019  
    33 *
    44 * Copyright (C) 2002-2003 Peter Graves
    5  * $Id: Primitives.java,v 1.518 2003-12-08 04:25:04 piso Exp $
     5 * $Id: Primitives.java,v 1.519 2003-12-08 04:49:13 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2828import java.util.Random;
    2929
    30 public final class Primitives extends Module
     30public final class Primitives extends Lisp
    3131{
    32     // Primitive1
    33     private static final int ABS                        = 1;
    34     private static final int ARRAYP                     = 2;
    35     private static final int ARRAY_HAS_FILL_POINTER_P   = 3;
    36     private static final int BIT_VECTOR_P               = 4;
    37     private static final int COMPILED_FUNCTION_P        = 5;
    38     private static final int CONSP                      = 6;
    39     private static final int EVAL                       = 7;
    40     private static final int IDENTITY                   = 8;
    41     private static final int LISTP                      = 9;
    42     private static final int SIMPLE_BIT_VECTOR_P        = 10;
    43     private static final int SIMPLE_VECTOR_P            = 11;
    44     private static final int VECTORP                    = 12;
    45 
    46     private Primitives()
    47     {
    48         definePrimitive1("abs", ABS);
    49         definePrimitive1("array-has-fill-pointer-p", ARRAY_HAS_FILL_POINTER_P);
    50         definePrimitive1("arrayp", ARRAYP);
    51         definePrimitive1("bit-vector-p", BIT_VECTOR_P);
    52         definePrimitive1("compiled-function-p", COMPILED_FUNCTION_P);
    53         definePrimitive1("consp", CONSP);
    54         definePrimitive1("eval", EVAL);
    55         definePrimitive1("identity", IDENTITY);
    56         definePrimitive1("listp", LISTP);
    57         definePrimitive1("simple-bit-vector-p", SIMPLE_BIT_VECTOR_P);
    58         definePrimitive1("simple-vector-p", SIMPLE_VECTOR_P);
    59         definePrimitive1("vectorp", VECTORP);
    60     }
    61 
    62     // Primitive1
    63     public LispObject dispatch(LispObject arg, int index)
    64         throws ConditionThrowable
    65     {
    66         switch (index) {
    67             case IDENTITY:                      // ### identity
    68                 return arg;
    69             case COMPILED_FUNCTION_P:           // ### compiled-function-p
    70                 return arg.typep(Symbol.COMPILED_FUNCTION);
    71             case CONSP:                         // ### consp
    72                 return arg instanceof Cons ? T : NIL;
    73             case LISTP:                         // ### listp
    74                 return arg.LISTP();
    75             case ABS:                           // ### abs
    76                 return arg.ABS();
    77             case ARRAYP:                        // ### arrayp
    78                 return arg instanceof AbstractArray ? T : NIL;
    79             case ARRAY_HAS_FILL_POINTER_P:      // ### array-has-fill-pointer-p
    80                 if (arg instanceof AbstractVector)
    81                     return ((AbstractVector)arg).getFillPointer() >= 0 ? T : NIL;
    82                 if (arg instanceof AbstractArray)
    83                     return NIL;
    84                 throw new ConditionThrowable(new TypeError(arg, "array"));
    85             case VECTORP:                       // ### vectorp
    86                 return arg.VECTORP();
    87             case SIMPLE_VECTOR_P:               // ### simple-vector-p
    88                 return arg.typep(Symbol.SIMPLE_VECTOR);
    89             case BIT_VECTOR_P:                  // ### bit-vector-p
    90                 return arg.BIT_VECTOR_P();
    91             case SIMPLE_BIT_VECTOR_P:           // ### simple-bit-vector-p
    92                 return arg.typep(Symbol.SIMPLE_BIT_VECTOR);
    93             case EVAL:                          // ### eval
    94                 return eval(arg, new Environment(), LispThread.currentThread());
    95             default:
    96                 Debug.trace("bad index " + index);
    97                 throw new ConditionThrowable(new WrongNumberOfArgumentsException((String)null));
    98         }
    99     }
    100 
    10132    // ### *
    10233    public static final Primitive MULTIPLY = new Primitive("*")
     
    201132            }
    202133            return result;
     134        }
     135    };
     136
     137    // ### identity
     138    private static final Primitive1 IDENTITY = new Primitive1("identity")
     139    {
     140        public LispObject execute(LispObject arg) throws ConditionThrowable
     141        {
     142            return arg;
     143        }
     144    };
     145
     146    // ### compiled-function-p
     147    private static final Primitive1 COMPILED_FUNCTION_P =
     148        new Primitive1("compiled-function-p")
     149    {
     150        public LispObject execute(LispObject arg) throws ConditionThrowable
     151        {
     152            return arg.typep(Symbol.COMPILED_FUNCTION);
     153        }
     154    };
     155
     156    // ### consp
     157    private static final Primitive1 CONSP = new Primitive1("consp")
     158    {
     159        public LispObject execute(LispObject arg) throws ConditionThrowable
     160        {
     161            return arg instanceof Cons ? T : NIL;
     162        }
     163    };
     164
     165    // ### listp
     166    private static final Primitive1 LISTP = new Primitive1("listp")
     167    {
     168        public LispObject execute(LispObject arg) throws ConditionThrowable
     169        {
     170            return arg.LISTP();
     171        }
     172    };
     173
     174    // ### abs
     175    private static final Primitive1 ABS = new Primitive1("abs")
     176    {
     177        public LispObject execute(LispObject arg) throws ConditionThrowable
     178        {
     179            return arg.ABS();
     180        }
     181    };
     182
     183    // ### arrayp
     184    private static final Primitive1 ARRAYP = new Primitive1("arrayp")
     185    {
     186        public LispObject execute(LispObject arg) throws ConditionThrowable
     187        {
     188            return arg instanceof AbstractArray ? T : NIL;
     189        }
     190    };
     191
     192    // ### array-has-fill-pointer-p
     193    private static final Primitive1 ARRAY_HAS_FILL_POINTER_P =
     194        new Primitive1("array-has-fill-pointer-p")
     195    {
     196        public LispObject execute(LispObject arg) throws ConditionThrowable
     197        {
     198            if (arg instanceof AbstractVector)
     199                return ((AbstractVector)arg).getFillPointer() >= 0 ? T : NIL;
     200            if (arg instanceof AbstractArray)
     201                return NIL;
     202            throw new ConditionThrowable(new TypeError(arg, "array"));
     203        }
     204    };
     205
     206    // ### vectorp
     207    private static final Primitive1 VECTORP = new Primitive1("vectorp")
     208    {
     209        public LispObject execute(LispObject arg) throws ConditionThrowable
     210        {
     211            return arg.VECTORP();
     212        }
     213    };
     214
     215    // ### simple-vector-p
     216    private static final Primitive1 SIMPLE_VECTOR_P =
     217        new Primitive1("simple-vector-p")
     218    {
     219        public LispObject execute(LispObject arg) throws ConditionThrowable
     220        {
     221            return arg.typep(Symbol.SIMPLE_VECTOR);
     222        }
     223    };
     224
     225    // ### bit-vector-p
     226    private static final Primitive1 BIT_VECTOR_P =
     227        new Primitive1("bit-vector-p")
     228    {
     229        public LispObject execute(LispObject arg) throws ConditionThrowable
     230        {
     231            return arg.BIT_VECTOR_P();
     232        }
     233    };
     234
     235    // ### simple-bit-vector-p
     236    private static final Primitive1 SIMPLE_BIT_VECTOR_P =
     237        new Primitive1("simple-bit-vector-p")
     238    {
     239        public LispObject execute(LispObject arg) throws ConditionThrowable
     240        {
     241            return arg.typep(Symbol.SIMPLE_BIT_VECTOR);
     242        }
     243    };
     244
     245    // ### eval
     246    private static final Primitive1 EVAL = new Primitive1("eval")
     247    {
     248        public LispObject execute(LispObject arg) throws ConditionThrowable
     249        {
     250            return eval(arg, new Environment(), LispThread.currentThread());
    203251        }
    204252    };
Note: See TracChangeset for help on using the changeset viewer.