[Guile-commits] 01/25: GOOPS cleanup to use SRFI-1 better

[Andy Wingo]

wingo pushed a commit to branch wip-goops-refactor
in repository guile.

commit 94494895c5f437e584eac2edbdca7295a869761d
Author: Andy Wingo <address@hidden>
Date:   Mon Jan 12 21:16:25 2015 +0100

    GOOPS cleanup to use SRFI-1 better
    
    * module/oop/goops.scm (class-subclasses, class-methods): Reimplement
      using stock SRFI-1 procedures.
---
 module/oop/goops.scm |   46 +++++++++++-----------------------------------
 1 files changed, 11 insertions(+), 35 deletions(-)

diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 7891930..afbc31c 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -236,6 +236,17 @@
   "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?
 ;;
@@ -2637,41 +2648,6 @@ var{initargs}."
                 ))
 
 ;;;
-;;; {<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}
 ;;;