Changeset 13877
- Timestamp:
- 02/24/12 04:20:52 (10 years ago)
- Location:
- trunk/abcl/src/org/armedbear/lisp
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r13876 r13877 211 211 (std-function-keywords method)) 212 212 213 213 (declaim (notinline map-dependents)) 214 (defun map-dependents (metaobject function) 215 ;; stub, will be redefined later 216 (declare (ignore metaobject function)) 217 nil) 214 218 215 219 (defmacro push-on-end (value location) … … 1424 1428 (dolist (method (generic-function-initial-methods gf)) 1425 1429 (if (typep gf 'standard-generic-function) 1426 (std-remove-method gf method) 1430 (progn 1431 (std-remove-method gf method) 1432 (map-dependents gf 1433 #'(lambda (dep) 1434 (update-dependent gf dep 1435 'remove-method method)))) 1427 1436 (remove-method gf method))) 1428 1437 (setf (generic-function-initial-methods gf) '())))) … … 1792 1801 (apply #'make-instance (generic-function-method-class gf) all-keys)))) 1793 1802 (if (eq (generic-function-method-class gf) +the-standard-method-class+) 1794 (std-add-method gf method) 1803 (progn 1804 (std-add-method gf method) 1805 (map-dependents gf 1806 #'(lambda (dep) 1807 (update-dependent gf dep 'add-method method)))) 1795 1808 (add-method gf method)) 1796 1809 method))) … … 2547 2560 initargs)))) 2548 2561 (if (eq (class-of gf) +the-standard-generic-function-class+) 2549 (std-add-method gf method) 2562 (progn 2563 (std-add-method gf method) 2564 (map-dependents gf 2565 #'(lambda (dep) 2566 (update-dependent gf dep 'add-method method)))) 2550 2567 (add-method gf method)) 2551 2568 method))) … … 2592 2609 initargs)))) 2593 2610 (if (eq (class-of gf) +the-standard-generic-function-class+) 2594 (std-add-method gf method) 2611 (progn 2612 (std-add-method gf method) 2613 (map-dependents gf 2614 #'(lambda (dep) 2615 (update-dependent gf dep 'add-method method)))) 2595 2616 (add-method gf method)) 2596 2617 method))) … … 3391 3412 class t all-keys 3392 3413 nil 'reinitialize-instance) 3393 (apply #'std-after-initialization-for-classes class all-keys)) 3414 (apply #'std-after-initialization-for-classes class all-keys) 3415 (map-dependents class #'(lambda (dep) (update-dependent class dep all-keys)))) 3416 3417 (defmethod reinitialize-instance :after ((class funcallable-standard-class) 3418 &rest all-keys) 3419 (remhash class *make-instance-initargs-cache*) 3420 (remhash class *reinitialize-instance-initargs-cache*) 3421 (%make-instances-obsolete class) 3422 (setf (class-finalized-p class) nil) 3423 (check-initargs (list #'allocate-instance 3424 #'initialize-instance) 3425 (list* class all-keys) 3426 class t all-keys 3427 nil 'reinitialize-instance) 3428 (apply #'std-after-initialization-for-classes class all-keys) 3429 (map-dependents class #'(lambda (dep) (update-dependent class dep all-keys)))) 3430 3431 (defmethod reinitialize-instance :after ((gf standard-generic-function) 3432 &rest all-keys) 3433 (map-dependents gf #'(lambda (dep) (update-dependent gf dep all-keys)))) 3394 3434 3395 3435 ;;; Finalize inheritance … … 3687 3727 (std-add-method generic-function method)) 3688 3728 3729 (defmethod add-method :after ((generic-function standard-generic-function) 3730 (method method)) 3731 (map-dependents generic-function 3732 #'(lambda (dep) (update-dependent generic-function dep 3733 'add-method method)))) 3734 3689 3735 (defgeneric remove-method (generic-function method)) 3690 3736 3691 (defmethod remove-method ((generic-function standard-generic-function) method) 3737 (defmethod remove-method ((generic-function standard-generic-function) 3738 (method method)) 3692 3739 (std-remove-method generic-function method)) 3740 3741 (defmethod remove-method :after ((generic-function standard-generic-function) 3742 (method method)) 3743 (map-dependents generic-function 3744 #'(lambda (dep) (update-dependent generic-function dep 3745 'remove-method method)))) 3693 3746 3694 3747 ;; See describe.lisp. … … 3820 3873 (remove method (slot-value specializer 'direct-methods))))) 3821 3874 3875 ;;; The Dependent Maintenance Protocol (AMOP pg. 160ff.) 3876 3877 (defvar *dependents* (make-hash-table :test 'eq :weakness :key)) 3878 3879 ;;; AMOP pg. 164 3880 (defgeneric add-dependent (metaobject dependent)) 3881 (defmethod add-dependent ((metaobject standard-class) dependent) 3882 (pushnew dependent (gethash metaobject *dependents* nil))) 3883 (defmethod add-dependent ((metaobject funcallable-standard-class) dependent) 3884 (pushnew dependent (gethash metaobject *dependents* nil))) 3885 (defmethod add-dependent ((metaobject standard-generic-function) dependent) 3886 (pushnew dependent (gethash metaobject *dependents* nil))) 3887 3888 ;;; AMOP pg. 225 3889 (defgeneric remove-dependent (metaobject dependent)) 3890 (defmethod remove-dependent ((metaobject standard-class) dependent) 3891 (setf (gethash metaobject *dependents*) 3892 (delete dependent (gethash metaobject *dependents* nil) :test #'eq))) 3893 (defmethod remove-dependent ((metaobject funcallable-standard-class) dependent) 3894 (setf (gethash metaobject *dependents*) 3895 (delete dependent (gethash metaobject *dependents* nil) :test #'eq))) 3896 (defmethod remove-dependent ((metaobject standard-generic-function) dependent) 3897 (setf (gethash metaobject *dependents*) 3898 (delete dependent (gethash metaobject *dependents* nil) :test #'eq))) 3899 3900 ;;; AMOP pg. 210 3901 (atomic-defgeneric map-dependents (metaobject function) 3902 (:method ((metaobject standard-class) function) 3903 (dolist (dependent (gethash metaobject *dependents* nil)) 3904 (funcall function dependent))) 3905 (:method ((metaobject funcallable-standard-class) function) 3906 (dolist (dependent (gethash metaobject *dependents* nil)) 3907 (funcall function dependent))) 3908 (:method ((metaobject standard-generic-function) function) 3909 (dolist (dependent (gethash metaobject *dependents* nil)) 3910 (funcall function dependent)))) 3911 3912 ;;; AMOP pg. 239 3913 (defgeneric update-dependent (metaobject dependent &rest initargs)) 3914 3915 3822 3916 ;;; SLIME compatibility functions. 3823 3917 -
trunk/abcl/src/org/armedbear/lisp/mop.lisp
r13837 r13877 83 83 extract-lambda-list 84 84 extract-specializer-names 85 )) 85 86 add-dependent 87 remove-dependent 88 map-dependents 89 update-dependent)) 86 90 87 91 (provide 'mop)
Note: See TracChangeset
for help on using the changeset viewer.