Commit fab0e59c authored by Philipp Marek's avatar Philipp Marek
Browse files

Fixed issue 13, WHICHEVER and single-argument calls.

parent fc2a2f5c
Loading
Loading
Loading
Loading
+21 −16
Original line number Diff line number Diff line
@@ -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)
@@ -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
+9 −0
Original line number Diff line number Diff line
@@ -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