Loading control-flow.lisp +21 −16 Original line number Diff line number Diff line Loading @@ -50,8 +50,14 @@ returns the values of T or OTHERWISE if no keys match." (defmacro whichever (&rest possibilities &environment env) "Evaluates exactly one of POSSIBILITIES, chosen at random." (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))) (let ((length (length possibilities))) (cond ((= 1 length) (first possibilities)) ((every #'constantp possibilities) `(svref (load-time-value (vector ,@possibilities)) (random ,length))) (T (labels ((expand (possibilities position random-number) (if (null (cdr possibilities)) (car possibilities) Loading @@ -63,9 +69,8 @@ returns the values of T or OTHERWISE if no keys match." ,(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))))))) ,(expand possibilities 0 random-number)))))))) (defmacro xor (&rest datums) "Evaluates its arguments one at a time, from left to right. If more than one Loading tests.lisp +9 −0 Original line number Diff line number Diff line Loading @@ -188,6 +188,15 @@ (and (member x '(1 2 3)) t)) t) ;; https://gitlab.common-lisp.net/alexandria/alexandria/issues/13 (deftest whichever.3 (multiple-value-bind (code warnings?) (compile nil `(lambda (x) (whichever (1+ x)))) (and (not warnings?) (= 6 (funcall code 5)))) t) (deftest xor.1 (xor nil nil 1 nil) 1 Loading Loading
control-flow.lisp +21 −16 Original line number Diff line number Diff line Loading @@ -50,8 +50,14 @@ returns the values of T or OTHERWISE if no keys match." (defmacro whichever (&rest possibilities &environment env) "Evaluates exactly one of POSSIBILITIES, chosen at random." (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))) (let ((length (length possibilities))) (cond ((= 1 length) (first possibilities)) ((every #'constantp possibilities) `(svref (load-time-value (vector ,@possibilities)) (random ,length))) (T (labels ((expand (possibilities position random-number) (if (null (cdr possibilities)) (car possibilities) Loading @@ -63,9 +69,8 @@ returns the values of T or OTHERWISE if no keys match." ,(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))))))) ,(expand possibilities 0 random-number)))))))) (defmacro xor (&rest datums) "Evaluates its arguments one at a time, from left to right. If more than one Loading
tests.lisp +9 −0 Original line number Diff line number Diff line Loading @@ -188,6 +188,15 @@ (and (member x '(1 2 3)) t)) t) ;; https://gitlab.common-lisp.net/alexandria/alexandria/issues/13 (deftest whichever.3 (multiple-value-bind (code warnings?) (compile nil `(lambda (x) (whichever (1+ x)))) (and (not warnings?) (= 6 (funcall code 5)))) t) (deftest xor.1 (xor nil nil 1 nil) 1 Loading