Generate a defmacro form that transforms code like this:
(mvlet* ((slot-names slot-binds (loop for slot in slots if (listp slot) collect slot into slot-binds and collect (first slot) into slot-names else collect slot into slot-names and collect (list slot slot) into slot-binds finally (return (values slot-names slot-binds)))) (body decls (parse-body body)) (slot-decls decls (partition-declarations slot-names decls))) `(macrolet ((:method (name &body args) (mvlet* ((class ',class) (self ',self) (slot-binds ',slot-binds) (qualifiers lambda-list body (parse-defmethod-args args)) (body decls docstring (parse-body body :documentation t)) (ll-with-self (substitute (list self class) self lambda-list))) (when (equal ll-with-self lambda-list) (error "No binding for ~s in ~s" self lambda-list)) `(symbol-macrolet ,(loop for (alias ref) in slot-binds collect (ematch ref ((and ref (type symbol)) `(,alias (slot-value ,self ',ref))) ((list 'function fn) `(,alias (,fn ,self))))) ,@',slot-decls (defmethod ,name ,@qualifiers ,ll-with-self ,@(unsplice docstring) ,@decls ,@body))))) ,@decls ,@body))

Pattern to recognize: Macro call that should be transformed by mvlet*

Macro definition:
(defmacro mvlet* ((&rest bindings) &body body &environment env)
  "Expand a series of nested `multiple-value-bind' forms.

`mvlet*' is similar in intent to Scheme’s `let-values', but with a
different and less parenthesis-intensive syntax. Each binding is a
list of

    (var var*... expr)

A simple example should suffice to show both the implementation and
the motivation:

    (defun uptime (seconds)
      (mvlet* ((minutes seconds (truncate seconds 60))
               (hours minutes (truncate minutes 60))
               (days hours (truncate hours 24)))
        (declare ((integer 0 *) days hours minutes seconds))
        (fmt \"~d day~:p, ~d hour~:p, ~d minute~:p, ~d second~:p\"
             days hours minutes seconds)))

Note that declarations work just like `let*'."
  (cond ((null bindings)
         `(locally ,@body))
        ((every #'simple-binding-p bindings)
         `(let* ,bindings ,@body))
        (t (multiple-value-bind (body decls)
               (parse-body body)
             (let* ((bindings (canonicalize-bindings bindings))
                    (mvbinds (member-if-not #'simple-binding-p bindings))
                    (simple-binds (ldiff bindings mvbinds)))
               (if simple-binds
                   (multiple-value-bind (local other)
                       (partition-declarations (mapcar #'car simple-binds) decls env)
                     `(let* ,simple-binds
                        ,@local
                        (mvlet* ,mvbinds
                          ,@other
                          ,@body)))
                   (let* ((vars (butlast (car bindings)))
                          (expr (lastcar (car bindings))))
                     (multiple-value-bind (local other)
                         (partition-declarations vars decls env)
                       `(multiple-value-bind ,vars
                            ,expr
                          ,@local
                          (mvlet* ,(cdr bindings)
                            ,@other
                            ,@body))))))))))

Macroexpansion:
(multiple-value-bind (slot-names slot-binds) (loop for slot in slots if (listp slot) collect slot into slot-binds and collect (first slot) into slot-names else collect slot into slot-names and collect (list slot slot) into slot-binds finally (return (values slot-names slot-binds))) (mvlet* ((body decls (parse-body body)) (slot-decls decls (partition-declarations slot-names decls))) (sb-int:quasiquote (macrolet ((:method (name &body args) (mvlet* ((class (quote #S(sb-impl::comma :expr class :kind 0))) (self (quote #S(sb-impl::comma :expr self :kind 0))) (slot-binds (quote #S(sb-impl::comma :expr slot-binds :kind 0))) (qualifiers lambda-list body (parse-defmethod-args args)) (body decls docstring (parse-body body :documentation t)) (ll-with-self (substitute (list self class) self lambda-list))) (when (equal ll-with-self lambda-list) (error "No binding for ~s in ~s" self lambda-list)) (sb-int:quasiquote (symbol-macrolet #S(sb-impl::comma :expr (loop for (alias ref) in slot-binds collect (ematch ref ((and ref (type symbol)) (sb-int:quasiquote (#S(sb-impl::comma :expr alias :kind 0) (slot-value #S(sb-impl::comma :expr self :kind 0) (quote #S(sb-impl::comma :expr ref :kind 0)))))) ((list (quote function) fn) (sb-int:quasiquote (#S(sb-impl::comma :expr alias :kind 0) (#S(sb-impl::comma :expr fn :kind 0) #S(sb-impl::comma :expr self :kind 0))))))) :kind 0) #S(sb-impl::comma :expr (quote #S(sb-impl::comma :expr slot-decls :kind 0)) :kind 2) (defmethod #S(sb-impl::comma :expr name :kind 0) #S(sb-impl::comma :expr qualifiers :kind 2) #S(sb-impl::comma :expr ll-with-self :kind 0) #S(sb-impl::comma :expr (unsplice docstring) :kind 2) #S(sb-impl::comma :expr decls :kind 2) #S(sb-impl::comma :expr body :kind 2))))))) #S(sb-impl::comma :expr decls :kind 2) #S(sb-impl::comma :expr body :kind 2)))))