Changeset 4283

Timestamp:

10/10/03 14:21:55 (20 years ago)

Author:

piso

Message:

CLASS-SLOTS
%SET-CLASS-SLOTS

Location:

trunk/j/src/org/armedbear/lisp

Files:

• Autoload.java (modified) (4 diffs)
• StandardClass.java (modified) (3 diffs)

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

@@ -3 +3 @@
  *
  * Copyright (C) 2003 Peter Graves
- * $Id: Autoload.java,v 1.83 2003-10-07 17:23:21 piso Exp $
+ * $Id: Autoload.java,v 1.84 2003-10-10 14:21:55 piso Exp $
  *
  * This program is free software; you can redistribute it and/or
@@ -188 +188 @@
         autoload("copy-structure", "StructureObject");
         autoload("delete-package", "PackageFunctions");
+        autoload("describe", "describe");
         autoload("directory-namestring", "Pathname");
-        autoload("describe", "describe");
         autoload("file-write-date", "Time");
         autoload("find-class", "LispClass");
@@ -252 +252 @@
         autoload(PACKAGE_SYS, "%open-input-file", "open");
         autoload(PACKAGE_SYS, "%open-output-file", "open");
+        autoload(PACKAGE_SYS, "%set-class-slots", "StandardClass");
         autoload(PACKAGE_SYS, "%string-capitalize", "StringFunctions");
         autoload(PACKAGE_SYS, "%string-downcase", "StringFunctions");
@@ -276 +277 @@
         autoload(PACKAGE_SYS, "%structure-set-2", "StructureObject");
         autoload(PACKAGE_SYS, "%time", "Time");
+        autoload(PACKAGE_SYS, "class-slots", "StandardClass");
         autoload(PACKAGE_SYS, "default-time-zone", "Time");
         autoload(PACKAGE_SYS, "hash-table-entries", "HashTable");

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

@@ -3 +3 @@
  *
  * Copyright (C) 2003 Peter Graves
- * $Id: StandardClass.java,v 1.6 2003-09-28 19:34:28 piso Exp $
+ * $Id: StandardClass.java,v 1.7 2003-10-10 14:18:24 piso Exp $
  *
  * This program is free software; you can redistribute it and/or
@@ -24 +24 @@
 public class StandardClass extends LispClass
 {
+    private LispObject directSlots;
+    private LispObject effectiveSlots;
+    private LispObject directSubclasses;
+    private LispObject directMethods;
+
+    public StandardClass()
+    {
+    }
+
     public StandardClass(Symbol symbol, LispObject directSuperclasses)
     {
@@ -56 +65 @@
     }
 
-    // ### make-instance-standard-class
-    // make-instance-standard-class name all-keys => class
-    private static final Primitive2 MAKE_INSTANCE_STANDARD_CLASS =
-        new Primitive2("make-instance-standard-class", PACKAGE_SYS, false)
+    // ### class-slots
+    private static final Primitive1 CLASS_SLOTS =
+        new Primitive1("class-slots", PACKAGE_SYS, false)
+    {
+        public LispObject execute(LispObject arg)
+            throws ConditionThrowable
+        {
+            if (arg instanceof StandardClass)
+                return ((StandardClass)arg).effectiveSlots;
+            if (arg == BuiltInClass.STANDARD_CLASS)
+                return NIL; // FIXME
+            throw new ConditionThrowable(new TypeError(arg, "standard class"));
+        }
+    };
+
+    // ### %set-class-slots
+    private static final Primitive2 _SET_CLASS_SLOTS =
+        new Primitive2("%set-class-slots", PACKAGE_SYS, false)
     {
         public LispObject execute(LispObject first, LispObject second)
             throws ConditionThrowable
         {
-            Symbol symbol = checkSymbol(first);
-            LispObject directSuperclasses = NIL;
-            LispObject allKeys = second;
-            while (allKeys != NIL) {
-                LispObject key = allKeys.car();
-                LispObject value = allKeys.cadr();
-                if (key == Keyword.DIRECT_SUPERCLASSES)
-                    directSuperclasses = value;
-                allKeys = allKeys.cddr();
+            if (first instanceof StandardClass) {
+                ((StandardClass)first).effectiveSlots = second;
+                return second;
             }
-            return new StandardClass(symbol, directSuperclasses);
+            throw new ConditionThrowable(new TypeError(first, "standard class"));
         }
     };