/usr/share/common-lisp/source/closer-mop/closer-scl.lisp is in cl-closer-mop 2:0.6-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | (in-package :closer-mop)
(defgeneric add-direct-method (specializer method)
(:method ((specializer standard-object) (method method))))
(defgeneric remove-direct-method (specializer method)
(:method ((specializer standard-object) (method method))))
(defvar *dependents* (make-hash-table :test #'eq))
(defgeneric add-dependent (metaobject dependent)
(:method ((metaobject standard-class) dependent)
(pushnew dependent (gethash metaobject *dependents*)))
(:method ((metaobject funcallable-standard-class) dependent)
(pushnew dependent (gethash metaobject *dependents*)))
(:method ((metaobject standard-generic-function) dependent)
(pushnew dependent (gethash metaobject *dependents*))))
(defgeneric remove-dependent (metaobject dependent)
(:method ((metaobject standard-class) dependent)
(setf (gethash metaobject *dependents*)
(delete metaobject (gethash metaobject *dependents*))))
(:method ((metaobject funcallable-standard-class) dependent)
(setf (gethash metaobject *dependents*)
(delete metaobject (gethash metaobject *dependents*))))
(:method ((metaobject standard-generic-function) dependent)
(setf (gethash metaobject *dependents*)
(delete metaobject (gethash metaobject *dependents*)))))
(defgeneric map-dependents (metaobject function)
(:method ((metaobject standard-class) function)
(mapc function (gethash metaobject *dependents*)))
(:method ((metaobject funcallable-standard-class) function)
(mapc function (gethash metaobject *dependents*)))
(:method ((metaobject standard-generic-function) function)
(mapc function (gethash metaobject *dependents*))))
(defgeneric update-dependent (metaobject dependent &rest initargs))
(defmethod reinitialize-instance :after ((metaobject metaobject) &rest initargs)
(declare (dynamic-extent initargs))
(map-dependents metaobject (lambda (dep) (apply #'update-dependent metaobject dep initargs))))
(defmethod add-method :after
((gf standard-generic-function) method)
(loop for specializer in (method-specializers method)
do (add-direct-method specializer method))
(map-dependents gf (lambda (dep) (update-dependent gf dep 'add-method method))))
(defmethod remove-method :after
((gf standard-generic-function) method)
(loop for specializer in (method-specializers method)
do (remove-direct-method specializer method))
(map-dependents gf (lambda (dep) (update-dependent gf dep 'remove-method method))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(pushnew :closer-mop *features*))
|