home *** CD-ROM | disk | FTP | other *** search
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; ;;
- ;; EuLisp Module Copyright (C) University of Bath 1991 ;;
- ;; ;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- (defmodule classy
-
- (standard0) ()
-
- (defun class-slots (cl)
- (mapcar slot-description-name
- (class-slot-descriptions cl)))
-
- (defun class-hierarchy ()
- (do-class-hierarchy (list object) 0))
-
- (defun do-class-hierarchy (objlist depth)
- (print-indent (car objlist) depth)
- (if (class-slots (car objlist))
- (progn
- (prin "slots: ")
- (print-indent (class-slots (car objlist)) depth))
- nil)
- (if (class-direct-subclasses (car objlist))
- (do-class-hierarchy (class-direct-subclasses (car objlist))
- (+ depth 4))
- nil)
- (if (cdr objlist)
- (do-class-hierarchy (cdr objlist) depth)
- nil))
-
- (defun print-indent (obj depth)
- (if (= depth 0)
- (print obj)
- (progn
- (prin " ")
- (print-indent obj (- depth 1)))))
-
- (export class-hierarchy)
-
- )
-
-