Changeset 14479

Timestamp:

04/24/13 12:51:16 (10 years ago)

Author:

rschlatte

Message:

Rename and slightly refactor sys:make-slot-definition

• rename to %make-slot-definition, make class argument mandatory

• adjust call sites

• also move checkSlotDefinition() method to location of sole caller

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• Autoload.java (modified) (1 diff)
• SlotDefinition.java (modified) (4 diffs)
• SlotDefinitionClass.java (modified) (2 diffs)
• clos.lisp (modified) (2 diffs)

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

@@ -643 +643 @@
         autoload(PACKAGE_SYS, "make-layout", "Layout", true);
         autoload(PACKAGE_SYS, "make-single-float", "FloatFunctions", true);
-        autoload(PACKAGE_SYS, "make-slot-definition", "SlotDefinition", true);
+        autoload(PACKAGE_SYS, "%make-slot-definition", "SlotDefinition", true);
         autoload(PACKAGE_SYS, "make-structure-class", "StructureClass");
         autoload(PACKAGE_SYS, "make-symbol-macro", "Primitives");

trunk/abcl/src/org/armedbear/lisp/SlotDefinition.java

@@ -38 +38 @@
 public final class SlotDefinition extends StandardObject
 {
-  public SlotDefinition()
+  private SlotDefinition()
   {
     super(StandardClass.STANDARD_SLOT_DEFINITION,
@@ -47 +47 @@
   }
 
-  public SlotDefinition(StandardClass clazz) {
+  private SlotDefinition(StandardClass clazz) {
     // clazz layout needs to have SlotDefinitionClass layout as prefix
     // or indexed slot access won't work
@@ -123 +123 @@
   }
 
-  public static StandardObject checkSlotDefinition(LispObject obj) {
-    if (obj instanceof StandardObject) return (StandardObject)obj;
-    return (StandardObject)type_error(obj, Symbol.SLOT_DEFINITION);
-  }
-
   @Override
   public String printObject()
@@ -143 +138 @@
   private static final Primitive MAKE_SLOT_DEFINITION 
     = new pf_make_slot_definition();
-  @DocString(name="make-slot-definition",
-             args="&optional class",
-             doc="Cannot be called with user-defined subclasses of standard-slot-definition.")
+  @DocString(name="%make-slot-definition",
+             args="slot-class",
+             doc="Argument must be a subclass of standard-slot-definition")
   private static final class pf_make_slot_definition extends Primitive
   {
     pf_make_slot_definition()
     {
-      super("make-slot-definition", PACKAGE_SYS, true, "&optional class");
-    }
-    @Override
-    public LispObject execute()
-    {
-      return new SlotDefinition();
+      super("%make-slot-definition", PACKAGE_SYS, true, "slot-class");
     }
     @Override
     public LispObject execute(LispObject slotDefinitionClass)
     {
-      return new SlotDefinition((StandardClass) slotDefinitionClass);
+      if (!(slotDefinitionClass instanceof StandardClass))
+        return type_error(slotDefinitionClass,
+                          StandardClass.STANDARD_SLOT_DEFINITION);
+      // we could check whether slotClass is a subtype of
+      // standard-slot-definition here, but subtypep doesn't work early
+      // in the build process
+      return new SlotDefinition((StandardClass)slotDefinitionClass);
     }
   };

trunk/abcl/src/org/armedbear/lisp/SlotDefinitionClass.java

@@ -63 +63 @@
         // standard-*-slot-definition do the same.
         StandardObject locationSlot =
-          SlotDefinition.checkSlotDefinition(slotDefinitions.nthcdr(8).car());
+          checkSlotDefinition(slotDefinitions.nthcdr(8).car());
         locationSlot.setInstanceSlotValue(Symbol.INITFORM, NIL);
         locationSlot.setInstanceSlotValue(Symbol.INITFUNCTION, StandardClass.constantlyNil);
         // Fix initargs of TYPE, DOCUMENTATION slots.
         StandardObject typeSlot =
-          SlotDefinition.checkSlotDefinition(slotDefinitions.nthcdr(9).car());
+          checkSlotDefinition(slotDefinitions.nthcdr(9).car());
         typeSlot.setInstanceSlotValue(Symbol.INITARGS, list(internKeyword("TYPE")));
         StandardObject documentationSlot =
-          SlotDefinition.checkSlotDefinition(slotDefinitions.nthcdr(10).car());
+          checkSlotDefinition(slotDefinitions.nthcdr(10).car());
         documentationSlot.setInstanceSlotValue(Symbol.INITARGS, list(internKeyword("DOCUMENTATION")));
         setDirectSlotDefinitions(slotDefinitions);
@@ -77 +77 @@
         setFinalized(true);
     }
+
+  private static StandardObject checkSlotDefinition(LispObject obj) {
+    if (obj instanceof StandardObject) return (StandardObject)obj;
+    return (StandardObject)type_error(obj, Symbol.SLOT_DEFINITION);
+  }
 }

trunk/abcl/src/org/armedbear/lisp/clos.lisp

@@ -486 +486 @@
   (let ((slot-class (apply #'direct-slot-definition-class class args)))
     (if (eq slot-class +the-standard-direct-slot-definition-class+)
-        (let ((slot (make-slot-definition +the-standard-direct-slot-definition-class+)))
+        (let ((slot (%make-slot-definition +the-standard-direct-slot-definition-class+)))
           (apply #'init-slot-definition slot :allocation-class class args)
           slot)
@@ -502 +502 @@
   (let ((slot-class (apply #'effective-slot-definition-class class args)))
     (if (eq slot-class +the-standard-effective-slot-definition-class+)
-        (let ((slot (make-slot-definition +the-standard-effective-slot-definition-class+)))
+        (let ((slot (%make-slot-definition +the-standard-effective-slot-definition-class+)))
           (apply #'init-slot-definition slot args)
           slot)