1 ;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006, 2008, 2012 Free Software Foundation, Inc.
3 ;;;; This library is free software; you can redistribute it and/or
4 ;;;; modify it under the terms of the GNU Lesser General Public
5 ;;;; License as published by the Free Software Foundation; either
6 ;;;; version 3 of the License, or (at your option) any later version.
8 ;;;; This library is distributed in the hope that it will be useful,
9 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 ;;;; Lesser General Public License for more details.
13 ;;;; You should have received a copy of the GNU Lesser General Public
14 ;;;; License along with this library; if not, write to the Free Software
15 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 (define-module (oop goops util)
20 :export (mapappend find-duplicate
21 map* for-each* length* improper->proper)
22 :use-module (srfi srfi-1)
23 :re-export (any every)
32 (define mapappend append-map)
34 (define (find-duplicate l) ; find a duplicate in a list; #f otherwise
37 ((memv (car l) (cdr l)) (car l))
38 (else (find-duplicate (cdr l)))))
40 (define (map* fn . l) ; A map which accepts dotted lists (arg lists
41 (cond ; must be "isomorph"
43 ((pair? (car l)) (cons (apply fn (map car l))
44 (apply map* fn (map cdr l))))
47 (define (for-each* fn . l) ; A for-each which accepts dotted lists (arg lists
48 (cond ; must be "isomorph"
50 ((pair? (car l)) (apply fn (map car l)) (apply for-each* fn (map cdr l)))
56 ((not (pair? ls)) n)))
58 (define (improper->proper ls)
60 (cons (car ls) (improper->proper (cdr ls)))