From d670d4fbe0abc3bb16d9f4c67e19e4b265882ee9 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 7 Nov 2006 12:49:44 +0200
Subject: [PATCH] IF-LET, IF-LET*, WHEN-LET, and WHEN-LET*

---
 alexandria.asd |   1 +
 binding.lisp   | 120 +++++++++++++++++++++++++++++++++++++++++++++++++
 package.lisp   |   6 +++
 tests.lisp     |  75 +++++++++++++++++++++++++++++++
 4 files changed, 202 insertions(+)
 create mode 100644 binding.lisp

diff --git a/alexandria.asd b/alexandria.asd
index 09fd989..675f62c 100644
--- a/alexandria.asd
+++ b/alexandria.asd
@@ -10,6 +10,7 @@
    (:file "symbols" :depends-on ("package"))
    (:file "arrays" :depends-on ("package"))
    (:file "types" :depends-on ("package"))
+   (:file "binding" :depends-on ("package"))
    (:file "functions" :depends-on ("package" "symbols"))
    (:file "lists" :depends-on ("package" "functions"))
    (:file "sequences" :depends-on ("package" "lists"))
diff --git a/binding.lisp b/binding.lisp
new file mode 100644
index 0000000..6dbbcec
--- /dev/null
+++ b/binding.lisp
@@ -0,0 +1,120 @@
+(in-package :alexandria)
+
+(defmacro if-let (bindings then-form &optional else-form)
+    "Creates new variable bindings, and conditionally executes either
+THEN-FORM or ELSE-FORM (defaulting 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))
+
+All initial-forms are executed sequentially in the specified order. Then all
+the variables are bound to the corresponding values.
+
+If all variables were bound to true values, 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 if-let* (bindings then-form &optional else-form)
+  "Creates new variable bindings, and conditionally executes either THEN-FORM
+or ELSE-FORM (defaulting 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 either
+THEN-FORM or ELSE-FORM (defaulting 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))
+
+All initial-forms are executed sequentially in the specified order. Then all
+the variables are bound to the corresponding values.
+
+If all variables were bound to true values, 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))))
+
+(defmacro when-let* (bindings &body forms)
+  "Creates new variable bindings, and conditionally executes either THEN-FORM
+or ELSE-FORM (defaulting 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, 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))))
+
diff --git a/package.lisp b/package.lisp
index 6dc750a..a1fc674 100644
--- a/package.lisp
+++ b/package.lisp
@@ -2,6 +2,11 @@
   (:nicknames :alexandria)
   (:use :cl)
   (:export 
+   ;; Binding constructs
+   #:if-let
+   #:if-let*
+   #:when-let
+   #:when-let*
    ;; Hash tables
    #:copy-hash-table
    #:hash-table-keys
@@ -65,6 +70,7 @@
    #:suffle
    ;; Macros
    #:with-unique-names   
+   #:with-gensyms
    #:once-only
    #:parse-body
    ;; Symbols
diff --git a/tests.lisp b/tests.lisp
index 26ff24f..496878f 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -962,3 +962,78 @@
     (type= 'string 'list)
   nil
   t)
+
+;;;; Bindings
+
+(declaim (notinline opaque))
+(defun opaque (x)
+  x)
+
+(deftest if-let.1
+    (if-let (x (opaque :ok))
+            x
+            :bad)
+  :ok)
+
+(deftest if-let.2
+    (if-let (x (opaque nil))
+            :bad
+            (and (not x) :ok))
+  :ok)
+
+(deftest if-let.3
+    (let ((x 1))
+      (if-let ((x 2)
+               (y x))
+              (+ x y)
+              :oops))
+  3)
+
+(deftest if-let.4
+    (if-let ((x 1)
+             (y nil))
+            :oops
+            (and (not y) x))
+  1)
+
+(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 when-let.1
+    (when-let (x (opaque :ok))
+      (setf x (cons x x))
+      x)
+  (:ok . :ok))
+
+(deftest when-let.2
+    (when-let ((x 1)
+               (y nil)
+               (z 3))
+      :oops)
+  nil)
+
+(deftest when-let.3
+    (let ((x 1))
+      (when-let ((x 2)
+                 (y x))
+        (+ x y)))
+  3)
+
+(deftest when-let*.1
+    (let ((x 1))
+      (when-let* ((x 2)
+                  (y x))
+        (+ x y)))
+  4)
-- 
GitLab