~ chicken-core (chicken-5) f4bf8ca5b47f06563f17004e95c5e049c4e69f9b

commit f4bf8ca5b47f06563f17004e95c5e049c4e69f9b
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Wed May 22 19:36:54 2013 +0200
Commit:     Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Sat Jun 29 20:34:07 2013 +0200

    Replace SRFI-1's PARTITION procedure with a faster implementation, provided by Joerg Wittenberger
    
    Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>

diff --git a/srfi-1.scm b/srfi-1.scm
index 16041e65..a347fea9 100644
--- a/srfi-1.scm
+++ b/srfi-1.scm
@@ -1115,21 +1115,24 @@
 		  ans)))))
 
 
+;;; This version does not share common tails like the reference impl does.
+;;; Kindly suggested by Joerg Wittenberger on 20-05-2013.
 
-;;; Answers share common tail with LIS where possible; 
-;;; the technique is slightly subtle.
-
-(define (partition pred lis)
+(define (partition pred lst)
 ;  (check-arg procedure? pred partition)
-  (let recur ((lis lis))
-    (if (null-list? lis) (values lis lis)	; Use NOT-PAIR? to handle dotted lists.
-	(let ((elt (car lis))
-	      (tail (cdr lis)))
-	  (receive (in out) (recur tail)
-	    (if (pred elt)
-		(values (if (pair? out) (cons elt in) lis) out)
-		(values in (if (pair? in) (cons elt out) lis))))))))
-
+  (let ((t (cons #f '()))
+	(f (cons #f '())))
+    (let ((tl t) (fl f))
+      (do ((lst lst (cdr lst)))
+	  ((null? lst) (values (cdr t) (cdr f)))
+	(let ((elt (car lst)))
+	  (if (pred elt)
+	      (let ((p (cons elt (cdr tl))))
+		(set-cdr! tl p)
+		(set! tl p))
+	      (let ((p (cons elt (cdr fl))))
+		(set-cdr! fl p)
+		(set! fl p))))))))
 
 
 ;(define (partition! pred lis)			; Things are much simpler