[alexandria-devel] [PATCH] PROG1-LET

[Benjamin Saunders]

PROG1-LET is a binding macro modeled closely after WHEN-LET and
friends, which I have regularly found useful in code to implement the
"create, modify, return" pattern common in some imperative
code. As a simple and, I believe, widely useful macro, I'd like to see
this enter into Alexandria proper. Docstring follows:

Creates new variable bindings and executes FORMS, returning the
initial value of the first binding.

BINDINGS must be either single binding of the form:

 (variable initial-form)

or a list of bindings of the form:

 ((variable   initial-form)
  (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 and FORMS
are executed as an implicit PROGN. Finally, the value returned by
INITIAL-FORM is returned.
-------------- next part --------------
From cbccc782f34477c924ea8ff7b6000cd52511a768 Mon Sep 17 00:00:00 2001
From: Benjamin Saunders <ralith at gmail.com>
Date: Sat, 7 Apr 2012 13:19:19 -0700
Subject: [PATCH] Added PROG1-LET

---
 binding.lisp |   27 +++++++++++++++++++++++++++
 package.lisp |    1 +
 tests.lisp   |   24 ++++++++++++++++++++++++
 3 files changed, 52 insertions(+)

diff --git a/binding.lisp b/binding.lisp
index 36d92bc..27db561 100644
--- a/binding.lisp
+++ b/binding.lisp
@@ -91,3 +91,30 @@ PROGN."
          (when ,(caar binding-list)
            ,@(bind (cdr binding-list) forms))))))
 
+(defmacro prog1-let (bindings &body forms)
+  "Creates new variable bindings and executes FORMS, returning the initial
+value of the first binding.
+
+BINDINGS must be either single binding of the form:
+
+ (variable initial-form)
+
+or a list of bindings of the form:
+
+ ((variable   initial-form)
+  (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 and FORMS are executed
+as an implicit PROGN. Finally, the value returned by INITIAL-FORM is
+returned."
+  (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
+                           (list bindings)
+                           bindings))
+         (variables (mapcar #'car binding-list)))
+    `(let ,binding-list
+       (prog1 ,(first variables)
+         , at forms))))
+
diff --git a/package.lisp b/package.lisp
index 673ed30..4bb5b56 100644
--- a/package.lisp
+++ b/package.lisp
@@ -11,6 +11,7 @@
    #:if-let
    #:when-let
    #:when-let*
+   #:prog1-let
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; REVIEW IN PROGRESS
    ;;
diff --git a/tests.lisp b/tests.lisp
index b875382..8a2dbeb 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -1779,6 +1779,30 @@
         :type-error))
   :type-error)
 
+(deftest prog1-let.1
+    (prog1-let (x :ok)
+      :oops)
+  :ok)
+
+(deftest prog1-let.2
+    (prog1-let ((x :ok)
+                (y :oops))
+      y)
+  :ok)
+
+(deftest prog1-let.3
+    (prog1-let (x (opaque :ok))
+      (setf x :oops))
+  :ok)
+
+(deftest prog1-let.error.1
+    (handler-case
+        (eval '(prog1-let x :oops))
+      (type-error ()
+        :type-error))
+  :type-error)
+
+
 (deftest doplist.1
     (let (keys values)
       (doplist (k v '(a 1 b 2 c 3) (values t (reverse keys) (reverse values) k v))
-- 
1.7.9.5

-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 836 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/alexandria-devel/attachments/20120407/d47531ff/attachment.sig>