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 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)))