1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00

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.
This commit is contained in:
Andy Wingo 2015-01-12 21:40:29 +01:00
parent 91ff8e9251
commit 06d54b3f70
2 changed files with 9 additions and 18 deletions

View file

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

View file

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