source: branches/1.0.x/abcl/src/org/armedbear/lisp/StandardMethod.java

Last change on this file was 13541, checked in by Mark Evenson, 14 years ago

Convert docstrings and primitives to standard conventions.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 12.7 KB
Line 
1/*
2 * StandardMethod.java
3 *
4 * Copyright (C) 2005 Peter Graves
5 * $Id: StandardMethod.java 13541 2011-08-27 23:23:24Z mevenson $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37
38public class StandardMethod extends StandardObject
39{
40  public StandardMethod()
41  {
42    super(StandardClass.STANDARD_METHOD,
43          StandardClass.STANDARD_METHOD.getClassLayout().getLength());
44  }
45
46  protected StandardMethod(LispClass cls, int length)
47  {
48    super(cls, length);
49  }
50
51  public StandardMethod(StandardGenericFunction gf,
52                        Function fastFunction,
53                        LispObject lambdaList,
54                        LispObject specializers)
55  {
56    this();
57    slots[StandardMethodClass.SLOT_INDEX_GENERIC_FUNCTION] = gf;
58    slots[StandardMethodClass.SLOT_INDEX_LAMBDA_LIST] = lambdaList;
59    slots[StandardMethodClass.SLOT_INDEX_SPECIALIZERS] = specializers;
60    slots[StandardMethodClass.SLOT_INDEX_QUALIFIERS] = NIL;
61    slots[StandardMethodClass.SLOT_INDEX_FUNCTION] = NIL;
62    slots[StandardMethodClass.SLOT_INDEX_FAST_FUNCTION] = fastFunction;
63    slots[StandardMethodClass.SLOT_INDEX_DOCUMENTATION] = NIL;
64  }
65
66  private static final Primitive METHOD_LAMBDA_LIST
67    = new pf_method_lambda_list(); 
68  @DocString(name="method-lambda-list",
69             args="generic-method")
70  private static final class pf_method_lambda_list extends Primitive
71  {
72    pf_method_lambda_list()
73    {
74      super("method-lambda-list", PACKAGE_SYS, true, "generic-method");
75    }
76    @Override
77    public LispObject execute(LispObject arg)
78    {
79      return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_LAMBDA_LIST];
80    }
81  };
82
83  private static final Primitive SET_METHOD_LAMBDA_LIST
84    = new pf_set_method_lambda_list();
85  @DocString(name="set-method-lambda-list",
86             args="method lambda-list")
87  private static final class pf_set_method_lambda_list extends Primitive
88  {
89    pf_set_method_lambda_list()
90    {
91      super("set-method-lambda-list", PACKAGE_SYS, true,
92            "method lambda-list");
93    }
94    @Override
95    public LispObject execute(LispObject first, LispObject second)
96    {
97      checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_LAMBDA_LIST] = second;
98      return second;
99    }
100  };
101
102
103  private static final Primitive _METHOD_QUALIFIERS
104    = new gf__method_qualifiers();
105  @DocString(name="%method-qualifiers",
106             args="method")
107  private static final class gf__method_qualifiers extends Primitive
108  {
109    gf__method_qualifiers()
110    {
111      super("%method-qualifiers", PACKAGE_SYS, true, "method");
112    }
113    @Override
114    public LispObject execute(LispObject arg)
115    {
116      return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_QUALIFIERS];
117    }
118  };
119
120  private static final Primitive SET_METHOD_QUALIFIERS
121    = new pf_set_method_qualifiers();
122  @DocString(name="set-method-qualifiers",
123             args="method qualifiers")
124  private static final class pf_set_method_qualifiers extends Primitive
125  {
126    pf_set_method_qualifiers()
127    {
128      super("set-method-qualifiers", PACKAGE_SYS, true,
129            "method qualifiers");
130    }
131    @Override
132    public LispObject execute(LispObject first, LispObject second)
133    {         
134      checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_QUALIFIERS] = second;
135      return second;
136    }
137  };
138
139  private static final Primitive METHOD_DOCUMENTATION
140    = new pf_method_documentation(); 
141  @DocString(name="method-documentation",
142             args="method")
143  private static final class pf_method_documentation extends Primitive
144  {
145    pf_method_documentation()
146    {
147      super("method-documentation", PACKAGE_SYS, true, "method");
148    }
149    @Override
150    public LispObject execute(LispObject arg)
151    {
152      return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_DOCUMENTATION];
153    }
154  };
155
156  private static final Primitive SET_METHOD_DOCUMENTATION
157    = new pf_set_method_documentation();
158  @DocString(name="set-method-documentation",
159             args="method documentation")
160  private static final class pf_set_method_documentation extends Primitive
161  {
162    pf_set_method_documentation()
163    {
164      super("set-method-documentation", PACKAGE_SYS, true,
165            "method documentation");
166    }
167    @Override
168    public LispObject execute(LispObject first, LispObject second)
169    {
170      checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_DOCUMENTATION] = second;
171      return second;
172    }
173  };
174
175  public LispObject getFunction()
176  {
177    return slots[StandardMethodClass.SLOT_INDEX_FUNCTION];
178  }
179
180  @Override
181  public String printObject()
182  {
183    LispObject genericFunction =
184      slots[StandardMethodClass.SLOT_INDEX_GENERIC_FUNCTION];
185    if (genericFunction instanceof StandardGenericFunction)
186      {
187        LispObject name =
188          ((StandardGenericFunction)genericFunction).getGenericFunctionName();
189        if (name != null)
190          {
191            StringBuilder sb = new StringBuilder();
192            LispObject className;
193            LispObject lispClass = getLispClass();
194            if (lispClass instanceof LispClass)
195              className = ((LispClass)lispClass).getName();
196            else
197              className = Symbol.CLASS_NAME.execute(lispClass);
198
199            sb.append(className.printObject());
200            sb.append(' ');
201            sb.append(name.printObject());
202            LispObject specializers =
203              slots[StandardMethodClass.SLOT_INDEX_SPECIALIZERS];
204            if (specializers != null)
205              {
206                LispObject specs = specializers;
207                LispObject names = NIL;
208                while (specs != NIL)
209                  {
210                    LispObject spec = specs.car();
211                    if (spec instanceof LispClass)
212                      names = names.push(((LispClass)spec).getName());
213                    else
214                      names = names.push(spec);
215                    specs = specs.cdr();
216                  }
217                sb.append(' ');
218                sb.append(names.nreverse().printObject());
219              }
220            return unreadableString(sb.toString());
221          }
222      }
223    return super.printObject();
224  }
225
226  private static final Primitive _METHOD_GENERIC_FUNCTION
227    = new pf__method_generic_function();
228  @DocString(name="%method-generic-function")
229  private static final class pf__method_generic_function extends Primitive
230  {
231    pf__method_generic_function()
232    {
233      super("%method-generic-function", PACKAGE_SYS, true);
234    }
235    @Override
236    public LispObject execute(LispObject arg)
237    {
238      return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_GENERIC_FUNCTION];
239    }
240  };
241
242  private static final Primitive _SET_METHOD_GENERICFUNCTION
243    = new pf__set_method_genericfunction();
244  @DocString(name="%set-method-generic-function")
245  private static final class pf__set_method_genericfunction extends Primitive
246  {
247    pf__set_method_genericfunction()
248    {
249      super("%set-method-generic-function", PACKAGE_SYS, true);
250    }
251    @Override
252    public LispObject execute(LispObject first, LispObject second)
253    {
254      checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_GENERIC_FUNCTION] = second;
255      return second;
256    }
257  };
258
259  private static final Primitive _METHOD_FUNCTION
260    = new pf__method_function(); 
261  @DocString(name="%method-function")
262  private static final class pf__method_function extends Primitive
263  {
264    pf__method_function()
265    {
266      super("%method-function", PACKAGE_SYS, true, "method");
267    }
268    @Override
269    public LispObject execute(LispObject arg)
270    {
271          return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_FUNCTION];
272    }
273  };
274
275  private static final Primitive _SET_METHOD_FUNCTION
276    = new pf__set_method_function();
277  @DocString(name="%set-method-function",
278             args="method function")
279  private static final class pf__set_method_function extends Primitive
280  {
281    pf__set_method_function()
282    {
283      super("%set-method-function", PACKAGE_SYS, true,
284            "method function");
285    }
286    @Override
287    public LispObject execute(LispObject first, LispObject second)
288    {
289      checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_FUNCTION] = second;
290      return second;
291    }
292  };
293
294  private static final Primitive _METHOD_FAST_FUNCTION
295    = new pf__method_fast_function();
296  @DocString(name="%method-fast-function",
297             args="method")
298  private static final class pf__method_fast_function extends Primitive
299  {
300    pf__method_fast_function()
301    {
302      super("%method-fast-function", PACKAGE_SYS, true, "method");
303    }
304    @Override
305    public LispObject execute(LispObject arg)
306    {
307      return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_FAST_FUNCTION];
308    }
309  };
310
311  private static final Primitive _SET_METHOD_FAST_FUNCTION
312    = new pf__set_method_fast_function();
313  @DocString(name="%set-method-fast-function",
314             args="method fast-function")
315  private static final class pf__set_method_fast_function extends Primitive
316  {
317    pf__set_method_fast_function()
318    {
319      super("%set-method-fast-function", PACKAGE_SYS, true,
320            "method fast-function");
321    }
322    @Override
323    public LispObject execute(LispObject first, LispObject second)
324    {
325      checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_FAST_FUNCTION] = second;
326      return second;
327    }
328  };
329
330  private static final Primitive _METHOD_SPECIALIZERS
331    = new pf__method_specializers();
332  @DocString(name="%method-specializers")
333  private static final class pf__method_specializers extends Primitive
334  {
335    pf__method_specializers()
336    {
337      super("%method-specializers", PACKAGE_SYS, true, "method");
338    }
339    @Override
340    public LispObject execute(LispObject arg)
341    {
342      return checkStandardMethod(arg).slots[StandardMethodClass.SLOT_INDEX_SPECIALIZERS];
343    }
344  };
345
346  private static final Primitive _SET_METHOD_SPECIALIZERS
347    = new pf__set_method_specializers();
348  @DocString(name="%set-method-specializers",
349             args="method specializers")
350  private static final class pf__set_method_specializers extends Primitive
351  {
352    pf__set_method_specializers()
353    {
354      super("%set-method-specializers", PACKAGE_SYS, true,
355            "method specializers");
356    }
357    @Override
358    public LispObject execute(LispObject first, LispObject second)
359    {
360      checkStandardMethod(first).slots[StandardMethodClass.SLOT_INDEX_SPECIALIZERS] = second;
361      return second;
362    }
363  };
364
365  private static final StandardGenericFunction METHOD_SPECIALIZERS =
366    new StandardGenericFunction("method-specializers",
367                                PACKAGE_MOP,
368                                true,
369                                _METHOD_SPECIALIZERS,
370                                list(Symbol.METHOD),
371                                list(StandardClass.STANDARD_METHOD));
372
373  private static final StandardGenericFunction METHOD_QUALIFIERS =
374    new StandardGenericFunction("method-qualifiers",
375                                PACKAGE_MOP,
376                                true,
377                                _METHOD_QUALIFIERS,
378                                list(Symbol.METHOD),
379                                list(StandardClass.STANDARD_METHOD));
380
381  final public static StandardMethod checkStandardMethod(LispObject first)
382  {
383    if (first instanceof StandardMethod)
384      return (StandardMethod) first;
385    return (StandardMethod) type_error(first, Symbol.METHOD);
386  }
387}
Note: See TracBrowser for help on using the repository browser.