j14i/cl-macros huggingface dataset:
Define a macro that eliminates this repetitive pattern:
(parse-conjunctive-clauses client instance nil :var (parse-d-spec client))

Issue: Macro call that should be transformed by parse-conjunctive-clauses

Macro definition:
(defmacro parse-conjunctive-clauses (client region read-name-p &rest args)
  (with-unique-names (clauses next)
    `(prog (,clauses)
      ,next
        (push (do-parse-clause ,client ,region *index* ,read-name-p ,@args)
              ,clauses)
        (when (maybe-parse-token :keywords '(:and))
          (go ,next))
        (return (nreverse ,clauses)))))

Macroexpansion:
(prog (#:clauses126) #:next127 (push (do-parse-clause client instance *index* nil :var (parse-d-spec client)) #:clauses126) (when (maybe-parse-token :keywords (quote (:and))) (go #:next127)) (return (nreverse #:clauses126)))
You are a Common Lisp macro expert. Given this code pattern:
(signal-syntax-error* (1- (lexer-pos lexer)) "Opening #\< in named group has no closing #\>.")

Write a macro that addresses: Macro call that should be transformed by signal-syntax-error*

Macro definition:
(defmacro signal-syntax-error* (pos format-control &rest format-arguments)
  `(error 'ppcre-syntax-error
          :pos ,pos
          :format-control ,format-control
          :format-arguments (list ,@format-arguments)))

Macroexpansion:
(error (quote ppcre-syntax-error) :pos (1- (lexer-pos lexer)) :format-control "Opening #< in named group has no closing #>." :format-arguments (list))
You are a Common Lisp macro expert. Given this code pattern:
(with-yield-binds (format nil "~A ~A ~A" (if (sql-statement-p (infix-op-left op)) (yield (make-sql-list (infix-op-left op))) (yield (infix-op-left op))) (sql-op-name op) (if (sql-statement-p (infix-op-right op)) (yield (make-sql-list (infix-op-right op))) (yield (infix-op-right op)))))

Write a macro that addresses: Macro call that should be transformed by with-yield-binds

Macro definition:
(defmacro with-yield-binds (&body body)
  `(let ((*bind-values* nil)
         (*use-global-bind-values* t))
     (values
      (progn ,@body)
      (loop for bind in (reverse *bind-values*)
            append bind))))

Macroexpansion:
(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "~A ~A ~A" (if (sql-statement-p (infix-op-left op)) (yield (make-sql-list (infix-op-left op))) (yield (infix-op-left op))) (sql-op-name op) (if (sql-statement-p (infix-op-right op)) (yield (make-sql-list (infix-op-right op))) (yield (infix-op-right op))))) (loop for bind in (reverse *bind-values*) append bind)))
You are a Common Lisp macro expert. Given this code pattern:
(defalias path:catdir (&rest pathnames) cl-fad:merge-pathnames-as-directory)

Write a macro that addresses: Macro call that should be transformed by defalias

Macro definition:
(defmacro defalias (name args realname)
  `(progn
     (defun ,name ,args
       ,(if (eql '&rest (first args))
            `(apply #',realname ,(second args))
            `(,realname ,@args)))
     (define-compiler-macro ,name (&rest args)
       (list* ',realname args))))

Macroexpansion:
(progn (defun path:catdir (&rest pathnames) (apply (function merge-pathnames-as-directory) pathnames)) (define-compiler-macro path:catdir (&rest args) (list* (quote merge-pathnames-as-directory) args)))
Write a Common Lisp macro to handle this code pattern:
(defalias path:catfile (&rest pathnames) cl-fad:merge-pathnames-as-file)

Problem: Macro call that should be transformed by defalias

Macro definition:
(defmacro defalias (name args realname)
  `(progn
     (defun ,name ,args
       ,(if (eql '&rest (first args))
            `(apply #',realname ,(second args))
            `(,realname ,@args)))
     (define-compiler-macro ,name (&rest args)
       (list* ',realname args))))

Macroexpansion:
(progn (defun path:catfile (&rest pathnames) (apply (function merge-pathnames-as-file) pathnames)) (define-compiler-macro path:catfile (&rest args) (list* (quote merge-pathnames-as-file) args)))
Generate a defmacro form that transforms code like this:
(dynamic-wind
  nil
  nil)

Pattern to recognize: Macro call that should be transformed by DYNAMIC-WIND

Macro definition:
(defmacro DYNAMIC-WIND ...)

Macroexpansion:
(flet ((#:dynamic-wind-thunk219 (#:proceed-thunk220)
         (macrolet ((proceed (&body #:proceed-body221)
                      `(if ,'#:proceed-thunk220
                           (funcall (the function ,'#:proceed-thunk220))
                           (progn ,@#:proceed-body221))))
           nil
           nil)))
  (declare (inline #:dynamic-wind-thunk219))
  (let ((*dynamic-wind-stack*
         (cons #'#:dynamic-wind-thunk219 *dynamic-wind-stack*)))
    (#:dynamic-wind-thunk219 nil)))
Create a Common Lisp macro for the following transformation. Before code:
(dletf nil
  (progn))

What needs to change: Macro call that should be transformed by DLETF

Macro definition:
(defmacro DLETF ...)

Macroexpansion:
(special-symbol-progv (with-symbol-access
                        (list))
    (list)
  (locally (declare (special)) (progn)))
You are a Common Lisp macro expert. Given this code pattern:
(with-wcs-math-error-handling (ret (log x (float 2 x))) (check-wcs-math-result))

Write a macro that addresses: Macro call that should be transformed by with-wcs-math-error-handling

Macro definition:
(defmacro with-wcs-math-error-handling
    ((var-or-var-list
      (function x &optional (y nil y-supplied-p))
      &rest keyargs
      &key underflow-value)
     &body body)
  (declare (ignorable underflow-value))
  (let ((x_ (gensym)) (y_ (gensym)) (args_ (gensym))
        (var-list (ensure-list var-or-var-list)))
    `(let* ((,x_ ,x)
            (,y_ ,y)
            (,args_ (list ,x_ ,@(if y-supplied-p `(,y_)))))
       (declare (ignorable ,y_)
                (type list ,args_)
                (dynamic-extent ,args_))
       (catch 'return-from-with-wcs-math-error-handling
         (multiple-value-bind ,var-list
             (call-with-wcs-math-error-handler ',function ,args_
                                               ,@keyargs)
           (flet ((check-wcs-math-result
                      (&optional (ret ,(first var-list))
                                 (arg-list ,args_))
                    (check-wcs-math-result ret arg-list)))
             ,@body))))))

Macroexpansion:
(let* ((#:g230 x) (#:g231 (float 2 x)) (#:g232 (list #:g230 #:g231))) (declare (ignorable #:g231) (type list #:g232) (dynamic-extent #:g232)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (ret) (call-with-wcs-math-error-handler (quote log) #:g232) (flet ((check-wcs-math-result (&optional (ret ret) (arg-list #:g232)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result)))))
Generate a defmacro form that transforms code like this:
(do+ (options :atomic-updates nil) (for x (across #(1 2 3 4) :index index)) (for k (in '(a b c d e))) (returning (list x k :index index)))

Pattern to recognize: Macro call that should be transformed by do+

Macro definition:
(defmacro do+ (&body body)
  "High-level, extensible iteration construct. Refer to the manual for syntax and semantics."
  `(do+/internal nil ,@body))

Macroexpansion:
(do+/internal nil (options :atomic-updates nil) (for x (across #(1 2 3 4) :index index)) (for k (in (quote (a b c d e)))) (returning (list x k :index index)))
Generate a defmacro form that transforms code like this:
(define-custom-var (:symbols-package *json-symbols-package*) (find-package 'keyword))

Pattern to recognize: Macro call that should be transformed by define-custom-var

Macro definition:
(defmacro define-custom-var ((key name) &rest other-args)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (progn (pushnew '(,name . ,key) *custom-vars* :test #'equal)
            (defvar ,name ,@other-args))))

Macroexpansion:
(eval-when (:compile-toplevel :load-toplevel :execute) (progn (pushnew (quote (*json-symbols-package* . :symbols-package)) *custom-vars* :test (function equal)) (defvar *json-symbols-package* (find-package (quote keyword)))))
Generate a defmacro form that transforms code like this:
(-<>> nil nil)

Pattern to recognize: Macro call that should be transformed by -<>>

Macro definition:
(defmacro -<>> ...)

Macroexpansion:
(->> nil nil)
Create a Common Lisp macro for the following transformation. Before code:
(define-value-binding table-keys (var table &aux (iterator (hash-table-iterator table)) next key val) (declare (type hash-table table) (type function iterator)) `(multiple-value-bind (,next ,key ,val) (funcall ,iterator) (declare (ignore ,val)) (if ,next (update ,var ,key) (end-for))))

What needs to change: Macro call that should be transformed by define-value-binding

Macro definition:
(defmacro define-value-binding (name (var &rest args) &body body)
  (let ((vars (lambda-fiddle:extract-lambda-vars (lambda-fiddle:remove-aux-part args))))
    (emit-binding-definition name var args body :extra-vars vars)))

Macroexpansion:
(define-direct-binding table-keys (var table) (let ((#:iterator145 (gensym #A((8) base-char . "ITERATOR"))) (#:next146 (gensym #A((4) base-char . "NEXT"))) (#:key147 (gensym #A((3) base-char . "KEY"))) (#:val148 (gensym #A((3) base-char . "VAL"))) (#:table144 (gensym #A((5) base-char . "TABLE")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:table144 table) (list #:iterator145 (list (quote hash-table-iterator) #:table144)) (list #:next146 nil) (list #:key147 nil) (list #:val148 nil) (loop for #:var143 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var143 nil))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:iterator145 :kind 0) #S(sb-impl::comma :expr #:next146 :kind 0) #S(sb-impl::comma :expr #:key147 :kind 0) #S(sb-impl::comma :expr #:val148 :kind 0) #S(sb-impl::comma :expr #:table144 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote hash-table) :kind 0) #S(sb-impl::comma :expr #:table144 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote function) :kind 0) #S(sb-impl::comma :expr #:iterator145 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((iterator #:iterator145) (next #:next146) (key #:key147) (val #:val148) (table #:table144)) (declare (ignorable iterator next key val table)) (sb-int:quasiquote (multiple-value-bind (#S(sb-impl::comma :expr next :kind 0) #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr val :kind 0)) (funcall #S(sb-impl::comma :expr iterator :kind 0)) (declare (ignore #S(sb-impl::comma :expr val :kind 0))) (if #S(sb-impl::comma :expr next :kind 0) (update #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr key :kind 0)) (end-for))))))))
Define a macro that eliminates this repetitive pattern:
(defgenerator cycle (list-or-gen) "Repeatedly cycles through a list or generator, yielding its elements indefinitely. Eg: (cycle '(a b c d)) -> a b c d a b c d a b ... Note that this tool may consume considerable storage if the source iterable is long." (let ((data (cond ((generatorp list-or-gen) (let ((accum nil)) (do-generator (g list-or-gen) (yield g) (push g accum)) (nreverse accum))) ((listp list-or-gen) list-or-gen) (t (error "Gen must be a list or generator"))))) (loop do (dolist (x data) (yield x)))))

Issue: Macro call that should be transformed by defgenerator

Macro definition:
(defmacro defgenerator (name arguments &body body)
  (multiple-value-bind (remaining-forms declarations doc-string)
      (alexandria:parse-body body :documentation t)
    `(defun ,name ,arguments
       ,doc-string
       ,@declarations
       (with-yield
	 ,@remaining-forms))))

Macroexpansion:
(defun cycle (list-or-gen) "Repeatedly cycles through a list or generator, yielding its elements indefinitely. Eg: (cycle '(a b c d)) -> a b c d a b c d a b ... Note that this tool may consume considerable storage if the source iterable is long." (with-yield (let ((data (cond ((generatorp list-or-gen) (let ((accum nil)) (do-generator (g list-or-gen) (yield g) (push g accum)) (nreverse accum))) ((listp list-or-gen) list-or-gen) (t (error "Gen must be a list or generator"))))) (loop do (dolist (x data) (yield x))))))
Create a Common Lisp macro for the following transformation. Before code:
(define-accumulation-binding minimizing (var form &key key) (let ((result (gensym "RESULT"))) `(let ((,result ,form)) (when (or (not ,var) (< ,(if key `(funcall ,key ,result) result) ,(if key `(funcall ,key ,var) var))) (setf ,var ,result)))))

What needs to change: Macro call that should be transformed by define-accumulation-binding

Macro definition:
(defmacro define-accumulation-binding (name (var &rest args) &body body)
  `(define-form-binding ,name (,var ,@args)
     ,@(form-fiddle:lambda-declarations `(lambda () ,@body))
     (values
      (progn ,@(form-fiddle:lambda-forms `(lambda () ,@body)))
      (delist var))))

Macroexpansion:
(define-form-binding minimizing (var form &key key) (values (progn (let ((result (gensym "RESULT"))) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr result :kind 0) #S(sb-impl::comma :expr form :kind 0))) (when (or (not #S(sb-impl::comma :expr var :kind 0)) (< #S(sb-impl::comma :expr (if key (sb-int:quasiquote (funcall #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr result :kind 0))) result) :kind 0) #S(sb-impl::comma :expr (if key (sb-int:quasiquote (funcall #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr var :kind 0))) var) :kind 0))) (setf #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr result :kind 0))))))) (delist var)))
Write a Common Lisp macro to handle this code pattern:
(builder :session (lambda (env) (if (equal (getf env :path-info) "/delayed-expire") (lambda (responder) (setf (getf (getf env :lack.session.options) :expire) t) (funcall responder '(200 () ("hi")))) (lambda (responder) (funcall responder '(200 () "hi"))))))

Problem: Macro call that should be transformed by builder

Macro definition:
(defmacro builder (&rest app-or-middlewares)
  (let ((middlewares (butlast app-or-middlewares)))
    `(reduce #'funcall
             (remove-if
              #'null
              (list
               ,@(loop for mw in middlewares
                       when mw
                         collect (convert-to-middleware-form mw))))
             :initial-value (to-app ,(car (last app-or-middlewares)))
             :from-end t)))

Macroexpansion:
(reduce (function funcall) (remove-if (function null) (list (find-middleware :session))) :initial-value (to-app (lambda (env) (if (equal (getf env :path-info) "/delayed-expire") (lambda (responder) (setf (getf (getf env :lack.session.options) :expire) t) (funcall responder (quote (200 nil ("hi"))))) (lambda (responder) (funcall responder (quote (200 nil "hi"))))))) :from-end t)
Generate a defmacro form that transforms code like this:
(defgenerator islice (generator stop-or-start &optional (stop nil has-stop-p) step) "Emits a subrange of generator. If only stop-or-start is set, islice will emit up to it and stop. If both stop-or-start and stop are set, islice will emit the stretch between stop and start. If step is set, then islice will emit every step-th item between start and stop. If stop is set to nil, then islice will continue through the source generator until it terminates. Eg: (islice (list->generator '(a b c d e f g)) 2) -> A B (islice (list->generator '(a b c d e f g)) 2 4) -> C D (islice (list->generator '(a b c d e f g)) 2 nil) -> C D E F G (islice (list->generator '(a b c d e f g)) 0 nil 2) -> A C E G" (let ((start (if has-stop-p stop-or-start nil)) (stop (or stop (unless has-stop-p stop-or-start))) (step (or step 1))) (when start (consume start generator)) (if stop (dotimes (i (floor (/ (- stop (or start 0)) step))) (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))) (loop do (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))))))

Pattern to recognize: Macro call that should be transformed by defgenerator

Macro definition:
(defmacro defgenerator (name arguments &body body)
  (multiple-value-bind (remaining-forms declarations doc-string)
      (alexandria:parse-body body :documentation t)
    `(defun ,name ,arguments
       ,doc-string
       ,@declarations
       (with-yield
	 ,@remaining-forms))))

Macroexpansion:
(defun islice (generator stop-or-start &optional (stop nil has-stop-p) step) "Emits a subrange of generator. If only stop-or-start is set, islice will emit up to it and stop. If both stop-or-start and stop are set, islice will emit the stretch between stop and start. If step is set, then islice will emit every step-th item between start and stop. If stop is set to nil, then islice will continue through the source generator until it terminates. Eg: (islice (list->generator '(a b c d e f g)) 2) -> A B (islice (list->generator '(a b c d e f g)) 2 4) -> C D (islice (list->generator '(a b c d e f g)) 2 nil) -> C D E F G (islice (list->generator '(a b c d e f g)) 0 nil 2) -> A C E G" (with-yield (let ((start (if has-stop-p stop-or-start nil)) (stop (or stop (unless has-stop-p stop-or-start))) (step (or step 1))) (when start (consume start generator)) (if stop (dotimes (i (floor (/ (- stop (or start 0)) step))) (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))) (loop do (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data))))))))
Define a macro that eliminates this repetitive pattern:
(define-error invalid-function-return-spec () (func spec) "Return type spec of function ~a is invalid:~%~a" func spec)

Issue: Macro call that should be transformed by define-error

Macro definition:
(defmacro define-error (name (&key (error-type 'varjo-error) (prefix "Varjo"))
                            (&rest args) error-string &body body)
  `(defcondition ,name (:error-type ,error-type :prefix ,prefix) ,args
       ,error-string ,@body))

Macroexpansion:
(defcondition invalid-function-return-spec (:error-type varjo-error :prefix "Varjo") (func spec) "Return type spec of function ~a is invalid:~%~a" func spec)
Create a Common Lisp macro for the following transformation. Before code:
(is-true nil)

What needs to change: Macro call that should be transformed by is-true

Macro definition:
(defmacro is-true (condition &rest reason-args)
  "Like IS this check generates a pass if CONDITION returns true
  and a failure if CONDITION returns false. Unlike IS this check
  does not inspect CONDITION to determine how to report the
  failure."
  `(if ,condition
       (add-result 'test-passed :test-expr ',condition)
       (process-failure ',condition
                        ,@(or reason-args
                              `("~S did not return a true value" ',condition)))))

Macroexpansion:
(if nil (add-result (quote test-passed) :test-expr (quote nil)) (process-failure (quote nil) "~S did not return a true value" (quote nil)))
Generate a defmacro form that transforms code like this:
(lambda (quote some-name))

Pattern to recognize: Macro call that should be transformed by LAMBDA

Macro definition:
(defmacro LAMBDA ...)

Macroexpansion:
#'(lambda (quote some-name))
Generate a defmacro form that transforms code like this:
(augment step-code prev-code)

Pattern to recognize: Macro call that should be transformed by augment

Macro definition:
(defmacro augment (var stuff)
  `(setf ,var (nconc ,var ,stuff)))

Macroexpansion:
(setf step-code (nconc step-code prev-code))
Create a Common Lisp macro for the following transformation. Before code:
(some-<>> (diamond-wand init (cddr exp) t t))

What needs to change: Macro call that should be transformed by some-<>

Macro definition:
(defmacro some-<> (init &body exps) (diamond-wand init exps nil t))

Macroexpansion:
(block #:g127 (diamond-wand init (cddr exp) t t))
Write a Common Lisp macro to handle this code pattern:
(bind (((:labels doit (x)) "if I knew how to get the docstring out of flet, I'd test it." (setf x (* 2 x)) (setf x (+ x 3)) x)) (ensure-same (doit 1) 5) (ensure-same (doit 2) 7))

Problem: Macro call that should be transformed by bind

Macro definition:
(defmacro bind ((&rest bindings) &body body)
  "Bind is a replacement for let*, destructuring-bind, multiple-value-bind and more. 

An example is probably the best way to describe its syntax:

    \(bind \(\(a 2\)
           \(\(b &rest args &key \(c 2\) &allow-other-keys\) '\(:a :c 5 :d 10 :e 54\)\)
           \(\(:values d e\) \(truncate 4.5\)\)
           \(\(:structure xxx- slot1 slot2\) \(make-xxx\)\)
           \(\(:flet name \(arg1 arg2\)\) \(+ arg1 arg2\)\)\)
         \(list a b c d e args\)\)

Simple bindings are as in let*. Destructuring is done if the first item
in a binding is a list. Multiple value binding is done if the first item
in a binding is a list and the first item in the list is ':values'. Other
forms have their own syntax. For example, :structure first has the conc
name and then slot names whereas :flet has the function name and a list
of arguments and then the function body (in an implicit progn)."
  (let (declarations)
    (loop while (and (consp (car body)) (eq (caar body) 'declare)) do
          (push (first body) declarations)
          (setf body (rest body)))
    (if bindings
	(let ((*all-declarations* (bind-expand-declarations (nreverse declarations))))
	  (prog1
	      (bind-macro-helper bindings body)
	    (check-for-unused-variable-declarations *all-declarations*)))
        `(locally
             ,@declarations
           ,@body))))

Macroexpansion:
(labels ((doit (x) "if I knew how to get the docstring out of flet, I'd test it." (progn (setf x (* 2 x)) (setf x (+ x 3)) x))) (progn (ensure-same (doit 1) 5) (ensure-same (doit 2) 7)))
Generate a defmacro form that transforms code like this:
(case nil)

Pattern to recognize: Macro call that should be transformed by CASE

Macro definition:
(defmacro CASE ...)

Macroexpansion:
(let ((#:nil nil))
  (declare (ignorable #:nil))
  (cond))
Generate a defmacro form that transforms code like this:
(with-ps-gensyms nil
  :key
  nil)

Pattern to recognize: Macro call that should be transformed by WITH-PS-GENSYMS

Macro definition:
(defmacro WITH-PS-GENSYMS ...)

Macroexpansion:
(let* ()
  :key
  nil)
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-expander slot-value 1 (expr val new-val) `(let ((new (copy-instance ,val))) (setf (slot-value new ,(third expr)) ,new-val) new))

What needs to change: Macro call that should be transformed by define-modf-expander

Macro definition:
(defmacro define-modf-expander (name nth-arg
                                (expr val new-val)
                                &body body)
  "Define a new expander which inverts forms starting with NAME.  Your function
should return an expansion from EXPR to a form that will build a new object that
has NEW-VAL in the place specified by expr.  NTH-ARG marks which argument is
considered the actual data which will be inverted next."
  (setf
   (gethash name *modf-nth-arg*)
   nth-arg)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf
      (gethash ',name *modf-nth-arg*)
      ,nth-arg
      (gethash ',name *modf-expansions*)
      (lambda (,expr ,val ,new-val)
        ,@body))))

Macroexpansion:
(eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote slot-value) *modf-nth-arg*) 1 (gethash (quote slot-value) *modf-expansions*) (lambda (expr val new-val) (sb-int:quasiquote (let ((new (copy-instance #S(sb-impl::comma :expr val :kind 0)))) (setf (slot-value new #S(sb-impl::comma :expr (third expr) :kind 0)) #S(sb-impl::comma :expr new-val :kind 0)) new)))))
You are a Common Lisp macro expert. Given this code pattern:
(define-macro nil
    :key
    nil)

Write a macro that addresses: Macro call that should be transformed by DEFINE-MACRO

Macro definition:
(defmacro DEFINE-MACRO ...)

Macroexpansion:
(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf (get 'nil ':key)
          (lambda (#:whole122 #:no-environment)
            (declare (ignorable #:no-environment))
            (handler-case
             (destructuring-bind
                 (#:namevar123)
                 #:whole122
               (declare (ignore #:namevar123)))
             (error (e) (error 'foo-syntax-error :form #:whole122 :cause e))))))