Commit 130ac5c4 authored by Nikodemus Siivola's avatar Nikodemus Siivola

WHEN-LET* short circuits, IF-LET* deleted

parent 655212e0
......@@ -30,37 +30,6 @@ effect."
,then-form
,else-form))))
(defmacro if-let* (bindings then-form &optional else-form)
"Creates new variable bindings, and conditionally executes either THEN-FORM
or ELSE-FORM. ELSE-FORM defaults to NIL.
BINDINGS must be either single binding of the form:
(variable initial-form)
or a list of bindings of the form:
((variable-1 initial-form-1)
(variable-2 initial-form-2)
...
(variable-n initial-form-n))
Each initial-form is executed in turn, and the variable bound to the
corresponding value. Initial-form expressions can refer to variables
previously bound by the IF-LET*.
If all variables are true after the bindings are complete, the THEN-FORM is
executed with the bindings in effect, otherwise the ELSE-FORM is executed with
the bindings in effect."
(let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
(list bindings)
bindings))
(variables (mapcar #'car binding-list)))
`(let* ,binding-list
(if (and ,@variables)
,then-form
,else-form))))
(defmacro when-let (bindings &body forms)
"Creates new variable bindings, and conditionally executes FORMS.
......@@ -106,13 +75,19 @@ Each initial-form is executed in turn, and the variable bound to the
corresponding value. Initial-form expressions can refer to variables
previously bound by the IF-LET*.
If all variables are true after the bindings are complete, then FORMS are
executed as an implicit PROGN."
(let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
(list bindings)
bindings))
(variables (mapcar #'car binding-list)))
`(let* ,binding-list
(when (and ,@variables)
,@forms))))
Execution of WHEN-LET* stops immediately if any initial-form evaluates to NIL.
If all initial-forms evaluate to true, then FORMS are executed as an implicit
PROGN."
(let ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
(list bindings)
bindings)))
(labels ((bind (bindings forms)
(if bindings
`((let (,(car bindings))
(when ,(caar bindings)
,@(bind (cdr bindings) forms))))
forms)))
`(let (,(car binding-list))
(when ,(caar binding-list)
,@(bind (cdr binding-list) forms))))))
......@@ -4,7 +4,6 @@
(:export
;; Binding constructs
#:if-let
#:if-let*
#:when-let
#:when-let*
;; Definitions
......
......@@ -1493,34 +1493,6 @@
:type-error))
:type-error)
(deftest if-let*.1
(let ((x 1))
(if-let* ((x 2)
(y x))
(+ x y)
:oops))
4)
(deftest if-let*.2
(if-let* ((x 2)
(y (prog1 x (setf x nil))))
:oops
(and (not x) y))
2)
(deftest if-let*.3
(if-let* (x 1)
x
:oops)
1)
(deftest if-let*.error.1
(handler-case
(eval '(if-let* x :oops :oops))
(type-error ()
:type-error))
:type-error)
(deftest when-let.1
(when-let (x (opaque :ok))
(setf x (cons x x))
......@@ -1561,6 +1533,13 @@
(1+ x)))
2)
(deftest when-let*.3
(when-let* ((x t)
(y (consp x))
(z (error "OOPS")))
t)
nil)
(deftest when-let*.error.1
(handler-case
(eval '(when-let* x :oops))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment