Changeset 13782


Ignore:
Timestamp:
01/15/12 21:55:45 (10 years ago)
Author:
rschlatte
Message:

Implement readers for generic-function objects as generic functions (AMOP pg. 216)

... rename predefined low-level accessors (e.g. generic-function-name ->

sys:%generic-function-name)

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

Legend:

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

    r13781 r13782  
    536536        autoload(PACKAGE_MOP, "eql-specializer-object", "EqualSpecializerObject", true);
    537537        autoload(PACKAGE_MOP, "funcallable-instance-function", "FuncallableStandardObject", false);
    538         autoload(PACKAGE_MOP, "generic-function-name", "StandardGenericFunction", true);
    539538        autoload(PACKAGE_MOP, "method-qualifiers", "StandardMethod", true);
    540539        autoload(PACKAGE_MOP, "method-specializers", "StandardMethod", true);
     
    640639        autoload(PACKAGE_SYS, "function-info", "function_info");
    641640        autoload(PACKAGE_SYS, "%function-keywords", "StandardMethod", true);
    642         autoload(PACKAGE_SYS, "generic-function-argument-precedence-order","StandardGenericFunction", true);
     641        autoload(PACKAGE_SYS, "%generic-function-argument-precedence-order","StandardGenericFunction", true);
    643642        autoload(PACKAGE_SYS, "generic-function-classes-to-emf-table","StandardGenericFunction", true);
    644643        autoload(PACKAGE_SYS, "generic-function-documentation","StandardGenericFunction", true);
    645644        autoload(PACKAGE_SYS, "generic-function-initial-methods","StandardGenericFunction", true);
    646         autoload(PACKAGE_SYS, "generic-function-method-class","StandardGenericFunction", true);
    647         autoload(PACKAGE_SYS, "generic-function-method-combination","StandardGenericFunction", true);
    648         autoload(PACKAGE_SYS, "generic-function-methods","StandardGenericFunction", true);
     645        autoload(PACKAGE_SYS, "%generic-function-method-class","StandardGenericFunction", true);
     646        autoload(PACKAGE_SYS, "%generic-function-method-combination","StandardGenericFunction", true);
     647        autoload(PACKAGE_SYS, "%generic-function-methods","StandardGenericFunction", true);
    649648        autoload(PACKAGE_SYS, "get-cached-emf", "StandardGenericFunction", true);
    650649        autoload(PACKAGE_SYS, "get-cached-slot-location", "StandardGenericFunction", true);
  • trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java

    r13777 r13782  
    319319  private static final Primitive GENERIC_FUNCTION_METHODS
    320320    = new pf_generic_function_methods();
    321   @DocString(name="generic-function-methods")
     321  @DocString(name="%generic-function-methods")
    322322  private static final class pf_generic_function_methods extends Primitive
    323323  {
    324324    pf_generic_function_methods()
    325325    {
    326       super("generic-function-methods", PACKAGE_SYS, true);
     326      super("%generic-function-methods", PACKAGE_SYS, true);
    327327    }
    328328    @Override
     
    352352  private static final Primitive GENERIC_FUNCTION_METHOD_CLASS
    353353    = new pf_generic_function_method_class();
    354   @DocString(name="generic-function-method-class")
     354  @DocString(name="%generic-function-method-class")
    355355  private static final class pf_generic_function_method_class extends Primitive
    356356  {
    357357    pf_generic_function_method_class()
    358358    {
    359       super("generic-function-method-class", PACKAGE_SYS, true);
     359      super("%generic-function-method-class", PACKAGE_SYS, true);
    360360    }
    361361    @Override
     
    385385  private static final Primitive GENERIC_FUNCTION_METHOD_COMBINATION
    386386    = new pf_generic_function_method_combination();
    387   @DocString(name="generic-function-method-combination")
     387  @DocString(name="%generic-function-method-combination")
    388388  private static final class pf_generic_function_method_combination extends Primitive
    389389  {
    390390    pf_generic_function_method_combination()
    391391    {
    392       super("generic-function-method-combination", PACKAGE_SYS, true);
     392      super("%generic-function-method-combination", PACKAGE_SYS, true);
    393393    }
    394394    @Override
     
    419419  private static final Primitive GENERIC_FUNCTION_ARGUMENT_PRECEDENCE_ORDER
    420420    = new pf_generic_function_argument_precedence_order();
    421   @DocString(name="generic-function-argument-precedence-order")
     421  @DocString(name="%generic-function-argument-precedence-order")
    422422  private static final class pf_generic_function_argument_precedence_order extends Primitive
    423423  {
    424424    pf_generic_function_argument_precedence_order()
    425425    {
    426       super("generic-function-argument-precedence-order", PACKAGE_SYS, true);
     426      super("%generic-function-argument-precedence-order", PACKAGE_SYS, true);
    427427    }
    428428    @Override
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13781 r13782  
    12691269;;   generic-function-name
    12701270
     1271;;; These are defined with % in package SYS, defined as functions here
     1272;;; and redefined as generic functions once we're all set up.
     1273
    12711274(defun generic-function-lambda-list (gf)
    12721275  (%generic-function-lambda-list gf))
     
    12791282  (set-generic-function-initial-methods gf new-value))
    12801283
     1284(defun generic-function-methods (gf)
     1285  (sys:%generic-function-methods gf))
    12811286(defun (setf generic-function-methods) (new-value gf)
    12821287  (set-generic-function-methods gf new-value))
    12831288
     1289(defun generic-function-method-class (gf)
     1290  (sys:%generic-function-method-class gf))
    12841291(defun (setf generic-function-method-class) (new-value gf)
    12851292  (set-generic-function-method-class gf new-value))
    12861293
     1294(defun generic-function-method-combination (gf)
     1295  (sys:%generic-function-method-combination gf))
    12871296(defun (setf generic-function-method-combination) (new-value gf)
    12881297  (set-generic-function-method-combination gf new-value))
    12891298
     1299(defun generic-function-argument-precedence-order (gf)
     1300  (sys:%generic-function-argument-precedence-order gf))
    12901301(defun (setf generic-function-argument-precedence-order) (new-value gf)
    12911302  (set-generic-function-argument-precedence-order gf new-value))
     
    18451856
    18461857(defun std-compute-discriminating-function (gf)
     1858  ;; In this function, we know that gf is of class
     1859  ;; standard-generic-function, so we call various
     1860  ;; sys:%generic-function-foo readers to break circularities.
    18471861  (cond
    1848     ((and (= (length (generic-function-methods gf)) 1)
    1849           (typep (car (generic-function-methods gf)) 'standard-reader-method))
    1850      ;;                 (sys::%format t "standard reader function ~S~%" (generic-function-name gf))
    1851 
    1852      (let* ((method (%car (generic-function-methods gf)))
     1862    ((and (= (length (sys:%generic-function-methods gf)) 1)
     1863          (typep (car (sys:%generic-function-methods gf)) 'standard-reader-method))
     1864     (let* ((method (%car (sys:%generic-function-methods gf)))
    18531865            (class (car (%method-specializers method)))
    18541866            (slot-name (reader-method-slot-name method)))
     
    18801892             ((= number-required 1)
    18811893              (cond
    1882                 ((and (eq (generic-function-method-combination gf) 'standard)
    1883                       (= (length (generic-function-methods gf)) 1))
    1884                  (let* ((method (%car (generic-function-methods gf)))
     1894                ((and (eq (sys:%generic-function-method-combination gf) 'standard)
     1895                      (= (length (sys:%generic-function-methods gf)) 1))
     1896                 (let* ((method (%car (sys:%generic-function-methods gf)))
    18851897                        (specializer (car (%method-specializers method)))
    18861898                        (function (or (%method-fast-function method)
     
    33703382  (allocate-instance class))
    33713383
     3384;;; Readers for generic function metaobjects
     3385;;; See AMOP pg. 216ff.
     3386(atomic-defgeneric generic-function-argument-precedence-order (generic-function)
     3387  (:method ((generic-function standard-generic-function))
     3388    (sys:%generic-function-argument-precedence-order generic-function)))
     3389
     3390(atomic-defgeneric generic-function-declarations (generic-function)
     3391  (:method ((generic-function standard-generic-function))
     3392    ;; TODO: add slot to StandardGenericFunctionClass.java, use it
     3393    nil))
     3394
     3395(atomic-defgeneric generic-function-lambda-list (generic-function)
     3396  (:method ((generic-function standard-generic-function))
     3397    (sys:%generic-function-lambda-list generic-function)))
     3398
     3399(atomic-defgeneric generic-function-method-class (generic-function)
     3400  (:method ((generic-function standard-generic-function))
     3401    (sys:%generic-function-method-class generic-function)))
     3402
     3403(atomic-defgeneric generic-function-method-combination (generic-function)
     3404  (:method ((generic-function standard-generic-function))
     3405    (sys:%generic-function-method-combination generic-function)))
     3406
     3407(atomic-defgeneric generic-function-methods (generic-function)
     3408  (:method ((generic-function standard-generic-function))
     3409    (sys:%generic-function-methods generic-function)))
     3410
     3411(atomic-defgeneric generic-function-name (generic-function)
     3412  (:method ((generic-function standard-generic-function))
     3413    (sys:%generic-function-name generic-function)))
     3414
    33723415(eval-when (:compile-toplevel :load-toplevel :execute)
    33733416  (require "MOP"))
Note: See TracChangeset for help on using the changeset viewer.