001: /*
002: * GenericFunction.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: GenericFunction.java,v 1.6 2003/11/15 11:03:32 beedlem Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: public final class GenericFunction extends StandardObject {
025: private LispObject discriminatingFunction;
026:
027: public GenericFunction(LispClass cls, LispObject slots) {
028: super (cls, slots);
029: }
030:
031: public LispObject getDiscriminatingFunction() {
032: return discriminatingFunction;
033: }
034:
035: public void setDiscriminatingFunction(LispObject function) {
036: discriminatingFunction = function;
037: }
038:
039: public LispObject execute() throws ConditionThrowable {
040: LispObject[] args = new LispObject[0];
041: return execute(args);
042: }
043:
044: public LispObject execute(LispObject arg) throws ConditionThrowable {
045: LispObject[] args = new LispObject[1];
046: args[0] = arg;
047: return execute(args);
048: }
049:
050: public LispObject execute(LispObject first, LispObject second)
051: throws ConditionThrowable {
052: LispObject[] args = new LispObject[2];
053: args[0] = first;
054: args[1] = second;
055: return execute(args);
056: }
057:
058: public LispObject execute(LispObject first, LispObject second,
059: LispObject third) throws ConditionThrowable {
060: LispObject[] args = new LispObject[3];
061: args[0] = first;
062: args[1] = second;
063: args[2] = third;
064: return execute(args);
065: }
066:
067: public LispObject execute(LispObject[] args)
068: throws ConditionThrowable {
069: return funcall(getDiscriminatingFunction(), args, LispThread
070: .currentThread());
071: }
072:
073: public String toString() {
074: LispObject slots = getSlots();
075: if (slots instanceof AbstractVector) {
076: AbstractVector v = (AbstractVector) slots;
077: try {
078: if (v.length() > 0) {
079: LispObject name = v.get(0);
080: if (name != null) {
081: StringBuffer sb = new StringBuffer("#<");
082: sb.append(String.valueOf(getLispClass()
083: .getSymbol()));
084: sb.append(' ');
085: sb.append(String.valueOf(name));
086: sb.append('>');
087: return sb.toString();
088: }
089: }
090: } catch (Throwable t) {
091: Debug.trace(t);
092: }
093: }
094: return super .toString();
095: }
096:
097: private static final Primitive1 GENERIC_FUNCTION_DISCRIMINATING_FUNCTION = new Primitive1(
098: "generic-function-discriminating-function", PACKAGE_SYS,
099: false) {
100: public LispObject execute(LispObject arg)
101: throws ConditionThrowable {
102: if (arg instanceof GenericFunction)
103: return ((GenericFunction) arg)
104: .getDiscriminatingFunction();
105: throw new ConditionThrowable(new TypeError(arg,
106: "generic function"));
107: }
108: };
109:
110: private static final Primitive1 _SET_GENERIC_FUNCTION_DISCRIMINATING_FUNCTION = new Primitive1(
111: "%set-generic-function-discriminating-function",
112: PACKAGE_SYS, false) {
113: public LispObject execute(LispObject first, LispObject second)
114: throws ConditionThrowable {
115: if (first instanceof GenericFunction) {
116: ((GenericFunction) first)
117: .setDiscriminatingFunction(second);
118: return second;
119: }
120: throw new ConditionThrowable(new TypeError(first,
121: "generic function"));
122: }
123: };
124: }
|