KickJava   Java API By Example, From Geeks To Geeks.

Java > Open Source Codes > org > armedbear > lisp > StructureClass


1 /*
2  * StructureClass.java
3  *
4  * Copyright (C) 2003-2004 Peter Graves
5  * $Id: StructureClass.java,v 1.10 2004/05/23 15:26:51 piso Exp $
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
22 package org.armedbear.lisp;
23
24 public class StructureClass extends SlotClass
25 {
26     private StructureClass(Symbol symbol)
27     {
28         super(symbol, new Cons(BuiltInClass.STRUCTURE_OBJECT));
29     }
30
31     public StructureClass(Symbol symbol, LispObject directSuperclasses)
32     {
33         super(symbol, directSuperclasses);
34     }
35
36     public LispObject typeOf()
37     {
38         return Symbol.STRUCTURE_CLASS;
39     }
40
41     public LispClass classOf()
42     {
43         return BuiltInClass.STRUCTURE_CLASS;
44     }
45
46     public LispObject typep(LispObject type) throws ConditionThrowable
47     {
48         if (type == Symbol.STRUCTURE_CLASS)
49             return T;
50         if (type == BuiltInClass.STRUCTURE_CLASS)
51             return T;
52         return super.typep(type);
53     }
54
55     public LispObject getDescription() throws ConditionThrowable
56     {
57         return new SimpleString(writeToString());
58     }
59
60     public String JavaDoc writeToString() throws ConditionThrowable
61     {
62         StringBuffer JavaDoc sb = new StringBuffer JavaDoc("#<STRUCTURE-CLASS ");
63         sb.append(symbol.writeToString());
64         sb.append('>');
65         return sb.toString();
66     }
67
68     // ### make-structure-class name direct-slots slots include => class
69 private static final Primitive4 MAKE_STRUCTURE_CLASS =
70         new Primitive4("make-structure-class", PACKAGE_SYS, false)
71     {
72         public LispObject execute(LispObject first, LispObject second,
73                                   LispObject third, LispObject fourth)
74             throws ConditionThrowable
75         {
76             Symbol symbol = checkSymbol(first);
77             LispObject directSlots = checkList(second);
78             LispObject slots = checkList(third);
79             Symbol include = checkSymbol(fourth);
80             StructureClass c = new StructureClass(symbol);
81             if (include != NIL) {
82                 LispClass includedClass = LispClass.findClass(include);
83                 if (includedClass == null)
84                     return signal(new SimpleError("Class " + include +
85                                                   " is undefined."));
86                 c.setCPL(new Cons(c, includedClass.getCPL()));
87             } else
88                 c.setCPL(c, BuiltInClass.STRUCTURE_OBJECT, BuiltInClass.CLASS_T);
89             c.setDirectSlots(directSlots);
90             c.setEffectiveSlots(slots);
91             addClass(symbol, c);
92             return c;
93         }
94     };
95 }
96
Popular Tags