diff --git a/control-flow.lisp b/control-flow.lisp index 0aafb2afd42e27e24c8bed1b22b7cc508359460d..f2624436c3e44d86c7e1f8983ac96a67403bea51 100644 --- a/control-flow.lisp +++ b/control-flow.lisp @@ -68,7 +68,7 @@ returns the values of DEFAULT if no keys match." ,(expand possibilities 0 random-number))))))) (defmacro xor (&rest datums) - "Evaluates its argument one at a time, from left to right. If more then one + "Evaluates its arguments one at a time, from left to right. If more then one argument evaluates to a true value no further DATUMS are evaluated, and NIL is returned as both primary and secondary value. If exactly one argument evaluates to true, its value is returned as the primary value after all the @@ -100,7 +100,7 @@ NIL." `(nth-value-or ,nth-value ,@(rest forms)) nil)))))) -(defmacro multiple-value-prog2 (first-form second-form &body body) - "Like CL:MULTIPLE-VALUE-PROG1, except it saves the values of the -second form." - `(progn ,first-form (multiple-value-prog1 ,second-form ,@body))) +(defmacro multiple-value-prog2 (first-form second-form &body forms) + "Evaluates FIRST-FORM, then SECOND-FORM, and then FORMS. Yields as its value +all the value returned by SECOND-FORM." + `(progn ,first-form (multiple-value-prog1 ,second-form ,@forms))) diff --git a/package.lisp b/package.lisp index c7f9bf1584ac1718c116089021243f0ff7c6ce5b..b5ce17be443165c71d9da8723e4976440b4eb49b 100644 --- a/package.lisp +++ b/package.lisp @@ -13,16 +13,19 @@ ;; REVIEW IN PROGRESS ;; ;; Control flow + ;; + ;; -- no clear consensus yet -- #:cswitch #:eswitch #:switch + ;; -- problem free? -- #:multiple-value-prog2 - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; REVIEW PENDING - ;; #:nth-value-or #:whichever #:xor + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; REVIEW PENDING + ;; ;; Definitions #:define-constant ;; Hash tables diff --git a/tests.lisp b/tests.lisp index e2904cc021f37e5e7d1c8c237761e3dfc8d22752..c13956850ba38b0543c793423c9f42bcc510af16 100644 --- a/tests.lisp +++ b/tests.lisp @@ -138,6 +138,21 @@ (13.0 :oops)) :yay) +(deftest multiple-value-prog2.1 + (multiple-value-prog2 + (values 1 1 1) + (values 2 20 200) + (values 3 3 3)) + 2 20 200) + +(deftest nth-value-or.1 + (multiple-value-bind (a b c) + (nth-value-or 1 + (values 1 nil 1) + (values 2 2 2)) + (= a b c 2)) + t) + (deftest whichever.1 (let ((x (whichever 1 2 3))) (and (member x '(1 2 3)) t)) @@ -156,6 +171,16 @@ 1 t) +(deftest xor.2 + (xor nil nil 1 2) + nil + nil) + +(deftest xor.3 + (xor nil nil nil) + nil + t) + ;;;; Definitions (deftest define-constant.1 @@ -1677,14 +1702,6 @@ :type-error)) :type-error) -(deftest nth-value-or.1 - (multiple-value-bind (a b c) - (nth-value-or 1 - (values 1 nil 1) - (values 2 2 2)) - (= a b c 2)) - t) - (deftest doplist.1 (let (keys values) (doplist (k v '(a 1 b 2 c 3) (values t (reverse keys) (reverse values) k v))