Changeset 13774


Ignore:
Timestamp:
01/14/12 16:52:48 (9 years ago)
Author:
rschlatte
Message:

introduce funcallable-standard-class

... not yet usable as metaclass since various machinery is missing

... also make #'documentation work for all class objects, not just

standard-class

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/StandardClass.java

    r13773 r13774  
    451451    addStandardClass(Symbol.STRUCTURE_CLASS, list(CLASS));
    452452
     453  public static final StandardClass FUNCALLABLE_STANDARD_CLASS =
     454    addStandardClass(Symbol.FUNCALLABLE_STANDARD_CLASS, list(CLASS));
     455  static
     456  {
     457    // funcallable-standard-class has more or less the same interface as
     458    // standard-class.
     459    FUNCALLABLE_STANDARD_CLASS.setClassLayout(layoutStandardClass);
     460    FUNCALLABLE_STANDARD_CLASS.setDirectSlotDefinitions(standardClassSlotDefinitions());
     461  }
     462
    453463  public static final StandardClass CONDITION =
    454464    addStandardClass(Symbol.CONDITION, list(STANDARD_OBJECT));
     
    572582  }
    573583
     584  // ### TODO move functionality upwards into funcallable-stanard-object
     585  // and use addStandardClass() here
    574586  public static final StandardClass STANDARD_GENERIC_FUNCTION =
    575587    new StandardGenericFunctionClass();
  • trunk/abcl/src/org/armedbear/lisp/Symbol.java

    r13773 r13774  
    29742974  public static final Symbol FUNCALLABLE_STANDARD_OBJECT =
    29752975    PACKAGE_MOP.addExternalSymbol("FUNCALLABLE-STANDARD-OBJECT");
     2976  public static final Symbol FUNCALLABLE_STANDARD_CLASS =
     2977    PACKAGE_CL.addExternalSymbol("FUNCALLABLE-STANDARD-CLASS");
    29762978  public static final Symbol SHORT_METHOD_COMBINATION =
    29772979    PACKAGE_MOP.addInternalSymbol("SHORT-METHOD-COMBINATION");
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13762 r13774  
    24732473                       #'(lambda (class-name)
    24742474                           `(:method (new-value (class ,class-name))
    2475                                      (,%name new-value class)))
    2476                      #'(lambda (class-name)
    2477                          `(:method ((class ,class-name))
    2478                                    (,%name class))))
    2479                    '(built-in-class
    2480                      forward-referenced-class
    2481                      structure-class))
    2482          (:method (,@(when (consp name) (list 'new-value))
    2483                    (class standard-class))
    2484              ,(if (consp name)
    2485                   `(setf (slot-value class ',slot) new-value)
    2486                 `(slot-value class ',slot))))))
     2475                              (,%name new-value class)))
     2476                       #'(lambda (class-name)
     2477                           `(:method ((class ,class-name))
     2478                              (,%name class))))
     2479                   '(built-in-class forward-referenced-class structure-class))
     2480         ,@(mapcar #'(lambda (class-name)
     2481                       `(:method (,@(when (consp name) (list 'new-value))
     2482                                  (class ,class-name))
     2483                          ,(if (consp name)
     2484                               `(setf (slot-value class ',slot) new-value)
     2485                               `(slot-value class ',slot))))
     2486                   '(standard-class funcallable-standard-class)))))
    24872487
    24882488
     
    25662566  new-value)
    25672567
    2568 (defmethod documentation ((x standard-class) (doc-type (eql 't)))
     2568(defmethod documentation ((x class) (doc-type (eql 't)))
    25692569  (class-documentation x))
    25702570
    2571 (defmethod documentation ((x standard-class) (doc-type (eql 'type)))
     2571(defmethod documentation ((x class) (doc-type (eql 'type)))
    25722572  (class-documentation x))
    25732573
    2574 (defmethod (setf documentation) (new-value (x standard-class) (doc-type (eql 't)))
     2574(defmethod (setf documentation) (new-value (x class) (doc-type (eql 't)))
    25752575  (%set-class-documentation x new-value))
    25762576
    2577 (defmethod (setf documentation) (new-value (x standard-class) (doc-type (eql 'type)))
     2577(defmethod (setf documentation) (new-value (x class) (doc-type (eql 'type)))
    25782578  (%set-class-documentation x new-value))
    25792579
     
    30043004(atomic-defgeneric finalize-inheritance (class)
    30053005    (:method ((class standard-class))
     3006       (std-finalize-inheritance class))
     3007    (:method ((class funcallable-standard-class))
    30063008       (std-finalize-inheritance class)))
    30073009
     
    30163018(defgeneric compute-slots (class))
    30173019(defmethod compute-slots ((class standard-class))
     3020  (std-compute-slots class))
     3021(defmethod compute-slots ((class funcallable-standard-class))
    30183022  (std-compute-slots class))
    30193023
  • trunk/abcl/src/org/armedbear/lisp/mop.lisp

    r13766 r13774  
    22
    33(in-package #:mop)
    4 
    5 (defclass funcallable-standard-class (class))
    6 
    7 (defmethod class-name ((class funcallable-standard-class))
    8   'funcallable-standard-class)
    94
    105;;; StandardGenericFunction.java defines FUNCALLABLE-INSTANCE-FUNCTION and
Note: See TracChangeset for help on using the changeset viewer.