diff --git a/control-flow.lisp b/control-flow.lisp index 42a88f9d862cca31699a3d71b6d996f33603a733..bf64728de756219fa9e32368dd30454f5a2755cc 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