source: branches/0.26.x/abcl/src/org/armedbear/lisp/StandardClass.java

Last change on this file was 13273, checked in by astalla, 14 years ago

Correct support for custom slots definitions in MOP:

  • class hierarchy for slot definitions as specified by AMOP (except the METAOBJECT superclass)
  • above class hierarchy is extensible by users
  • custom slot options are not evaluated
  • compute-effective-slot-definition lambda list updated to take NAME argument (2nd)
  • a few more symbols exported from the MOP package

There are no new ANSI tests failures caused by these changes on my machine.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 31.8 KB
Line 
1/*
2 * StandardClass.java
3 *
4 * Copyright (C) 2003-2005 Peter Graves
5 * $Id: StandardClass.java 13273 2011-05-01 22:34:47Z astalla $
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 StandardClass extends SlotClass
39{
40
41  public static Symbol symName = PACKAGE_MOP.intern("NAME");
42  public static Symbol symLayout = PACKAGE_MOP.intern("LAYOUT");
43  public static Symbol symDirectSuperclasses
44    = PACKAGE_MOP.intern("DIRECT-SUPERCLASSES");
45  public static Symbol symDirectSubclasses
46    = PACKAGE_MOP.intern("DIRECT-SUBCLASSES");
47  public static Symbol symPrecedenceList
48    = PACKAGE_MOP.intern("PRECEDENCE-LIST");
49  public static Symbol symDirectMethods
50    = PACKAGE_MOP.intern("DIRECT-METHODS");
51  public static Symbol symDocumentation
52    = PACKAGE_MOP.intern("DOCUMENTATION");
53  public static Symbol symDirectSlots
54    = PACKAGE_MOP.intern("DIRECT-SLOTS");
55  public static Symbol symSlots
56    = PACKAGE_MOP.intern("SLOTS");
57  public static Symbol symDirectDefaultInitargs
58    = PACKAGE_MOP.intern("DIRECT-DEFAULT-INITARGS");
59  public static Symbol symDefaultInitargs
60    = PACKAGE_MOP.intern("DEFAULT-INITARGS");
61  public static Symbol symFinalizedP
62    = PACKAGE_MOP.intern("FINALIZED-P");
63
64  static Layout layoutStandardClass =
65      new Layout(null,
66                 list(symName,
67                      symLayout,
68                      symDirectSuperclasses,
69                      symDirectSubclasses,
70                      symPrecedenceList,
71                      symDirectMethods,
72                      symDirectSlots,
73                      symSlots,
74                      symDirectDefaultInitargs,
75                      symDefaultInitargs,
76                      symFinalizedP,
77                      symDocumentation),
78                 NIL)
79      {
80        @Override
81        public LispClass getLispClass()
82        {
83          return STANDARD_CLASS;
84        }
85      };
86
87  public StandardClass()
88  {
89      super(layoutStandardClass);
90      setDirectSuperclasses(NIL);
91      setDirectSubclasses(NIL);
92      setClassLayout(layoutStandardClass);
93      setCPL(NIL);
94      setDirectMethods(NIL);
95      setDocumentation(NIL);
96      setDirectSlotDefinitions(NIL);
97      setSlotDefinitions(NIL);
98      setDirectDefaultInitargs(NIL);
99      setDefaultInitargs(NIL);
100      setFinalized(false);
101  }
102
103  public StandardClass(Symbol symbol, LispObject directSuperclasses)
104  {
105      super(layoutStandardClass,
106            symbol, directSuperclasses);
107      setDirectSubclasses(NIL);
108      setClassLayout(layoutStandardClass);
109      setCPL(NIL);
110      setDirectMethods(NIL);
111      setDocumentation(NIL);
112      setDirectSlotDefinitions(NIL);
113      setSlotDefinitions(NIL);
114      setDirectDefaultInitargs(NIL);
115      setDefaultInitargs(NIL);
116      setFinalized(false);
117  }
118
119  @Override
120  public LispObject getName()
121  {
122    return getInstanceSlotValue(symName);
123  }
124
125  @Override
126  public void setName(LispObject newName)
127  {
128    setInstanceSlotValue(symName, newName);
129  }
130
131  @Override
132  public Layout getClassLayout()
133  {
134    LispObject layout = getInstanceSlotValue(symLayout);
135    if (layout == UNBOUND_VALUE)
136        return null;
137
138    if (! (layout instanceof Layout)) {
139        (new Error()).printStackTrace();
140        LispThread.currentThread().printBacktrace();
141        return (Layout)Lisp.error(Symbol.TYPE_ERROR,
142                new SimpleString("The value " + layout.writeToString()
143                    + " is not of expected type " + Symbol.LAYOUT.writeToString()
144                    + " in class " + this.writeToString() + "."));
145      }
146   
147    return (layout == UNBOUND_VALUE) ? null : (Layout)layout;
148  }
149
150  @Override
151  public void setClassLayout(LispObject newLayout)
152  {
153    setInstanceSlotValue(symLayout, newLayout);
154  }
155
156  @Override
157  public LispObject getDirectSuperclasses()
158  {
159    return getInstanceSlotValue(symDirectSuperclasses);
160  }
161
162  @Override
163  public void setDirectSuperclasses(LispObject directSuperclasses)
164  {
165    setInstanceSlotValue(symDirectSuperclasses, directSuperclasses);
166  }
167
168  @Override
169  public final boolean isFinalized()
170  {
171    return getInstanceSlotValue(symFinalizedP) != NIL;
172  }
173
174  @Override
175  public final void setFinalized(boolean b)
176  {
177    setInstanceSlotValue(symFinalizedP, b ? T : NIL);
178  }
179
180  @Override
181  public LispObject getDirectSubclasses()
182  {
183    return getInstanceSlotValue(symDirectSubclasses);
184  }
185
186  @Override
187  public void setDirectSubclasses(LispObject directSubclasses)
188  {
189    setInstanceSlotValue(symDirectSubclasses, directSubclasses);
190  }
191
192  @Override
193  public LispObject getCPL()
194  {
195    return getInstanceSlotValue(symPrecedenceList);
196  }
197
198  @Override
199  public void setCPL(LispObject... cpl)
200  {
201    LispObject obj1 = cpl[0];
202    if (obj1.listp() && cpl.length == 1)
203      setInstanceSlotValue(symPrecedenceList, obj1);
204    else
205      {
206        Debug.assertTrue(obj1 == this);
207        LispObject l = NIL;
208        for (int i = cpl.length; i-- > 0;)
209            l = new Cons(cpl[i], l);
210        setInstanceSlotValue(symPrecedenceList, l);
211      }
212  }
213
214  @Override
215  public LispObject getDirectMethods()
216  {
217    return getInstanceSlotValue(symDirectMethods);
218  }
219
220  @Override
221  public void setDirectMethods(LispObject methods)
222  {
223    setInstanceSlotValue(symDirectMethods, methods);
224  }
225
226  @Override
227  public LispObject getDocumentation()
228  {
229    return getInstanceSlotValue(symDocumentation);
230  }
231
232  @Override
233  public void setDocumentation(LispObject doc)
234  {
235    setInstanceSlotValue(symDocumentation, doc);
236  }
237
238  @Override
239  public LispObject getDirectSlotDefinitions()
240  {
241    return getInstanceSlotValue(symDirectSlots);
242  }
243
244  @Override
245  public void setDirectSlotDefinitions(LispObject directSlotDefinitions)
246  {
247    setInstanceSlotValue(symDirectSlots, directSlotDefinitions);
248  }
249
250  @Override
251  public LispObject getSlotDefinitions()
252  {
253    return getInstanceSlotValue(symSlots);
254  }
255
256  @Override
257  public void setSlotDefinitions(LispObject slotDefinitions)
258  {
259     setInstanceSlotValue(symSlots, slotDefinitions);
260  }
261
262  @Override
263  public LispObject getDirectDefaultInitargs()
264  {
265    return getInstanceSlotValue(symDirectDefaultInitargs);
266  }
267
268  @Override
269  public void setDirectDefaultInitargs(LispObject directDefaultInitargs)
270  {
271    setInstanceSlotValue(symDirectDefaultInitargs, directDefaultInitargs);
272  }
273
274  @Override
275  public LispObject getDefaultInitargs()
276  {
277    return getInstanceSlotValue(symDefaultInitargs);
278  }
279
280  @Override
281  public void setDefaultInitargs(LispObject defaultInitargs)
282  {
283    setInstanceSlotValue(symDefaultInitargs, defaultInitargs);
284  }
285
286  @Override
287  public LispObject typeOf()
288  {
289    return Symbol.STANDARD_CLASS;
290  }
291
292  @Override
293  public LispObject classOf()
294  {
295    return STANDARD_CLASS;
296  }
297
298  @Override
299  public LispObject typep(LispObject type)
300  {
301    if (type == Symbol.STANDARD_CLASS)
302      return T;
303    if (type == STANDARD_CLASS)
304      return T;
305    return super.typep(type);
306  }
307
308  public LispObject allocateInstance()
309  {
310    Layout layout = getClassLayout();
311    if (layout == null)
312      {
313        Symbol.ERROR.execute(Symbol.SIMPLE_ERROR,
314                             Keyword.FORMAT_CONTROL,
315                             new SimpleString("No layout for class ~S."),
316                             Keyword.FORMAT_ARGUMENTS,
317                             list(this));
318      }
319    return new StandardObject(this, layout.getLength());
320  }
321
322  @Override
323  public String writeToString()
324  {
325    StringBuilder sb =
326      new StringBuilder(Symbol.STANDARD_CLASS.writeToString());
327    if (getName() != null)
328      {
329        sb.append(' ');
330        sb.append(getName().writeToString());
331      }
332    return unreadableString(sb.toString());
333  }
334
335  private static final LispObject standardClassSlotDefinitions()
336  {
337      // (CONSTANTLY NIL)
338    Function initFunction = new Function() {
339      @Override
340      public LispObject execute()
341      {
342         return NIL;
343      }
344    };
345
346    return
347        list(helperMakeSlotDefinition("NAME", initFunction),
348             helperMakeSlotDefinition("LAYOUT", initFunction),
349             helperMakeSlotDefinition("DIRECT-SUPERCLASSES", initFunction),
350             helperMakeSlotDefinition("DIRECT-SUBCLASSES", initFunction),
351             helperMakeSlotDefinition("PRECEDENCE-LIST", initFunction),
352             helperMakeSlotDefinition("DIRECT-METHODS", initFunction),
353             helperMakeSlotDefinition("DIRECT-SLOTS", initFunction),
354             helperMakeSlotDefinition("SLOTS", initFunction),
355             helperMakeSlotDefinition("DIRECT-DEFAULT-INITARGS", initFunction),
356             helperMakeSlotDefinition("DEFAULT-INITARGS", initFunction),
357             helperMakeSlotDefinition("FINALIZED-P", initFunction),
358             helperMakeSlotDefinition("DOCUMENTATION", initFunction));
359  }
360
361
362
363  private static final SlotDefinition helperMakeSlotDefinition(String name,
364                                                               Function init)
365  {
366    return
367        new SlotDefinition(PACKAGE_MOP.intern(name),   // name
368             list(PACKAGE_MOP.intern("CLASS-" + name)), // readers
369             init);
370  }
371
372  private static final StandardClass addStandardClass(Symbol name,
373                                                      LispObject directSuperclasses)
374  {
375    StandardClass c = new StandardClass(name, directSuperclasses);
376    addClass(name, c);
377    return c;
378  }
379
380  // At this point, BuiltInClass.java has not been completely loaded yet, and
381  // BuiltInClass.CLASS_T is null. So we need to call setDirectSuperclass()
382  // for STANDARD_CLASS and STANDARD_OBJECT in initializeStandardClasses()
383  // below.
384  public static final StandardClass STANDARD_CLASS =
385    addStandardClass(Symbol.STANDARD_CLASS, list(BuiltInClass.CLASS_T));
386  public static final StandardClass STANDARD_OBJECT =
387    addStandardClass(Symbol.STANDARD_OBJECT, list(BuiltInClass.CLASS_T));
388
389    public static final StandardClass SLOT_DEFINITION =
390        addStandardClass(Symbol.SLOT_DEFINITION, list(STANDARD_OBJECT));
391    public static final StandardClass STANDARD_SLOT_DEFINITION =
392        addClass(Symbol.STANDARD_SLOT_DEFINITION, new SlotDefinitionClass(Symbol.STANDARD_SLOT_DEFINITION, list(SLOT_DEFINITION)));
393
394  static
395  {
396      SLOT_DEFINITION.finalizeClass();
397
398    STANDARD_CLASS.setClassLayout(layoutStandardClass);
399    STANDARD_CLASS.setDirectSlotDefinitions(standardClassSlotDefinitions());
400  }
401
402    public static final StandardClass DIRECT_SLOT_DEFINITION =
403      addStandardClass(Symbol.DIRECT_SLOT_DEFINITION, list(SLOT_DEFINITION));
404    public static final StandardClass EFFECTIVE_SLOT_DEFINITION =
405        addStandardClass(Symbol.EFFECTIVE_SLOT_DEFINITION, list(SLOT_DEFINITION));
406    //      addStandardClass(Symbol.STANDARD_SLOT_DEFINITION, list(SLOT_DEFINITION));
407    public static final StandardClass STANDARD_DIRECT_SLOT_DEFINITION =
408        addClass(Symbol.STANDARD_DIRECT_SLOT_DEFINITION,
409                 new SlotDefinitionClass(Symbol.STANDARD_DIRECT_SLOT_DEFINITION,
410                                         list(STANDARD_SLOT_DEFINITION, DIRECT_SLOT_DEFINITION)));
411    public static final StandardClass STANDARD_EFFECTIVE_SLOT_DEFINITION =
412        addClass(Symbol.STANDARD_EFFECTIVE_SLOT_DEFINITION,
413                 new SlotDefinitionClass(Symbol.STANDARD_EFFECTIVE_SLOT_DEFINITION,
414                                         list(STANDARD_SLOT_DEFINITION, EFFECTIVE_SLOT_DEFINITION)));
415
416
417  // BuiltInClass.FUNCTION is also null here (see previous comment).
418  public static final StandardClass GENERIC_FUNCTION =
419    addStandardClass(Symbol.GENERIC_FUNCTION, list(BuiltInClass.FUNCTION,
420                                                    STANDARD_OBJECT));
421
422  public static final StandardClass CLASS =
423    addStandardClass(Symbol.CLASS, list(STANDARD_OBJECT));
424
425  public static final StandardClass BUILT_IN_CLASS =
426    addStandardClass(Symbol.BUILT_IN_CLASS, list(CLASS));
427
428  public static final StandardClass FORWARD_REFERENCED_CLASS =
429    addStandardClass(Symbol.FORWARD_REFERENCED_CLASS, list(CLASS));
430
431  public static final StandardClass STRUCTURE_CLASS =
432    addStandardClass(Symbol.STRUCTURE_CLASS, list(CLASS));
433
434  public static final StandardClass CONDITION =
435    addStandardClass(Symbol.CONDITION, list(STANDARD_OBJECT));
436
437  public static final StandardClass SIMPLE_CONDITION =
438    addStandardClass(Symbol.SIMPLE_CONDITION, list(CONDITION));
439
440  public static final StandardClass WARNING =
441    addStandardClass(Symbol.WARNING, list(CONDITION));
442
443  public static final StandardClass SIMPLE_WARNING =
444    addStandardClass(Symbol.SIMPLE_WARNING, list(SIMPLE_CONDITION, WARNING));
445
446  public static final StandardClass STYLE_WARNING =
447    addStandardClass(Symbol.STYLE_WARNING, list(WARNING));
448
449  public static final StandardClass SERIOUS_CONDITION =
450    addStandardClass(Symbol.SERIOUS_CONDITION, list(CONDITION));
451
452  public static final StandardClass STORAGE_CONDITION =
453    addStandardClass(Symbol.STORAGE_CONDITION, list(SERIOUS_CONDITION));
454
455  public static final StandardClass ERROR =
456    addStandardClass(Symbol.ERROR, list(SERIOUS_CONDITION));
457
458  public static final StandardClass ARITHMETIC_ERROR =
459    addStandardClass(Symbol.ARITHMETIC_ERROR, list(ERROR));
460
461  public static final StandardClass CELL_ERROR =
462    addStandardClass(Symbol.CELL_ERROR, list(ERROR));
463
464  public static final StandardClass CONTROL_ERROR =
465    addStandardClass(Symbol.CONTROL_ERROR, list(ERROR));
466
467  public static final StandardClass FILE_ERROR =
468    addStandardClass(Symbol.FILE_ERROR, list(ERROR));
469
470  public static final StandardClass DIVISION_BY_ZERO =
471    addStandardClass(Symbol.DIVISION_BY_ZERO, list(ARITHMETIC_ERROR));
472
473  public static final StandardClass FLOATING_POINT_INEXACT =
474    addStandardClass(Symbol.FLOATING_POINT_INEXACT, list(ARITHMETIC_ERROR));
475
476  public static final StandardClass FLOATING_POINT_INVALID_OPERATION =
477    addStandardClass(Symbol.FLOATING_POINT_INVALID_OPERATION, list(ARITHMETIC_ERROR));
478
479  public static final StandardClass FLOATING_POINT_OVERFLOW =
480    addStandardClass(Symbol.FLOATING_POINT_OVERFLOW, list(ARITHMETIC_ERROR));
481
482  public static final StandardClass FLOATING_POINT_UNDERFLOW =
483    addStandardClass(Symbol.FLOATING_POINT_UNDERFLOW, list(ARITHMETIC_ERROR));
484
485  public static final StandardClass PROGRAM_ERROR =
486    addStandardClass(Symbol.PROGRAM_ERROR, list(ERROR));
487
488  public static final StandardClass PACKAGE_ERROR =
489    addStandardClass(Symbol.PACKAGE_ERROR, list(ERROR));
490
491  public static final StandardClass STREAM_ERROR =
492    addStandardClass(Symbol.STREAM_ERROR, list(ERROR));
493
494  public static final StandardClass PARSE_ERROR =
495    addStandardClass(Symbol.PARSE_ERROR, list(ERROR));
496
497  public static final StandardClass PRINT_NOT_READABLE =
498    addStandardClass(Symbol.PRINT_NOT_READABLE, list(ERROR));
499
500  public static final StandardClass READER_ERROR =
501    addStandardClass(Symbol.READER_ERROR, list(PARSE_ERROR, STREAM_ERROR));
502
503  public static final StandardClass END_OF_FILE =
504    addStandardClass(Symbol.END_OF_FILE, list(STREAM_ERROR));
505
506  public static final StandardClass SIMPLE_ERROR =
507    addStandardClass(Symbol.SIMPLE_ERROR, list(SIMPLE_CONDITION, ERROR));
508
509  public static final StandardClass TYPE_ERROR =
510    addStandardClass(Symbol.TYPE_ERROR, list(ERROR));
511
512  public static final StandardClass SIMPLE_TYPE_ERROR =
513    addStandardClass(Symbol.SIMPLE_TYPE_ERROR, list(SIMPLE_CONDITION,
514                                                     TYPE_ERROR));
515
516  public static final StandardClass UNBOUND_SLOT =
517    addStandardClass(Symbol.UNBOUND_SLOT, list(CELL_ERROR));
518
519  public static final StandardClass UNBOUND_VARIABLE =
520    addStandardClass(Symbol.UNBOUND_VARIABLE, list(CELL_ERROR));
521
522  public static final StandardClass UNDEFINED_FUNCTION =
523    addStandardClass(Symbol.UNDEFINED_FUNCTION, list(CELL_ERROR));
524
525  public static final StandardClass COMPILER_ERROR =
526    addStandardClass(Symbol.COMPILER_ERROR, list(CONDITION));
527   
528  public static final StandardClass INTERNAL_COMPILER_ERROR =
529    addStandardClass(Symbol.INTERNAL_COMPILER_ERROR, list(CONDITION));
530
531  public static final StandardClass COMPILER_UNSUPPORTED_FEATURE_ERROR =
532    addStandardClass(Symbol.COMPILER_UNSUPPORTED_FEATURE_ERROR,
533                     list(CONDITION));
534
535  public static final StandardClass JAVA_EXCEPTION =
536    addStandardClass(Symbol.JAVA_EXCEPTION, list(ERROR));
537
538  public static final StandardClass METHOD =
539    addStandardClass(Symbol.METHOD, list(STANDARD_OBJECT));
540
541  public static final StandardClass STANDARD_METHOD =
542    new StandardMethodClass();
543  static
544  {
545    addClass(Symbol.STANDARD_METHOD, STANDARD_METHOD);
546  }
547
548  public static final StandardClass STANDARD_READER_METHOD =
549    new StandardReaderMethodClass();
550  static
551  {
552    addClass(Symbol.STANDARD_READER_METHOD, STANDARD_READER_METHOD);
553  }
554
555  public static final StandardClass STANDARD_GENERIC_FUNCTION =
556    new StandardGenericFunctionClass();
557  static
558  {
559    addClass(Symbol.STANDARD_GENERIC_FUNCTION, STANDARD_GENERIC_FUNCTION);
560  }
561
562  public static void initializeStandardClasses()
563  {
564    // We need to call setDirectSuperclass() here for classes that have a
565    // BuiltInClass as a superclass. See comment above (at first mention of
566    // STANDARD_OBJECT).
567    STANDARD_CLASS.setDirectSuperclass(CLASS);
568    STANDARD_OBJECT.setDirectSuperclass(BuiltInClass.CLASS_T);
569    GENERIC_FUNCTION.setDirectSuperclasses(list(BuiltInClass.FUNCTION,
570                                                 STANDARD_OBJECT));
571
572    ARITHMETIC_ERROR.setCPL(ARITHMETIC_ERROR, ERROR, SERIOUS_CONDITION,
573                            CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
574    ARITHMETIC_ERROR.setDirectSlotDefinitions(
575      list(new SlotDefinition(Symbol.OPERATION,
576                               list(PACKAGE_CL.intern("ARITHMETIC-ERROR-OPERATION"))),
577            new SlotDefinition(Symbol.OPERANDS,
578                               list(PACKAGE_CL.intern("ARITHMETIC-ERROR-OPERANDS")))));
579    BUILT_IN_CLASS.setCPL(BUILT_IN_CLASS, CLASS, STANDARD_OBJECT,
580                          BuiltInClass.CLASS_T);
581    CELL_ERROR.setCPL(CELL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
582                      STANDARD_OBJECT, BuiltInClass.CLASS_T);
583    CELL_ERROR.setDirectSlotDefinitions(
584      list(new SlotDefinition(Symbol.NAME,
585                               list(Symbol.CELL_ERROR_NAME))));
586    CLASS.setCPL(CLASS, STANDARD_OBJECT, BuiltInClass.CLASS_T);
587    COMPILER_ERROR.setCPL(COMPILER_ERROR, CONDITION, STANDARD_OBJECT,
588                          BuiltInClass.CLASS_T);
589    INTERNAL_COMPILER_ERROR.setCPL(INTERNAL_COMPILER_ERROR, CONDITION, STANDARD_OBJECT,
590                                   BuiltInClass.CLASS_T);
591    COMPILER_UNSUPPORTED_FEATURE_ERROR.setCPL(COMPILER_UNSUPPORTED_FEATURE_ERROR,
592                                              CONDITION, STANDARD_OBJECT,
593                                              BuiltInClass.CLASS_T);
594    CONDITION.setCPL(CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
595    CONDITION.setDirectSlotDefinitions(
596      list(new SlotDefinition(Symbol.FORMAT_CONTROL,
597                               list(Symbol.SIMPLE_CONDITION_FORMAT_CONTROL)),
598            new SlotDefinition(Symbol.FORMAT_ARGUMENTS,
599                               list(Symbol.SIMPLE_CONDITION_FORMAT_ARGUMENTS),
600                               NIL)));
601    CONDITION.setDirectDefaultInitargs(list(Keyword.FORMAT_ARGUMENTS,
602                                             // FIXME
603                                             new Closure(list(Symbol.LAMBDA, NIL, NIL),
604                                                         new Environment())));
605    CONTROL_ERROR.setCPL(CONTROL_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
606                         STANDARD_OBJECT, BuiltInClass.CLASS_T);
607    DIVISION_BY_ZERO.setCPL(DIVISION_BY_ZERO, ARITHMETIC_ERROR, ERROR,
608                            SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
609                            BuiltInClass.CLASS_T);
610    END_OF_FILE.setCPL(END_OF_FILE, STREAM_ERROR, ERROR, SERIOUS_CONDITION,
611                       CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
612    ERROR.setCPL(ERROR, SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
613                 BuiltInClass.CLASS_T);
614    FILE_ERROR.setCPL(FILE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
615                      STANDARD_OBJECT, BuiltInClass.CLASS_T);
616    FILE_ERROR.setDirectSlotDefinitions(
617      list(new SlotDefinition(Symbol.PATHNAME,
618                               list(PACKAGE_CL.intern("FILE-ERROR-PATHNAME")))));
619    FLOATING_POINT_INEXACT.setCPL(FLOATING_POINT_INEXACT, ARITHMETIC_ERROR,
620                                  ERROR, SERIOUS_CONDITION, CONDITION,
621                                  STANDARD_OBJECT, BuiltInClass.CLASS_T);
622    FLOATING_POINT_INVALID_OPERATION.setCPL(FLOATING_POINT_INVALID_OPERATION,
623                                            ARITHMETIC_ERROR, ERROR,
624                                            SERIOUS_CONDITION, CONDITION,
625                                            STANDARD_OBJECT, BuiltInClass.CLASS_T);
626    FLOATING_POINT_OVERFLOW.setCPL(FLOATING_POINT_OVERFLOW, ARITHMETIC_ERROR,
627                                   ERROR, SERIOUS_CONDITION, CONDITION,
628                                   STANDARD_OBJECT, BuiltInClass.CLASS_T);
629    FLOATING_POINT_UNDERFLOW.setCPL(FLOATING_POINT_UNDERFLOW, ARITHMETIC_ERROR,
630                                    ERROR, SERIOUS_CONDITION, CONDITION,
631                                    STANDARD_OBJECT, BuiltInClass.CLASS_T);
632    FORWARD_REFERENCED_CLASS.setCPL(FORWARD_REFERENCED_CLASS, CLASS,
633                                    BuiltInClass.CLASS_T);
634    GENERIC_FUNCTION.setCPL(GENERIC_FUNCTION, STANDARD_OBJECT,
635                            BuiltInClass.FUNCTION,
636                            BuiltInClass.CLASS_T);
637    JAVA_EXCEPTION.setCPL(JAVA_EXCEPTION, ERROR, SERIOUS_CONDITION, CONDITION,
638                          STANDARD_OBJECT, BuiltInClass.CLASS_T);
639    JAVA_EXCEPTION.setDirectSlotDefinitions(
640      list(new SlotDefinition(Symbol.CAUSE, list(Symbol.JAVA_EXCEPTION_CAUSE))));
641    METHOD.setCPL(METHOD, STANDARD_OBJECT, BuiltInClass.CLASS_T);
642    PACKAGE_ERROR.setCPL(PACKAGE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
643                         STANDARD_OBJECT, BuiltInClass.CLASS_T);
644    PACKAGE_ERROR.setDirectSlotDefinitions(
645      list(new SlotDefinition(Symbol.PACKAGE,
646                               list(PACKAGE_CL.intern("PACKAGE-ERROR-PACKAGE")))));
647    PARSE_ERROR.setCPL(PARSE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
648                       STANDARD_OBJECT, BuiltInClass.CLASS_T);
649    PRINT_NOT_READABLE.setCPL(PRINT_NOT_READABLE, ERROR, SERIOUS_CONDITION,
650                              CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
651    PRINT_NOT_READABLE.setDirectSlotDefinitions(
652      list(new SlotDefinition(Symbol.OBJECT,
653                               list(PACKAGE_CL.intern("PRINT-NOT-READABLE-OBJECT")))));
654    PROGRAM_ERROR.setCPL(PROGRAM_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
655                         STANDARD_OBJECT, BuiltInClass.CLASS_T);
656    READER_ERROR.setCPL(READER_ERROR, PARSE_ERROR, STREAM_ERROR, ERROR,
657                        SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
658                        BuiltInClass.CLASS_T);
659    SERIOUS_CONDITION.setCPL(SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
660                             BuiltInClass.CLASS_T);
661    SIMPLE_CONDITION.setCPL(SIMPLE_CONDITION, CONDITION, STANDARD_OBJECT,
662                            BuiltInClass.CLASS_T);
663    SIMPLE_ERROR.setCPL(SIMPLE_ERROR, SIMPLE_CONDITION, ERROR,
664                        SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
665                        BuiltInClass.CLASS_T);
666    SIMPLE_TYPE_ERROR.setDirectSuperclasses(list(SIMPLE_CONDITION,
667                                                  TYPE_ERROR));
668    SIMPLE_TYPE_ERROR.setCPL(SIMPLE_TYPE_ERROR, SIMPLE_CONDITION,
669                             TYPE_ERROR, ERROR, SERIOUS_CONDITION,
670                             CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
671    SIMPLE_WARNING.setDirectSuperclasses(list(SIMPLE_CONDITION, WARNING));
672    SIMPLE_WARNING.setCPL(SIMPLE_WARNING, SIMPLE_CONDITION, WARNING,
673                          CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
674    STANDARD_CLASS.setCPL(STANDARD_CLASS, CLASS,
675                          STANDARD_OBJECT, BuiltInClass.CLASS_T);
676    STANDARD_OBJECT.setCPL(STANDARD_OBJECT, BuiltInClass.CLASS_T);
677    STORAGE_CONDITION.setCPL(STORAGE_CONDITION, SERIOUS_CONDITION, CONDITION,
678                             STANDARD_OBJECT, BuiltInClass.CLASS_T);
679    STREAM_ERROR.setCPL(STREAM_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
680                        STANDARD_OBJECT, BuiltInClass.CLASS_T);
681    STREAM_ERROR.setDirectSlotDefinitions(
682      list(new SlotDefinition(Symbol.STREAM,
683                               list(PACKAGE_CL.intern("STREAM-ERROR-STREAM")))));
684    STRUCTURE_CLASS.setCPL(STRUCTURE_CLASS, CLASS, STANDARD_OBJECT,
685                           BuiltInClass.CLASS_T);
686    STYLE_WARNING.setCPL(STYLE_WARNING, WARNING, CONDITION, STANDARD_OBJECT,
687                         BuiltInClass.CLASS_T);
688    TYPE_ERROR.setCPL(TYPE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
689                      STANDARD_OBJECT, BuiltInClass.CLASS_T);
690    TYPE_ERROR.setDirectSlotDefinitions(
691      list(new SlotDefinition(Symbol.DATUM,
692                               list(PACKAGE_CL.intern("TYPE-ERROR-DATUM"))),
693            new SlotDefinition(Symbol.EXPECTED_TYPE,
694                               list(PACKAGE_CL.intern("TYPE-ERROR-EXPECTED-TYPE")))));
695    UNBOUND_SLOT.setCPL(UNBOUND_SLOT, CELL_ERROR, ERROR, SERIOUS_CONDITION,
696                        CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
697    UNBOUND_SLOT.setDirectSlotDefinitions(
698      list(new SlotDefinition(Symbol.INSTANCE,
699                               list(PACKAGE_CL.intern("UNBOUND-SLOT-INSTANCE")))));
700    UNBOUND_VARIABLE.setCPL(UNBOUND_VARIABLE, CELL_ERROR, ERROR,
701                            SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
702                            BuiltInClass.CLASS_T);
703    UNDEFINED_FUNCTION.setCPL(UNDEFINED_FUNCTION, CELL_ERROR, ERROR,
704                              SERIOUS_CONDITION, CONDITION, STANDARD_OBJECT,
705                              BuiltInClass.CLASS_T);
706    WARNING.setCPL(WARNING, CONDITION, STANDARD_OBJECT, BuiltInClass.CLASS_T);
707
708    // Condition classes.
709    STANDARD_CLASS.finalizeClass();
710    STANDARD_OBJECT.finalizeClass();
711    CLASS.finalizeClass();
712    ARITHMETIC_ERROR.finalizeClass();
713    CELL_ERROR.finalizeClass();
714    COMPILER_ERROR.finalizeClass();
715    INTERNAL_COMPILER_ERROR.finalizeClass();
716    COMPILER_UNSUPPORTED_FEATURE_ERROR.finalizeClass();
717    CONDITION.finalizeClass();
718    CONTROL_ERROR.finalizeClass();
719    DIVISION_BY_ZERO.finalizeClass();
720    END_OF_FILE.finalizeClass();
721    ERROR.finalizeClass();
722    FILE_ERROR.finalizeClass();
723    FLOATING_POINT_INEXACT.finalizeClass();
724    FLOATING_POINT_INVALID_OPERATION.finalizeClass();
725    FLOATING_POINT_OVERFLOW.finalizeClass();
726    FLOATING_POINT_UNDERFLOW.finalizeClass();
727    JAVA_EXCEPTION.finalizeClass();
728    PACKAGE_ERROR.finalizeClass();
729    PARSE_ERROR.finalizeClass();
730    PRINT_NOT_READABLE.finalizeClass();
731    PROGRAM_ERROR.finalizeClass();
732    READER_ERROR.finalizeClass();
733    SERIOUS_CONDITION.finalizeClass();
734    SIMPLE_CONDITION.finalizeClass();
735    SIMPLE_ERROR.finalizeClass();
736    SIMPLE_TYPE_ERROR.finalizeClass();
737    SIMPLE_WARNING.finalizeClass();
738    STORAGE_CONDITION.finalizeClass();
739    STREAM_ERROR.finalizeClass();
740    STYLE_WARNING.finalizeClass();
741    TYPE_ERROR.finalizeClass();
742    UNBOUND_SLOT.finalizeClass();
743    UNBOUND_VARIABLE.finalizeClass();
744    UNDEFINED_FUNCTION.finalizeClass();
745    WARNING.finalizeClass();
746
747    // SYS:SLOT-DEFINITION is constructed and finalized in
748    // SlotDefinitionClass.java, but we need to fill in a few things here.
749    Debug.assertTrue(SLOT_DEFINITION.isFinalized());
750    SLOT_DEFINITION.setCPL(SLOT_DEFINITION, STANDARD_OBJECT,
751                           BuiltInClass.CLASS_T);
752    SLOT_DEFINITION.setDirectSlotDefinitions(SLOT_DEFINITION.getClassLayout().generateSlotDefinitions());
753    // There are no inherited slots.
754    SLOT_DEFINITION.setSlotDefinitions(SLOT_DEFINITION.getDirectSlotDefinitions());
755
756    DIRECT_SLOT_DEFINITION.setCPL(DIRECT_SLOT_DEFINITION, SLOT_DEFINITION,
757                                  STANDARD_OBJECT, BuiltInClass.CLASS_T);
758    DIRECT_SLOT_DEFINITION.finalizeClass();
759    EFFECTIVE_SLOT_DEFINITION.setCPL(EFFECTIVE_SLOT_DEFINITION, SLOT_DEFINITION,
760                                     STANDARD_OBJECT, BuiltInClass.CLASS_T);
761    EFFECTIVE_SLOT_DEFINITION.finalizeClass();
762    STANDARD_SLOT_DEFINITION.setCPL(STANDARD_SLOT_DEFINITION, SLOT_DEFINITION,
763                                    STANDARD_OBJECT, BuiltInClass.CLASS_T);
764    STANDARD_SLOT_DEFINITION.finalizeClass();
765    STANDARD_DIRECT_SLOT_DEFINITION.setCPL(STANDARD_DIRECT_SLOT_DEFINITION, STANDARD_SLOT_DEFINITION,
766                                           DIRECT_SLOT_DEFINITION, SLOT_DEFINITION, STANDARD_OBJECT,
767                                           BuiltInClass.CLASS_T);
768    STANDARD_DIRECT_SLOT_DEFINITION.finalizeClass();
769    STANDARD_EFFECTIVE_SLOT_DEFINITION.setCPL(STANDARD_EFFECTIVE_SLOT_DEFINITION, STANDARD_SLOT_DEFINITION,
770                                              EFFECTIVE_SLOT_DEFINITION, SLOT_DEFINITION, STANDARD_OBJECT,
771                                              BuiltInClass.CLASS_T);
772    STANDARD_EFFECTIVE_SLOT_DEFINITION.finalizeClass();
773
774    // STANDARD-METHOD
775    Debug.assertTrue(STANDARD_METHOD.isFinalized());
776    STANDARD_METHOD.setCPL(STANDARD_METHOD, METHOD, STANDARD_OBJECT,
777                           BuiltInClass.CLASS_T);
778    STANDARD_METHOD.setDirectSlotDefinitions(STANDARD_METHOD.getClassLayout().generateSlotDefinitions());
779    // There are no inherited slots.
780    STANDARD_METHOD.setSlotDefinitions(STANDARD_METHOD.getDirectSlotDefinitions());
781
782    // STANDARD-READER-METHOD
783    Debug.assertTrue(STANDARD_READER_METHOD.isFinalized());
784    STANDARD_READER_METHOD.setCPL(STANDARD_READER_METHOD, STANDARD_METHOD,
785                                  METHOD, STANDARD_OBJECT, BuiltInClass.CLASS_T);
786    STANDARD_READER_METHOD.setSlotDefinitions(STANDARD_READER_METHOD.getClassLayout().generateSlotDefinitions());
787    // All but the last slot are inherited.
788    STANDARD_READER_METHOD.setDirectSlotDefinitions(list(STANDARD_READER_METHOD.getSlotDefinitions().reverse().car()));
789
790    // STANDARD-GENERIC-FUNCTION
791    Debug.assertTrue(STANDARD_GENERIC_FUNCTION.isFinalized());
792    STANDARD_GENERIC_FUNCTION.setCPL(STANDARD_GENERIC_FUNCTION,
793                                     GENERIC_FUNCTION, STANDARD_OBJECT,
794                                     BuiltInClass.FUNCTION,
795                                     BuiltInClass.CLASS_T);
796    STANDARD_GENERIC_FUNCTION.setDirectSlotDefinitions(STANDARD_GENERIC_FUNCTION.getClassLayout().generateSlotDefinitions());
797    // There are no inherited slots.
798    STANDARD_GENERIC_FUNCTION.setSlotDefinitions(STANDARD_GENERIC_FUNCTION.getDirectSlotDefinitions());
799  }
800}
Note: See TracBrowser for help on using the repository browser.