From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Matthias Koeppe Newsgroups: gmane.lisp.guile.devel Subject: [Patch] Re-implement srfi-1 partition in C to avoid stack overflow Date: Thu, 19 Jun 2003 17:58:10 +0200 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1056039311 8754 80.91.224.249 (19 Jun 2003 16:15:11 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Thu, 19 Jun 2003 16:15:11 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Thu Jun 19 18:15:07 2003 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 19T243-0002Gl-00 for ; Thu, 19 Jun 2003 18:15:07 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.20) id 19T1oe-0006br-IE for guile-devel@m.gmane.org; Thu, 19 Jun 2003 11:59:12 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.20) id 19T1o8-00063X-Ju for guile-devel@gnu.org; Thu, 19 Jun 2003 11:58:40 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.20) id 19T1nm-0004rc-4O for guile-devel@gnu.org; Thu, 19 Jun 2003 11:58:21 -0400 Original-Received: from merkur.math.uni-magdeburg.de ([141.44.75.40]) by monty-python.gnu.org with esmtp (Exim 4.20) id 19T1nk-0004mW-KW for guile-devel@gnu.org; Thu, 19 Jun 2003 11:58:16 -0400 Original-Received: from beta ([141.44.75.78] helo=beta.math.uni-magdeburg.de) by merkur.math.uni-magdeburg.de with esmtp (Exim 4.10) id 19T1nf-0003rz-00 for guile-devel@gnu.org; Thu, 19 Jun 2003 17:58:11 +0200 Original-Received: (from mkoeppe@localhost) by beta.math.uni-magdeburg.de (8.11.7+Sun/8.11.7) id h5JFwAi20406; Thu, 19 Jun 2003 17:58:10 +0200 (MEST) X-Authentication-Warning: beta.math.uni-magdeburg.de: mkoeppe set sender to mkoeppe@mail.math.uni-magdeburg.de using -f Original-To: guile-devel@gnu.org Original-Lines: 154 X-Warning: no 'abuse'-account in domain mail.math.uni-magdeburg.de (cf. RFC2142/4.) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1b5 Precedence: list List-Id: Developers list for Guile, the GNU extensibility library List-Help: List-Post: List-Subscribe: , List-Archive: List-Unsubscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:2562 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:2562 The partition procedure in srfi-1 does not work well in Guile. Even for not-very-long input lists (like 500 elements), a stack overflow is signaled. The reason seems to be the recursive use of receive and values. Here is the srfi/ChangeLog entry: 2003-06-19 Matthias Koeppe * srfi-1.c (scm_srfi1_partition), srfi-1.scm (partition): Re-implement in C to avoid stack overflows for long input lists. Index: test-suite/tests/srfi-1.test =================================================================== RCS file: /cvs/guile/guile-core/test-suite/tests/srfi-1.test,v retrieving revision 1.2 diff -u -c -r1.2 srfi-1.test *** test-suite/tests/srfi-1.test 12 May 2003 23:05:50 -0000 1.2 --- test-suite/tests/srfi-1.test 19 Jun 2003 15:52:41 -0000 *************** *** 183,185 **** --- 183,229 ---- (pass-if "'(a b . c) 2" (equal? '(a b) (take '(a b . c) 2)))) + + ;; + ;; partition + ;; + + (define (test-partition pred list kept-good dropped-good) + (call-with-values (lambda () + (partition pred list)) + (lambda (kept dropped) + (and (equal? kept kept-good) + (equal? dropped dropped-good))))) + + (with-test-prefix "partition" + + (pass-if "with dropped tail" + (test-partition even? '(1 2 3 4 5 6 7) + '(2 4 6) '(1 3 5 7))) + + (pass-if "with kept tail" + (test-partition even? '(1 2 3 4 5 6) + '(2 4 6) '(1 3 5))) + + (pass-if "with everything dropped" + (test-partition even? '(1 3 5 7) + '() '(1 3 5 7))) + + (pass-if "with everything kept" + (test-partition even? '(2 4 6) + '(2 4 6) '())) + + (pass-if "with empty list" + (test-partition even? '() + '() '())) + + (pass-if "with reasonably long list" + ;; the old implementation from SRFI-1 reference implementation + ;; would signal a stack-overflow for a list of only 500 elements! + (call-with-values (lambda () + (partition even? + (make-list 10000 1))) + (lambda (even odd) + (and (= (length odd) 10000) + (= (length even) 0)))))) + Index: srfi/srfi-1.c =================================================================== RCS file: /cvs/guile/guile-core/srfi/srfi-1.c,v retrieving revision 1.6 diff -u -c -r1.6 srfi-1.c *** srfi/srfi-1.c 21 Apr 2003 01:59:57 -0000 1.6 --- srfi/srfi-1.c 19 Jun 2003 15:52:41 -0000 *************** *** 319,324 **** --- 319,364 ---- } #undef FUNC_NAME + SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0, + (SCM pred, SCM list), + "Partition the elements of @var{list} with predicate @var{pred}.\n" + "Return two values: the list of elements satifying @var{pred} and\n" + "the list of elements @emph{not} satisfying @var{pred}. The order\n" + "of the output lists follows the order of @var{list}. @var{list}\n" + "is not mutated. One of the output lists may share memory with @var{list}.\n") + #define FUNC_NAME s_scm_srfi1_partition + { + /* In this implementation, the output lists don't share memory with + list, because it's probably not worth the effort. */ + scm_t_trampoline_1 call = scm_trampoline_1(pred); + SCM kept = scm_cons(SCM_EOL, SCM_EOL); + SCM kept_tail = kept; + SCM dropped = scm_cons(SCM_EOL, SCM_EOL); + SCM dropped_tail = dropped; + + SCM_ASSERT(call, pred, 2, FUNC_NAME); + + for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR(list)) { + SCM elt = SCM_CAR(list); + SCM new_tail = scm_cons(SCM_CAR(list), SCM_EOL); + if (SCM_NFALSEP(call(pred, elt))) { + SCM_SETCDR(kept_tail, new_tail); + kept_tail = new_tail; + } + else { + SCM_SETCDR(dropped_tail, new_tail); + dropped_tail = new_tail; + } + } + /* re-use the initial conses for the values list */ + SCM_SETCAR(kept, SCM_CDR(kept)); + SCM_SETCDR(kept, dropped); + SCM_SETCAR(dropped, SCM_CDR(dropped)); + SCM_SETCDR(dropped, SCM_EOL); + return scm_values(kept); + } + #undef FUNC_NAME + void scm_init_srfi_1 (void) { Index: srfi/srfi-1.scm =================================================================== RCS file: /cvs/guile/guile-core/srfi/srfi-1.scm,v retrieving revision 1.24 diff -u -c -r1.24 srfi-1.scm *** srfi/srfi-1.scm 12 May 2003 23:02:01 -0000 1.24 --- srfi/srfi-1.scm 19 Jun 2003 15:52:41 -0000 *************** *** 662,676 **** ;;; Filtering & partitioning - (define (partition pred list) - (if (null? list) - (values '() '()) - (if (pred (car list)) - (receive (in out) (partition pred (cdr list)) - (values (cons (car list) in) out)) - (receive (in out) (partition pred (cdr list)) - (values in (cons (car list) out)))))) - (define (remove pred list) (filter (lambda (x) (not (pred x))) list)) --- 662,667 ---- -- Matthias Koeppe -- http://www.math.uni-magdeburg.de/~mkoeppe _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel