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.
From cbccc782f34477c924ea8ff7b6000cd52511a768 Mon Sep 17 00:00:00 2001 From: Benjamin Saunders <ral...@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) + ,@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
pgpasWoxAKf6J.pgp
Description: PGP signature
_______________________________________________ alexandria-devel mailing list alexandria-devel@common-lisp.net http://lists.common-lisp.net/cgi-bin/mailman/listinfo/alexandria-devel