Changeset 4285

Timestamp:

10/10/03 17:01:33 (18 years ago)

Author:

piso

Message:

CLASS-DIRECT-SLOTS, CLASS-DIRECT-METHODS

File:

• trunk/j/src/org/armedbear/lisp/StandardClass.java (modified) (4 diffs)

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

@@ -3 +3 @@
  *
  * Copyright (C) 2003 Peter Graves
- * $Id: StandardClass.java,v 1.7 2003-10-10 14:18:24 piso Exp $
+ * $Id: StandardClass.java,v 1.8 2003-10-10 17:01:33 piso Exp $
  *
  * This program is free software; you can redistribute it and/or
@@ -26 +26 @@
     private LispObject directSlots;
     private LispObject effectiveSlots;
-    private LispObject directSubclasses;
     private LispObject directMethods;
 
@@ -65 +64 @@
     }
 
+    // ### class-direct-slots
+    private static final Primitive1 CLASS_DIRECT_SLOTS =
+        new Primitive1("class-direct-slots", PACKAGE_SYS, false)
+    {
+        public LispObject execute(LispObject arg)
+            throws ConditionThrowable
+        {
+            if (arg instanceof StandardClass)
+                return ((StandardClass)arg).directSlots;
+            if (arg instanceof BuiltInClass)
+                return NIL;
+            throw new ConditionThrowable(new TypeError(arg, "standard class"));
+        }
+    };
+
+    // ### %set-class-direct-slots
+    private static final Primitive2 _SET_CLASS_DIRECT_SLOTS =
+        new Primitive2("%set-class-direct-slots", PACKAGE_SYS, false)
+    {
+        public LispObject execute(LispObject first, LispObject second)
+            throws ConditionThrowable
+        {
+            if (first instanceof StandardClass) {
+                ((StandardClass)first).directSlots = second;
+                return second;
+            }
+            throw new ConditionThrowable(new TypeError(first, "standard class"));
+        }
+    };
+
     // ### class-slots
     private static final Primitive1 CLASS_SLOTS =
@@ -94 +123 @@
         }
     };
+
+    // ### class-direct-methods
+    private static final Primitive1 CLASS_DIRECT_METHODS =
+        new Primitive1("class-direct-methods", PACKAGE_SYS, false)
+    {
+        public LispObject execute(LispObject arg)
+            throws ConditionThrowable
+        {
+            if (arg instanceof StandardClass)
+                return ((StandardClass)arg).directMethods;
+            throw new ConditionThrowable(new TypeError(arg, "standard class"));
+        }
+    };
+
+    // ### %set-class-direct-methods
+    private static final Primitive2 _SET_CLASS_DIRECT_METHODS =
+        new Primitive2("%set-class-direct-methods", PACKAGE_SYS, false)
+    {
+        public LispObject execute(LispObject first, LispObject second)
+            throws ConditionThrowable
+        {
+            if (first instanceof StandardClass) {
+                ((StandardClass)first).directMethods = second;
+                return second;
+            }
+            throw new ConditionThrowable(new TypeError(first, "standard class"));
+        }
+    };
 }