GOOPS cleanup to use SRFI-1 better
authorAndy Wingo <wingo@pobox.com>
Mon, 12 Jan 2015 20:16:25 +0000 (21:16 +0100)
committerAndy Wingo <wingo@pobox.com>
Fri, 23 Jan 2015 15:16:02 +0000 (16:16 +0100)
* module/oop/goops.scm (class-subclasses, class-methods): Reimplement
  using stock SRFI-1 procedures.

module/oop/goops.scm

index ba3eade..543acff 100644 (file)
   "Return the slot list of the class @var{obj}."
   class-index-slots)
 
+(define (class-subclasses c)
+  (define (all-subclasses c)
+    (cons c (append-map all-subclasses
+                        (class-direct-subclasses c))))
+  (delete-duplicates (cdr (all-subclasses c)) eq?))
+
+(define (class-methods c)
+  (delete-duplicates (append-map class-direct-methods
+                                 (cons c (class-subclasses c)))
+                     eq?))
+
 ;;
 ;; is-a?
 ;;
@@ -2657,41 +2668,6 @@ var{initargs}."
                 no-method
                 ))
 
-;;;
-;;; {<composite-metaclass> and <active-metaclass>}
-;;;
-
-;(autoload "active-slot"    <active-metaclass>)
-;(autoload "composite-slot" <composite-metaclass>)
-;(export <composite-metaclass> <active-metaclass>)
-
-;;;
-;;; {Tools}
-;;;
-
-;; list2set
-;;
-;; duplicate the standard list->set function but using eq instead of
-;; eqv which really sucks a lot, uselessly here
-;;
-(define (list2set l)
-  (let loop ((l l)
-             (res '()))
-    (cond
-     ((null? l) res)
-     ((memq (car l) res) (loop (cdr l) res))
-     (else (loop (cdr l) (cons (car l) res))))))
-
-(define (class-subclasses c)
-  (letrec ((allsubs (lambda (c)
-                      (cons c (mapappend allsubs
-                                         (class-direct-subclasses c))))))
-    (list2set (cdr (allsubs c)))))
-
-(define (class-methods c)
-  (list2set (mapappend class-direct-methods
-                       (cons c (class-subclasses c)))))
-
 ;;;
 ;;; {Final initialization}
 ;;;