[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
RE: Is there an example of a function that will
- To: Info-MCL@cambridge.apple.com
- Subject: RE: Is there an example of a function that will
- From: "pierce" <pierce@at-mail-server.vitro.com>
- Date: 25 Jun 92 09:42:26 U
Luke,
>I am looking for a recursive version of class-direct-subclasses that will
>return all the classes in a list.
There is not a version built into MCL since the CLOS implementation doesn't
need it.
Try the following:
(defmacro deftransitive-closure (r1 r2)
`(defmethod ,r1 ((thing t)) (standard-transitive-closure-internal ',r2
thing nil)))
(defmethod standard-transitive-closure-internal ((r2 symbol) (thing t)
(ancestors-so-far list))
(let (parents ancestors)
(setf parents (funcall r2 thing))
(setf ancestors parents)
(loop
for p in (set-difference parents ancestors-so-far)
as local-ancestors = (standard-transitive-closure-internal r2 p
`(,@ancestors-so-far ,p)) do
(setf ancestors (union ancestors local-ancestors)))
ancestors))
(deftransitive-closure class-effective-subclasses class-direct-subclasses)
#|
;;; Example
(defclass c1 () ())
(defclass c2 (c1) ())
(defclass c3 (c2) ())
(class-effective-subclasses (find-class 'c1))
|#
-Jonathan