Changeset 4288

Timestamp:

10/10/03 17:03:17 (19 years ago)

Author:

piso

Message:

CLASS-DIRECT-SUBCLASSES

File:

• trunk/j/src/org/armedbear/lisp/LispClass.java (modified) (5 diffs)

trunk/j/src/org/armedbear/lisp/LispClass.java

@@ -3 +3 @@
  *
  * Copyright (C) 2003 Peter Graves
- * $Id: LispClass.java,v 1.30 2003-10-10 14:46:21 piso Exp $
+ * $Id: LispClass.java,v 1.31 2003-10-10 17:03:17 piso Exp $
  *
  * This program is free software; you can redistribute it and/or
@@ -44 +44 @@
     protected Symbol symbol;
     private LispObject directSuperclasses;
+    private LispObject directSubclasses;
     private LispObject classPrecedenceList = NIL;
 
@@ -81 +82 @@
     {
         directSuperclasses = new Cons(superclass);
+    }
+
+    public final LispObject getDirectSubclasses()
+    {
+        return directSubclasses;
+    }
+
+    public final void setDirectSubclasses(LispObject directSubclasses)
+    {
+        this.directSubclasses = directSubclasses;
     }
 
@@ -268 +279 @@
     };
 
+    // ### class-direct-subclasses
+    private static final Primitive1 CLASS_DIRECT_SUBCLASSES =
+        new Primitive1("class-direct-subclasses", PACKAGE_SYS, false)
+    {
+        public LispObject execute(LispObject arg) throws ConditionThrowable
+        {
+            if (arg instanceof LispClass)
+                return ((LispClass)arg).getDirectSubclasses();
+            throw new ConditionThrowable(new TypeError(arg, "class"));
+        }
+    };
+
+    // ### %set-class-direct-subclasses
+    private static final Primitive2 _SET_CLASS_DIRECT_SUBCLASSES =
+        new Primitive2("%set-class-direct-subclasses", PACKAGE_SYS, false)
+    {
+        public LispObject execute(LispObject first, LispObject second)
+            throws ConditionThrowable
+        {
+            if (first instanceof LispClass) {
+                ((LispClass)first).setDirectSubclasses(second);
+                return second;
+            }
+            throw new ConditionThrowable(new TypeError(first, "class"));
+        }
+    };
+
     // ### class-precedence-list
     private static final Primitive1 CLASS_PRECEDENCE_LIST =
@@ -280 +318 @@
     };
 
+    // ### %set-class-precedence-list
+    private static final Primitive1 _SET_CLASS_PRECEDENCE_LIST =
+        new Primitive1("%set-class-precedence-list", PACKAGE_SYS, false)
+    {
+        public LispObject execute(LispObject first, LispObject second)
+            throws ConditionThrowable
+        {
+            if (first instanceof LispClass) {
+                ((LispClass)first).classPrecedenceList = second;
+                return second;
+            }
+            throw new ConditionThrowable(new TypeError(first, "class"));
+        }
+    };
+
     // ### classp
     private static final Primitive1 CLASSP =