From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: ludo@gnu.org (Ludovic =?iso-8859-1?Q?Court=E8s?=) Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Remove duplicated code in `(oop goops util)' Date: Thu, 13 Mar 2008 15:39:38 +0100 Message-ID: <87wso6adsl.fsf@gnu.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1205419231 1716 80.91.229.12 (13 Mar 2008 14:40:31 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 13 Mar 2008 14:40:31 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Thu Mar 13 15:40:59 2008 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1JZobm-0006ig-7f for guile-devel@m.gmane.org; Thu, 13 Mar 2008 15:40:38 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JZobD-0001wK-7v for guile-devel@m.gmane.org; Thu, 13 Mar 2008 10:40:03 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1JZob5-0001wF-Hk for guile-devel@gnu.org; Thu, 13 Mar 2008 10:39:55 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1JZob4-0001vw-3J for guile-devel@gnu.org; Thu, 13 Mar 2008 10:39:55 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1JZob3-0001vt-Ng for guile-devel@gnu.org; Thu, 13 Mar 2008 10:39:53 -0400 Original-Received: from main.gmane.org ([80.91.229.2] helo=ciao.gmane.org) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1JZob3-00085L-1c for guile-devel@gnu.org; Thu, 13 Mar 2008 10:39:53 -0400 Original-Received: from list by ciao.gmane.org with local (Exim 4.43) id 1JZoay-0001WC-KM for guile-devel@gnu.org; Thu, 13 Mar 2008 14:39:49 +0000 Original-Received: from 193.50.110.109 ([193.50.110.109]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 13 Mar 2008 14:39:48 +0000 Original-Received: from ludo by 193.50.110.109 with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 13 Mar 2008 14:39:48 +0000 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 92 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: 193.50.110.109 X-Revolutionary-Date: 24 =?iso-8859-1?Q?Vent=F4se?= an 216 de la =?iso-8859-1?Q?R=E9volution?= X-PGP-Key-ID: 0xEB1F5364 X-PGP-Key: http://www.laas.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 821D 815D 902A 7EAB 5CEE D120 7FBA 3D4F EB1F 5364 X-OS: i686-pc-linux-gnu User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/22.1 (gnu/linux) Cancel-Lock: sha1:Rs+pNxNoNEqB0IqhGJBk08cGdkk= X-detected-kernel: by monty-python.gnu.org: Linux 2.6, seldom 2.4 (older, 4) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:7069 Archived-At: --=-=-= Hi, Would there be any objections to the patch below? It removes code that duplicates SRFI-1. For `mapappend', the substitute uses a (slightly) more efficient algorithm AFAICS. Given N M-element lists, I think we have: old `mapappend' -> O(M * 3N) `append-map' -> O(M * (1 + N)) Checking whether this is correct is left as an exercise to the reader... Thanks, Ludovic. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename*=us-ascii''%2c%2cgoops-util.diff Content-Description: The patch --- /home/ludo/src/guile/1.8/guile-core/oop/goops/util.scm.~1.8.2.1.~ 2006-02-12 14:42:52.000000000 +0100 +++ /home/ludo/src/guile/1.8/guile-core/oop/goops/util.scm 2008-03-12 18:12:06.000000000 +0100 @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006, 2008 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -17,9 +17,10 @@ (define-module (oop goops util) - :export (any every - mapappend find-duplicate top-level-env top-level-env? + :export (mapappend find-duplicate top-level-env top-level-env? map* for-each* length* improper->proper) + :use-module (srfi srfi-1) + :re-export (any every) :no-backtrace ) @@ -28,43 +29,7 @@ ;;; {Utilities} ;;; -(define (any pred lst . rest) - (if (null? rest) ;fast path - (and (not (null? lst)) - (let loop ((head (car lst)) (tail (cdr lst))) - (if (null? tail) - (pred head) - (or (pred head) - (loop (car tail) (cdr tail)))))) - (let ((lsts (cons lst rest))) - (and (not (any null? lsts)) - (let loop ((heads (map car lsts)) (tails (map cdr lsts))) - (if (any null? tails) - (apply pred heads) - (or (apply pred heads) - (loop (map car tails) (map cdr tails))))))))) - -(define (every pred lst . rest) - (if (null? rest) ;fast path - (or (null? lst) - (let loop ((head (car lst)) (tail (cdr lst))) - (if (null? tail) - (pred head) - (and (pred head) - (loop (car tail) (cdr tail)))))) - (let ((lsts (cons lst rest))) - (or (any null? lsts) - (let loop ((heads (map car lsts)) (tails (map cdr lsts))) - (if (any null? tails) - (apply pred heads) - (and (apply pred heads) - (loop (map car tails) (map cdr tails))))))))) - -(define (mapappend func . args) - (if (memv '() args) - '() - (append (apply func (map car args)) - (apply mapappend func (map cdr args))))) +(define mapappend append-map) (define (find-duplicate l) ; find a duplicate in a list; #f otherwise (cond --=-=-=--