summaryrefslogtreecommitdiff
path: root/module/oop
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-01-12 21:40:29 +0100
committerAndy Wingo <wingo@pobox.com>2015-01-23 16:16:02 +0100
commit06d54b3f700b7da0540a707d6e4c26475622cb74 (patch)
tree62f1fa43224860a7a750cbcb18255357cdd3b927 /module/oop
parent91ff8e9251a7fb602518dca7eb1284256f55bec3 (diff)
GOOPS utils module cleanups
* module/oop/goops.scm (make-class): Inline find-duplicate to its use site. * module/oop/goops/util.scm (improper->proper): Remove unused function. (any, every): Don't re-export these from SRFI-1; users can get them from SRFI-1 directly.
Diffstat (limited to 'module/oop')
-rw-r--r--module/oop/goops.scm8
-rw-r--r--module/oop/goops/util.scm19
2 files changed, 9 insertions, 18 deletions
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 543acffe4..64c3d1182 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -1183,6 +1183,14 @@ followed by its associated value. If @var{l} does not hold a value for
;;;
(define (make-class supers slots . options)
+ (define (find-duplicate l)
+ (match l
+ (() #f)
+ ((head . tail)
+ (if (memq head tail)
+ head
+ (find-duplicate tail)))))
+
(let* ((name (get-keyword #:name options (make-unbound)))
(supers (if (not (or-map (lambda (class)
(memq <object>
diff --git a/module/oop/goops/util.scm b/module/oop/goops/util.scm
index fa486453b..8b48f98cc 100644
--- a/module/oop/goops/util.scm
+++ b/module/oop/goops/util.scm
@@ -17,24 +17,12 @@
(define-module (oop goops util)
- :export (find-duplicate
- map* for-each* length* improper->proper)
- :use-module (srfi srfi-1)
- :re-export (any every)
- :no-backtrace
- )
-
+ #:export (map* for-each* length*))
;;;
;;; {Utilities}
;;;
-(define (find-duplicate l) ; find a duplicate in a list; #f otherwise
- (cond
- ((null? l) #f)
- ((memv (car l) (cdr l)) (car l))
- (else (find-duplicate (cdr l)))))
-
(define (map* fn . l) ; A map which accepts dotted lists (arg lists
(cond ; must be "isomorph"
((null? (car l)) '())
@@ -52,8 +40,3 @@
(do ((n 0 (+ 1 n))
(ls ls (cdr ls)))
((not (pair? ls)) n)))
-
-(define (improper->proper ls)
- (if (pair? ls)
- (cons (car ls) (improper->proper (cdr ls)))
- (list ls)))