Changeset 4166


Ignore:
Timestamp:
10/01/03 23:04:27 (19 years ago)
Author:
piso
Message:

FBOUNDP

File:
1 edited

Legend:

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

    r4165 r4166  
    33 *
    44 * Copyright (C) 2002-2003 Peter Graves
    5  * $Id: Primitives.java,v 1.457 2003-10-01 22:56:43 piso Exp $
     5 * $Id: Primitives.java,v 1.458 2003-10-01 23:04:27 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    5454    private static final int EVAL                       = 20;
    5555    private static final int EVENP                      = 21;
    56     private static final int FBOUNDP                    = 22;
    57     private static final int FMAKUNBOUND                = 23;
    58     private static final int FOURTH                     = 24;
    59     private static final int FUNCTIONP                  = 25;
    60     private static final int IDENTITY                   = 26;
    61     private static final int KEYWORDP                   = 27;
    62     private static final int LENGTH                     = 28;
    63     private static final int LISTP                      = 29;
    64     private static final int LOWER_CASE_P               = 30;
    65     private static final int MAKE_SYMBOL                = 31;
    66     private static final int MAKUNBOUND                 = 32;
    67     private static final int NUMBERP                    = 33;
    68     private static final int ODDP                       = 34;
    69     private static final int PREDECESSOR                = 35;
    70     private static final int SECOND                     = 36;
    71     private static final int SIMPLE_BIT_VECTOR_P        = 37;
    72     private static final int SIMPLE_STRING_P            = 38;
    73     private static final int SIMPLE_VECTOR_P            = 39;
    74     private static final int SPECIAL_OPERATOR_P         = 40;
    75     private static final int STRINGP                    = 41;
    76     private static final int SUCCESSOR                  = 42;
    77     private static final int SYMBOL_FUNCTION            = 43;
    78     private static final int SYMBOL_NAME                = 44;
    79     private static final int SYMBOL_PACKAGE             = 45;
    80     private static final int SYMBOL_PLIST               = 46;
    81     private static final int SYMBOL_VALUE               = 47;
    82     private static final int THIRD                      = 48;
    83     private static final int UPPER_CASE_P               = 49;
    84     private static final int VALUES_LIST                = 50;
    85     private static final int VECTORP                    = 51;
     56    private static final int FMAKUNBOUND                = 22;
     57    private static final int FOURTH                     = 23;
     58    private static final int FUNCTIONP                  = 24;
     59    private static final int IDENTITY                   = 25;
     60    private static final int KEYWORDP                   = 26;
     61    private static final int LENGTH                     = 27;
     62    private static final int LISTP                      = 28;
     63    private static final int LOWER_CASE_P               = 29;
     64    private static final int MAKE_SYMBOL                = 30;
     65    private static final int MAKUNBOUND                 = 31;
     66    private static final int NUMBERP                    = 32;
     67    private static final int ODDP                       = 33;
     68    private static final int PREDECESSOR                = 34;
     69    private static final int SECOND                     = 35;
     70    private static final int SIMPLE_BIT_VECTOR_P        = 36;
     71    private static final int SIMPLE_STRING_P            = 37;
     72    private static final int SIMPLE_VECTOR_P            = 38;
     73    private static final int SPECIAL_OPERATOR_P         = 39;
     74    private static final int STRINGP                    = 40;
     75    private static final int SUCCESSOR                  = 41;
     76    private static final int SYMBOL_FUNCTION            = 42;
     77    private static final int SYMBOL_NAME                = 43;
     78    private static final int SYMBOL_PACKAGE             = 44;
     79    private static final int SYMBOL_PLIST               = 45;
     80    private static final int SYMBOL_VALUE               = 46;
     81    private static final int THIRD                      = 47;
     82    private static final int UPPER_CASE_P               = 48;
     83    private static final int VALUES_LIST                = 49;
     84    private static final int VECTORP                    = 50;
    8685
    8786    // Primitive2
    88     private static final int MEMBER                     = 52;
    89     private static final int RPLACA                     = 53;
    90     private static final int RPLACD                     = 54;
    91     private static final int SET                        = 55;
     87    private static final int MEMBER                     = 51;
     88    private static final int RPLACA                     = 52;
     89    private static final int RPLACD                     = 53;
     90    private static final int SET                        = 54;
    9291
    9392    private Primitives()
     
    117116        definePrimitive1("eval", EVAL);
    118117        definePrimitive1("evenp", EVENP);
    119         definePrimitive1("fboundp", FBOUNDP);
    120118        definePrimitive1("fmakunbound", FMAKUNBOUND);
    121119        definePrimitive1("fourth", FOURTH);
     
    247245            case MAKE_SYMBOL:                   // ### make-symbol
    248246                return new Symbol(LispString.getValue(arg));
    249             case FBOUNDP:                       // ### fboundp
    250                 return arg.getSymbolFunction() != null ? T : NIL;
    251247            case MAKUNBOUND:                    // ### makunbound
    252248                checkSymbol(arg).setSymbolValue(null);
     
    735731                return T;
    736732            return symbol.getSymbolValue() != null ? T : NIL;
     733        }
     734    };
     735
     736    // ### fboundp
     737    private static final Primitive1 FBOUNDP = new Primitive1("fboundp")
     738    {
     739        public LispObject execute(LispObject arg) throws ConditionThrowable
     740        {
     741            if (arg instanceof Symbol)
     742                return arg.getSymbolFunction() != null ? T : NIL;
     743            if (arg instanceof Cons && arg.car() == Symbol.SETF) {
     744                LispObject f = get(checkSymbol(arg.cadr()),
     745                                   PACKAGE_SYS.intern("SETF-FUNCTION"));
     746                return f != null ? T : NIL;
     747            }
     748            throw new ConditionThrowable(new TypeError(arg, "valid function name"));
    737749        }
    738750    };
Note: See TracChangeset for help on using the changeset viewer.