>From 1770fbcd2624f60588fcde7fe5963f89b87fea55 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Wed, 22 May 2013 19:36:54 +0200 Subject: [PATCH] Replace SRFI-1's PARTITION procedure with a faster implementation, provided by Joerg Wittenberger --- srfi-1.scm | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/srfi-1.scm b/srfi-1.scm index 16041e6..a347fea 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 -- 1.8.2.3