From ada02b061aac7cbbf43145beaf5d27d78f9e9fcc Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 8 Mar 2010 10:46:37 +0200
Subject: [PATCH] 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@gmail.com>
---
 control-flow.lisp | 23 ++++++++++++++---------
 1 file 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 ,@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
-- 
GitLab