[alexandria.git] updated branch master: ada02b0... faster WHICHEVER

[Nikodemus Siivola]

The branch master has been updated:
       via  ada02b061aac7cbbf43145beaf5d27d78f9e9fcc (commit)
      from  d4a72df548269ed8cffb35876307c6ecb20625c1 (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 ada02b061aac7cbbf43145beaf5d27d78f9e9fcc
Author: Nikodemus Siivola <nikodemus at random-state.net>
Date:   Mon Mar 8 10:46:37 2010 +0200

    faster WHICHEVER
    
     Call RANDOM just once, and build an inline binary search tree
     for O(log n) goodness 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