and-let*

and-let.el

;; [SRFI-2]
;; http://srfi.schemers.org/srfi-2/srfi-2.html
;;
;; AND-LET* (CLAWS) BODY

(require 'cl-lib)

(defmacro and-let* (varlist &rest body)
  "Like `let' but bind only if CLAW bind non-nil value.
Useful to avoid deep nest of `let' and `and'/`when'/`if' test.

AND-LET* (CLAWS) BODY

CLAWS ::= '() | (cons CLAW CLAWS)
CLAW  ::=  (VARIABLE EXPRESSION) | (EXPRESSION) | BOUND-VARIABLE

\(let ((v1 (some)))
  (when v1
    (let ((v2 (any)))
      (when v2
        (message \"Working!\")))))

above is rewrite as following:

\(and-let* ((v1 (some))
           (v2 (any)))
   (message \"Working!\"))

\[SRFI-2]
http://srfi.schemers.org/srfi-2/srfi-2.html
"
  (declare (indent 1))
  (cl-reduce
   (lambda (v res)
     (cond
      ((atom v)
       ;; BOUND-VARIABLE
       `(and ,v ,res))
      ((= (length v) 1)
       ;; (EXPRESSION)
       `(and ,@v ,res))
      ((> (length v) 2)
       (error "Malformed `and-let*'"))
      ((not (symbolp (car v)))
       (error "Malformed `and-let*'"))
      (t
       ;; (VARIABLE EXPRESSION)
       `(let ((,(car v) ,(cadr v)))
          (and ,(car v) ,res)))))
   varlist
   :from-end t
   :initial-value `(progn ,@body)))

and-let2.el

;; [SRFI-2]
;; http://srfi.schemers.org/srfi-2/srfi-2.html
;;
;; AND-LET* (CLAWS) BODY

;; CLAWS ::= '() | (cons CLAW CLAWS)
;; CLAW  ::=  (VARIABLE EXPRESSION) | (EXPRESSION) | BOUND-VARIABLE
;; with no `cl' version
(defmacro and-let* (varlist &rest body)
  (declare (indent 1))
  (let ((res `(progn ,@body)))
    (dolist (v (reverse varlist))
      (setq res
            (cond
             ((atom v)
              ;; BOUND-VARIABLE
              `(and ,v ,res))
             ((= (length v) 1)
              ;; (EXPRESSION)
              `(and ,@v ,res))
             ((> (length v) 2)
              (error "Malformed `and-let*'"))
             ((not (symbolp (car v)))
              (error "Malformed `and-let*'"))
             (t
              ;; (VARIABLE EXPRESSION)
              `(let ((,(car v) ,(cadr v)))
                 (and ,(car v) ,res))))))
    res))

test-and-let.el

(require 'ert)

(ert-deftest normal-0001 ()
  :tags '(and-let)
  (should (equal (and-let* ((a 1)) a) 1))
  (should (equal (and-let* ((a 1) (b nil)) a) nil))
  (should (equal (and-let* ((a 1) (b t)) (list a b)) '(1 t)))
  (should (equal (let ((test nil)) (and-let* ((a 1) test) (list a 'test))) nil))
  (should (equal (let ((test t)) (and-let* ((a 1) test) (list a 'test))) '(1 test)))
  (should (equal (and-let* ((a 1) ((funcall 'identity 1))) (list a 'test2)) '(1 test2)))
  (should (equal (and-let* ((a 1) ((funcall 'identity nil))) (list a 'test2)) nil)))