mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 22:10:21 +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:
parent
91ff8e9251
commit
06d54b3f70
2 changed files with 9 additions and 18 deletions
|
@ -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 (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)))
|
(let* ((name (get-keyword #:name options (make-unbound)))
|
||||||
(supers (if (not (or-map (lambda (class)
|
(supers (if (not (or-map (lambda (class)
|
||||||
(memq <object>
|
(memq <object>
|
||||||
|
|
|
@ -17,24 +17,12 @@
|
||||||
|
|
||||||
|
|
||||||
(define-module (oop goops util)
|
(define-module (oop goops util)
|
||||||
:export (find-duplicate
|
#:export (map* for-each* length*))
|
||||||
map* for-each* length* improper->proper)
|
|
||||||
:use-module (srfi srfi-1)
|
|
||||||
:re-export (any every)
|
|
||||||
:no-backtrace
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; {Utilities}
|
;;; {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
|
(define (map* fn . l) ; A map which accepts dotted lists (arg lists
|
||||||
(cond ; must be "isomorph"
|
(cond ; must be "isomorph"
|
||||||
((null? (car l)) '())
|
((null? (car l)) '())
|
||||||
|
@ -52,8 +40,3 @@
|
||||||
(do ((n 0 (+ 1 n))
|
(do ((n 0 (+ 1 n))
|
||||||
(ls ls (cdr ls)))
|
(ls ls (cdr ls)))
|
||||||
((not (pair? ls)) n)))
|
((not (pair? ls)) n)))
|
||||||
|
|
||||||
(define (improper->proper ls)
|
|
||||||
(if (pair? ls)
|
|
||||||
(cons (car ls) (improper->proper (cdr ls)))
|
|
||||||
(list ls)))
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue