[alexandria-cvs] [alexandria.git] updated branch master: 0358465... faster WHICHEVER

[Nikodemus Siivola]

The branch master has been updated:
       via  035846561e47e1f7531f21e49cacc58f007cfc9b (commit)
      from  66bd88d5eab762a6080ec4be197b82570d9e7b49 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 035846561e47e1f7531f21e49cacc58f007cfc9b
Author: Nikodemus Siivola <nikodemus at random-state.net>
Date:   Mon Mar 8 10:46:37 2010 +0200

    faster WHICHEVER
    
    O(log n) instead of O(n).
    
     Patch by: Gustavo <gugamilare at gmail.com>

-----------------------------------------------------------------------

Summary of changes:
 control-flow.lisp |   23 ++++++++++++++---------
 1 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/control-flow.lisp b/control-flow.lisp
index 42a88f9..bf64728 100644
--- a/control-flow.lisp
+++ b/control-flow.lisp
@@ -52,15 +52,20 @@ returns the values of DEFAULT if no keys match."
   (setf possibilities (mapcar (lambda (p) (macroexpand p env)) possibilities))
   (if (every (lambda (p) (constantp p)) possibilities)
       `(svref (load-time-value (vector , at possibilities)) (random ,(length possibilities)))
-      (with-gensyms (function)
-        `(let ((,function (lambda () ,(pop possibilities))))
-           (declare (function ,function))
-           ,@(let ((p 1))
-               (mapcar (lambda (possibility)
-                         `(when (zerop (random ,(incf p)))
-                            (setf ,function (lambda () ,possibility))))
-                       possibilities))
-           (funcall ,function)))))
+      (labels ((expand (possibilities position random-number)
+                 (if (null (cdr possibilities))
+                     (car possibilities)
+                     (let* ((length (length possibilities))
+                            (half (truncate length 2))
+                            (second-half (nthcdr half possibilities))
+                            (first-half (butlast possibilities (- length half))))
+                       `(if (< ,random-number ,(+ position half))
+                            ,(expand first-half position random-number)
+                            ,(expand second-half (+ position half) random-number))))))
+        (with-gensyms (random-number)
+          (let ((length (length possibilities)))
+            `(let ((,random-number (random ,length)))
+               ,(expand possibilities 0 random-number)))))))
 
 (defmacro xor (&rest datums)
   "Evaluates its argument one at a time, from left to right. If more then one
-- 
Alexandria hooks/post-receive