From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Kevin Ryde Newsgroups: gmane.lisp.guile.devel Subject: filter-map tail recursion Date: Wed, 01 Dec 2004 10:18:46 +1100 Message-ID: <87vfbndiy1.fsf@zip.com.au> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1101942506 24831 80.91.229.6 (1 Dec 2004 23:08:26 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Wed, 1 Dec 2004 23:08:26 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Thu Dec 02 00:08:22 2004 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1CZda9-00072L-00 for ; Thu, 02 Dec 2004 00:08:21 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1CZdje-0001KN-8e for guile-devel@m.gmane.org; Wed, 01 Dec 2004 18:18:10 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.33) id 1CZdjZ-0001KI-6K for guile-devel@gnu.org; Wed, 01 Dec 2004 18:18:05 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.33) id 1CZdjY-0001K6-Mp for guile-devel@gnu.org; Wed, 01 Dec 2004 18:18:04 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1CZdjY-0001K3-Jf for guile-devel@gnu.org; Wed, 01 Dec 2004 18:18:04 -0500 Original-Received: from [61.8.0.85] (helo=mailout2.pacific.net.au) by monty-python.gnu.org with esmtp (Exim 4.34) id 1CZdZm-0006pX-GM for guile-devel@gnu.org; Wed, 01 Dec 2004 18:07:59 -0500 Original-Received: from mailproxy1.pacific.net.au (mailproxy1.pacific.net.au [61.8.0.86]) by mailout2.pacific.net.au (8.12.3/8.12.3/Debian-7.1) with ESMTP id iB1N7tKP021057 for ; Thu, 2 Dec 2004 10:07:55 +1100 Original-Received: from localhost (ppp2447.dyn.pacific.net.au [61.8.36.71]) by mailproxy1.pacific.net.au (8.12.3/8.12.3/Debian-7.1) with ESMTP id iB1N7rPm012236 for ; Thu, 2 Dec 2004 10:07:54 +1100 Original-Received: from gg by localhost with local (Exim 3.36 #1 (Debian)) id 1CZHGi-0000bK-00; Wed, 01 Dec 2004 10:18:48 +1100 Original-To: guile-devel@gnu.org Mail-Copies-To: never User-Agent: Gnus/5.110003 (No Gnus v0.3) Emacs/21.3 (gnu/linux) 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: main.gmane.org gmane.lisp.guile.devel:4459 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:4459 --=-=-= * srfi-1.scm (filter-map): Use tail recursion, to avoid stack overflow. I'm thinking of this for 1.6 too, if 1.8 is still a while away. And various other tail recursions I've put just in 1.8 too. Hitting overflows on just a few thousand elements is no fun. --=-=-= Content-Disposition: inline; filename=srfi-1.scm.filter-map.diff --- srfi-1.scm.~1.33.~ 2004-08-27 10:14:23.000000000 +1000 +++ srfi-1.scm 2004-09-28 17:59:16.000000000 +1000 @@ -567,20 +567,22 @@ (define (filter-map f clist1 . rest) (if (null? rest) - (let lp ((l clist1)) + (let lp ((l clist1) + (rl '())) (if (null? l) - '() + (reverse! rl) (let ((res (f (car l)))) (if res - (cons res (lp (cdr l))) - (lp (cdr l)))))) - (let lp ((l (cons clist1 rest))) + (lp (cdr l) (cons res rl)) + (lp (cdr l) rl))))) + (let lp ((l (cons clist1 rest)) + (rl '())) (if (any1 null? l) - '() + (reverse! rl) (let ((res (apply f (map1 car l)))) (if res - (cons res (lp (map1 cdr l))) - (lp (map1 cdr l)))))))) + (lp (map1 cdr l) (cons res rl)) + (lp (map1 cdr l) rl))))))) ;;; Filtering & partitioning --=-=-= Content-Disposition: inline; filename=srfi-1.test.filter-map.diff --- srfi-1.test.~1.9.~ 2003-12-03 08:18:16.000000000 +1100 +++ srfi-1.test 2004-11-30 17:54:42.000000000 +1100 @@ -458,6 +458,50 @@ (drop '(a b . c) 2)))) ;; +;; filter-map +;; + +(with-test-prefix "filter-map" + + (with-test-prefix "one list" + (pass-if "(1)" + (equal? '(1) (filter-map noop '(1)))) + + (pass-if "(#f)" + (equal? '() (filter-map noop '(#f)))) + + (pass-if "(1 2)" + (equal? '(1 2) (filter-map noop '(1 2)))) + + (pass-if "(#f 2)" + (equal? '(2) (filter-map noop '(#f 2)))) + + (pass-if "(#f #f)" + (equal? '() (filter-map noop '(#f #f)))) + + (pass-if "(1 2 3)" + (equal? '(1 2 3) (filter-map noop '(1 2 3)))) + + (pass-if "(#f 2 3)" + (equal? '(2 3) (filter-map noop '(#f 2 3)))) + + (pass-if "(1 #f 3)" + (equal? '(1 3) (filter-map noop '(1 #f 3)))) + + (pass-if "(1 2 #f)" + (equal? '(1 2) (filter-map noop '(1 2 #f))))) + + (with-test-prefix "two lists" + (pass-if "(1 2 3) (4 5 6)" + (equal? '(1 2 3) (filter-map noop '(1 2 3) '(4 5 6)))) + + (pass-if "(#f 2 3) (4 5)" + (equal? '(2) (filter-map noop '(#f 2 3) '(4 5)))) + + (pass-if "(4 #f) (1 2 3)" + (equal? '(4) (filter-map noop '(4 #f) '(1 2 3)))))) + +;; ;; length+ ;; --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://lists.gnu.org/mailman/listinfo/guile-devel --=-=-=--