Write a Common Lisp macro to handle this code pattern:
(action (:traverse node-for node new-subs) (let ((loop-subs new-subs)) (loop :for binding :in (node-for-bindings node) :for name := (node-for-binding-name binding) :do (when (find name subs :key #'ast-substitution-from) (util:coalton-bug "Failure to apply ast substitution on variable ~A to node-for" name)) :do (when rename-bound-variables (push (make-ast-substitution :from name :to (make-node-variable :type (node-for-binding-type binding) :value (gensym (symbol-name name)))) loop-subs))) (make-node-for :type (node-type node) :label (node-for-label node) :bindings (loop :for binding :in (node-for-bindings node) :for name := (node-for-binding-name binding) :collect (make-node-for-binding :name (if rename-bound-variables (node-variable-value (ast-substitution-to (find name loop-subs :key #'ast-substitution-from))) name) :type (node-for-binding-type binding) :init (funcall *traverse* (node-for-binding-init binding) new-subs) :step (and (node-for-binding-step binding) (funcall *traverse* (node-for-binding-step binding) loop-subs)))) :sequential-p (node-for-sequential-p node) :returns (and (node-for-returns node) (funcall *traverse* (node-for-returns node) loop-subs)) :termination-kind (node-for-termination-kind node) :termination-expr (and (node-for-termination-expr node) (funcall *traverse* (node-for-termination-expr node) loop-subs)) :body (funcall *traverse* (node-for-body node) loop-subs))))

Problem: Macro call that should be transformed by action

Macro definition:
(defmacro action ((when type &rest args) &body body)
  "Construct an action block, turning `body` into a lambda function
accepting `args` if `args` are provided. If there are no `args`, then
`body` is assumed to be a function object and is used directly with
`when` and `type` to create an `action` instance. Otherwise, the first
argument in `args` is declared to be a node of type `type`, and the
`args` and `body` are used to generate a lambda function."
  (check-type when keyword)
  (check-type type symbol)
  (assert (subtypep type 'node))
  (assert (or (not (endp args)) (= 1 (length body))))
  (if (endp args)
      `(make-action ',when ',type ,@body)
      `(make-action ',when ',type
                    (lambda (,@args)
                      (declare (type ,type ,(first args)))
                      ,@body))))

Macroexpansion:
(make-action (quote :traverse) (quote node-for) (lambda (node new-subs) (declare (type node-for node)) (let ((loop-subs new-subs)) (loop :for binding :in (node-for-bindings node) :for name := (node-for-binding-name binding) :do (when (find name subs :key (function ast-substitution-from)) (util:coalton-bug "Failure to apply ast substitution on variable ~A to node-for" name)) :do (when rename-bound-variables (push (make-ast-substitution :from name :to (make-node-variable :type (node-for-binding-type binding) :value (gensym (symbol-name name)))) loop-subs))) (make-node-for :type (node-type node) :label (node-for-label node) :bindings (loop :for binding :in (node-for-bindings node) :for name := (node-for-binding-name binding) :collect (make-node-for-binding :name (if rename-bound-variables (node-variable-value (ast-substitution-to (find name loop-subs :key (function ast-substitution-from)))) name) :type (node-for-binding-type binding) :init (funcall *traverse* (node-for-binding-init binding) new-subs) :step (and (node-for-binding-step binding) (funcall *traverse* (node-for-binding-step binding) loop-subs)))) :sequential-p (node-for-sequential-p node) :returns (and (node-for-returns node) (funcall *traverse* (node-for-returns node) loop-subs)) :termination-kind (node-for-termination-kind node) :termination-expr (and (node-for-termination-expr node) (funcall *traverse* (node-for-termination-expr node) loop-subs)) :body (funcall *traverse* (node-for-body node) loop-subs)))))