Instruction:
Generate a defmacro form that transforms code like this:
(make-name-transformer name "-ZORK")

Pattern to recognize: Macro call that should be transformed by make-name-transformer

Input: (make-name-transformer name "-ZORK")

Output:
(defmacro make-name-transformer (&rest elements)
  "Return an accessor name transformer.
The unquoted `name' symbol argument is substituted for the slot name.
Class option examples:

  :accessor-name-transformer (make-name-transformer \"FOO-\" name \"-BAR\")

Use the slot name directly:

  :accessor-name-transformer (make-name-transformer name)"
  `(lambda (name definition)
    (declare (ignorable definition))
    (concatenate-symbol ,@(mapcar (lambda (el)
                                    (if (and (symbolp el)
                                             (string= (symbol-name el) "NAME"))
                                        'name
                                        el))
                                  elements))))

(lambda (name definition) (declare (ignorable definition)) (concatenate-symbol name "-ZORK"))


Instruction:
Define a macro that eliminates this repetitive pattern:
(check-cursor-attached cluffer:beginning-of-line-p (cursor))

Issue: Macro call that should be transformed by check-cursor-attached

Input: (check-cursor-attached cluffer:beginning-of-line-p (cursor))

Output:
(defmacro check-cursor-attached (name arguments)
  (let ((args (substitute '(cursor cluffer:cursor) 'cursor arguments)))
    `(defmethod ,name :before ,args
       (declare (ignore ,@(set-difference (remove 'cursor arguments)
                                          lambda-list-keywords)))
       (unless (cluffer:cursor-attached-p cursor)
         (error 'cluffer:cursor-detached)))))

(defmethod cluffer:beginning-of-line-p :before ((cursor cluffer:cursor)) (declare (ignore)) (unless (cluffer:cursor-attached-p cursor) (error (quote cluffer:cursor-detached))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(letrec-syntax common-lisp:nil (common-lisp:progn))

Write a macro that addresses: Macro call that should be transformed by LETREC-SYNTAX

Input: (letrec-syntax common-lisp:nil (common-lisp:progn))

Output: (defmacro LETREC-SYNTAX ...)

(common-lisp:macrolet ()
  (common-lisp:progn))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(augment init-code `((setq ,extra-save-var ,(save-info-iv-ref s-i))))

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

Input: (augment init-code `((setq ,extra-save-var ,(save-info-iv-ref s-i))))

Output:
(defmacro augment (var stuff)
  `(setf ,var (nconc ,var ,stuff)))

(setf init-code (nconc init-code (sb-int:quasiquote ((setq #S(sb-impl::comma :expr extra-save-var :kind 0) #S(sb-impl::comma :expr (save-info-iv-ref s-i) :kind 0))))))


Instruction:
Generate a defmacro form that transforms code like this:
(with-quote-char (map nil (lambda (ex) (format out "~&~A;~%~A" (sxql:yield ex) statement-separator)) expressions))

Pattern to recognize: Macro call that should be transformed by with-quote-char

Input: (with-quote-char (map nil (lambda (ex) (format out "~&~A;~%~A" (sxql:yield ex) statement-separator)) expressions))

Output:
(defmacro with-quote-char (&body body)
  `(let ((sxql:*quote-character* (or sxql:*quote-character*
                                     (connection-quote-character *connection*))))
     ,@body))

(let ((sxql/sql-type:*quote-character* (or sxql/sql-type:*quote-character* (connection-quote-character *connection*)))) (map nil (lambda (ex) (format out "~&~A;~%~A" (sxql/sql-type:yield ex) statement-separator)) expressions))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(count-of nil
  :key
  nil)

Write a macro that addresses: Macro call that should be transformed by COUNT-OF

Input:
(count-of nil
  :key
  nil)

Output: (defmacro COUNT-OF ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-custom-var (:array-scope *array-scope-variables*) '(*internal-decoder*) "A list of symbols naming dynamic variables which should be re-bound in the scope of every JSON Array.")

What needs to change: Macro call that should be transformed by define-custom-var

Input: (define-custom-var (:array-scope *array-scope-variables*) '(*internal-decoder*) "A list of symbols naming dynamic variables which should be re-bound in the scope of every JSON Array.")

Output:
(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))))

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (pushnew (quote (*array-scope-variables* . :array-scope)) *custom-vars* :test (function equal)) (defvar *array-scope-variables* (quote (*internal-decoder*)) "A list of symbols naming dynamic variables which should be re-bound in the scope of every JSON Array.")))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-collectors nil
  nil)

Write a macro that addresses: Macro call that should be transformed by WITH-COLLECTORS

Input:
(with-collectors nil
  nil)

Output: (defmacro WITH-COLLECTORS ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(lambda-match0 ((cons key pattern) `(assoc ,key ,pattern)))

Issue: Macro call that should be transformed by lambda-match0

Input: (lambda-match0 ((cons key pattern) `(assoc ,key ,pattern)))

Output:
(defmacro lambda-match0 (&body clauses)
  (alexandria:with-gensyms (arg)
    `(lambda (,arg)
       (match0 ,arg
         ,@clauses))))

(lambda (#:arg165) (match0 #:arg165 ((cons key pattern) (sb-int:quasiquote (assoc #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr pattern :kind 0))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defmacro-driver 'some-name)

What needs to change: Macro call that should be transformed by DEFMACRO-DRIVER

Input: (defmacro-driver 'some-name)

Output: (defmacro DEFMACRO-DRIVER ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defmacro clause-quote-2 (&key ((:quote some-name)) generate))
  (iterate::install-clause-info '(quote) '(quote) 'clause-quote-2 nil t)
  ''some-name)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(check-cursor-attached cluffer:items (cursor &key start end))

What needs to change: Macro call that should be transformed by check-cursor-attached

Input: (check-cursor-attached cluffer:items (cursor &key start end))

Output:
(defmacro check-cursor-attached (name arguments)
  (let ((args (substitute '(cursor cluffer:cursor) 'cursor arguments)))
    `(defmethod ,name :before ,args
       (declare (ignore ,@(set-difference (remove 'cursor arguments)
                                          lambda-list-keywords)))
       (unless (cluffer:cursor-attached-p cursor)
         (error 'cluffer:cursor-detached)))))

(defmethod cluffer:items :before ((cursor cluffer:cursor) &key start end) (declare (ignore end start)) (unless (cluffer:cursor-attached-p cursor) (error (quote cluffer:cursor-detached))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(none-of nil
  :key
  nil)

Write a macro that addresses: Macro call that should be transformed by NONE-OF

Input:
(none-of nil
  :key
  nil)

Output: (defmacro NONE-OF ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(collect-max nil :key nil)

Issue: Macro call that should be transformed by COLLECT-MAX

Input: (collect-max nil :key nil)

Output: (defmacro COLLECT-MAX ...)

(common-lisp:let* ((#:generator-379 (generator :key))
                   #:items-369
                   (#:generator-377 (generator nil))
                   #:numbers-368
                   (#:number-371 nil)
                   #:result-372)
  (declare (type generator #:generator-379)
           (type generator #:generator-377)
           (type (null-or t) #:result-372))
  (tagbody
   #:ll-380
    (setq #:items-369 (next-in #:generator-379 (go end)))
    (setq #:numbers-368 (next-in #:generator-377 (go end)))
    (if (or (null #:number-371) (< #:number-371 #:numbers-368))
        (setq #:number-371 #:numbers-368
              #:result-372 #:items-369))
    (go #:ll-380)
   end)
  (if (null #:number-371)
      (setq #:result-372 nil))
  #:result-372)


Instruction:
Generate a defmacro form that transforms code like this:
(is-false t)

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

Input: (is-false t)

Output:
(defmacro is (test &rest reason-args)
  "The DWIM checking operator.

If TEST returns a true value a test-passed result is generated,
otherwise a test-failure result is generated. The reason, unless
REASON-ARGS is provided, is generated based on the form of TEST:

 (predicate expected actual) - Means that we want to check
 whether, according to PREDICATE, the ACTUAL value is
 in fact what we EXPECTED.

 (predicate value) - Means that we want to ensure that VALUE
 satisfies PREDICATE.

 Wrapping the TEST form in a NOT simply produces a negated reason
 string."
  (assert (listp test)
          (test)
          "Argument to IS must be a list, not ~S" test)
  (let (bindings effective-test default-reason-args)
    (with-gensyms (e a v)
      (flet ((process-entry (predicate expected actual &optional negatedp)
               ;; make sure EXPECTED is holding the entry that starts with 'values
               (when (and (consp actual)
                          (eq (car actual) 'values))
                 (assert (not (and (consp expected)
                                   (eq (car expected) 'values))) ()
                                   "Both the expected and actual part is a values expression.")
                 (rotatef expected actual))
               (let ((setf-forms))
                 (if (and (consp expected)
                          (eq (car expected) 'values))
                     (progn
                       (setf expected (copy-list expected))
                       (setf setf-forms (loop for cell = (rest expected) then (cdr cell)
                                              for i from 0
                                              while cell
                                              when (eq (car cell) '*)
                                              collect `(setf (elt ,a ,i) nil)
                                              and do (setf (car cell) nil)))
                       (setf bindings (list (list e `(list ,@(rest expected)))
                                            (list a `(multiple-value-list ,actual)))))
                     (setf bindings (list (list e expected)
                                          (list a actual))))
                 (setf effective-test `(progn
                                         ,@setf-forms
                                         ,(if negatedp
                                              `(not (,predicate ,e ,a))
                                              `(,predicate ,e ,a)))))))
        (list-match-case test
          ((not (?predicate ?expected ?actual))
           (process-entry ?predicate ?expected ?actual t)
           (setf default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which is ~2&~S~2%to ~2&~S~2% (it should not be)"
                       `',?actual a `',?predicate e)))
          ((not (?satisfies ?value))
           (setf bindings (list (list v ?value))
                 effective-test `(not (,?satisfies ,v))
                 default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which satisfies ~2&~S~2% (it should not)"
                       `',?value v `',?satisfies)))
          ((?predicate ?expected ?actual)
           (process-entry ?predicate ?expected ?actual)
           (setf default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%"
                       `',?actual a `',?predicate e)))
          ((?satisfies ?value)
           (setf bindings (list (list v ?value))
                 effective-test `(,?satisfies ,v)
                 default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which does not satisfy ~2&~S~2%"
                       `',?value v `',?satisfies)))
          (?_
           (setf bindings '()
                 effective-test test
                 default-reason-args (list "~2&~S~2% was NIL." `',test)))))
      `(let ,bindings
         (if ,effective-test
             (add-result 'test-passed :test-expr ',test)
             (process-failure ',test
                              ,@(or reason-args default-reason-args)))))))

(let ((#:value201 t)) (if #:value201 (process-failure (quote t) "~S returned the value ~S, which is true" (quote t) #:value201) (add-result (quote test-passed) :test-expr (quote t))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-shell-component roy :input-type "roy" :output-type "js" :shell-command ("roy" "-r"))

What needs to change: Macro call that should be transformed by define-shell-component

Input: (define-shell-component roy :input-type "roy" :output-type "js" :shell-command ("roy" "-r"))

Output:
(defmacro define-shell-component (name &key input-type output-type shell-command)
  "Define an ASDF component that's compiled by running a shell command."
  `(define-component ,name
     :input-type ,input-type
     :output-type ,output-type
     :compile-function (lambda (input-pathname output-pathname)
                         (inferior-shell:run (list ,@(ensure-list shell-command)
                                                    input-pathname
                                                    output-pathname)
                                             :show t))))

(define-component roy :input-type "roy" :output-type "js" :compile-function (lambda (input-pathname output-pathname) (inferior-shell:run (list "roy" "-r" input-pathname output-pathname) :show t)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-modf-rewrite cddr (expr) `(cdr (cdr ,(second expr))))

Problem: Macro call that should be transformed by define-modf-rewrite

Input: (define-modf-rewrite cddr (expr) `(cdr (cdr ,(second expr))))

Output:
(defmacro define-modf-rewrite (name (expr) &body body)
  "Define a new rewrite rule.  If a form starting with NAME is encountered, call
the defined function to return a form that we can deal with (i.e. one defined
via DEFINE-MODF-EXPANDER, DEFINE-MODF-FUNCTION, and DEFINE-MODF-METHOD)."
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf (gethash ',name *modf-rewrites*)
           (lambda (,expr)
             ,@body))))

(eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote cddr) *modf-rewrites*) (lambda (expr) (sb-int:quasiquote (cdr (cdr #S(sb-impl::comma :expr (second expr) :kind 0)))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-rewrite cdaaar (expr) `(cdr (caaar ,(second expr))))

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

Input: (define-modf-rewrite cdaaar (expr) `(cdr (caaar ,(second expr))))

Output:
(defmacro define-modf-rewrite (name (expr) &body body)
  "Define a new rewrite rule.  If a form starting with NAME is encountered, call
the defined function to return a form that we can deal with (i.e. one defined
via DEFINE-MODF-EXPANDER, DEFINE-MODF-FUNCTION, and DEFINE-MODF-METHOD)."
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf (gethash ',name *modf-rewrites*)
           (lambda (,expr)
             ,@body))))

(eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote cdaaar) *modf-rewrites*) (lambda (expr) (sb-int:quasiquote (cdr (caaar #S(sb-impl::comma :expr (second expr) :kind 0)))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(when ret-body (setf body (rest ret-body)) (setf type (first ret-body)))

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

Input: (when ret-body (setf body (rest ret-body)) (setf type (first ret-body)))

Output:
(defmacro when (test &body forms)
  `(if ,test
	   ,(cl:if (cadr forms)
			   `(progn ,@forms)
			   (car forms))))

(if ret-body (progn (setf body (rest ret-body)) (setf type (first ret-body))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defun/1 getc (fd) (fgetc fd))

What needs to change: Macro call that should be transformed by defun/1

Input: (defun/1 getc (fd) (fgetc fd))

Output:
(defmacro defun/1 (name arglist &body body)
  "Lisp-1 defun; makes function pointers work."
  `(progn
     (defun ,name ,arglist
       (declare (optimize (speed 0) (debug 3)
                          ;; FIXME: Why do minor warnings result in load errors?
                          #+sbcl (sb-ext:inhibit-warnings 3)))

       ,@body)
     (defparameter ,name (vacietis.c:mkptr& (symbol-function ',name)))))

(progn (defun getc (fd) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (fgetc fd)) (defparameter getc (vacietis.c:mkptr& (symbol-function (quote getc)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-error unable-to-resolve-func-type () (func-name args) "Unable to resolve the result type of function '~a' when called~%with the argument types:~%~a~%" func-name (mapcar #'type->type-spec (mapcar #'primary-type args)))

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

Input: (define-error unable-to-resolve-func-type () (func-name args) "Unable to resolve the result type of function '~a' when called~%with the argument types:~%~a~%" func-name (mapcar #'type->type-spec (mapcar #'primary-type args)))

Output:
(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))

(defcondition unable-to-resolve-func-type (:error-type varjo-error :prefix "Varjo") (func-name args) "Unable to resolve the result type of function '~a' when called~%with the argument types:~%~a~%" func-name (mapcar (function type->type-spec) (mapcar (function primary-type) args)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(def-dynenv-macro nil
    (progn))

Problem: Macro call that should be transformed by DEF-DYNENV-MACRO

Input:
(def-dynenv-macro nil
    (progn))

Output: (defmacro DEF-DYNENV-MACRO ...)

(defmacro nil (progn &environment #:env175) (with-dynenv #:env175))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-shell-component sass-strict :input-type "sass" :output-type "css" :shell-command "sass")

Problem: Macro call that should be transformed by define-shell-component

Input: (define-shell-component sass-strict :input-type "sass" :output-type "css" :shell-command "sass")

Output:
(defmacro define-shell-component (name &key input-type output-type shell-command)
  "Define an ASDF component that's compiled by running a shell command."
  `(define-component ,name
     :input-type ,input-type
     :output-type ,output-type
     :compile-function (lambda (input-pathname output-pathname)
                         (inferior-shell:run (list ,@(ensure-list shell-command)
                                                    input-pathname
                                                    output-pathname)
                                             :show t))))

(define-component sass-strict :input-type "sass" :output-type "css" :compile-function (lambda (input-pathname output-pathname) (inferior-shell:run (list "sass" input-pathname output-pathname) :show t)))


Instruction:
Generate a defmacro form that transforms code like this:
(do+ (accumulating-to foo) (stop-when (> (length foo) 10)) (returning foo) (do+ (for x (in '(1 2 3))) (do+ (for y (in '(a b))) (collect (list x y) :into foo))))

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

Input: (do+ (accumulating-to foo) (stop-when (> (length foo) 10)) (returning foo) (do+ (for x (in '(1 2 3))) (do+ (for y (in '(a b))) (collect (list x y) :into foo))))

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

(do+/internal nil (accumulating-to foo) (stop-when (> (length foo) 10)) (returning foo) (do+ (for x (in (quote (1 2 3)))) (do+ (for y (in (quote (a b)))) (collect (list x y) :into foo))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(disable-quasiquote-2.0)

Problem: Macro call that should be transformed by DISABLE-QUASIQUOTE-2.0

Output: (defmacro DISABLE-QUASIQUOTE-2.0 ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (%disable-quasiquote-2.0))


Instruction:
Generate a defmacro form that transforms code like this:
(ematch0 args (nil nil) ((list* '&key rest) (list* '&key (process-keyword-args rest))) ((list* '&rest rest) (list* '&rest (process-rest-args rest))) ((list* '&aux rest) args) ((list* (list name) rest) (list* (list name ''_) (process-optional-args rest))) ((list* (list name default) rest) (list* (list name default) (process-optional-args rest))) ((list* (list name default pred) rest) (list* (list name default pred) (process-optional-args rest))) ((list* name rest) (list* (list name ''_) (process-optional-args rest))))

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

Input: (ematch0 args (nil nil) ((list* '&key rest) (list* '&key (process-keyword-args rest))) ((list* '&rest rest) (list* '&rest (process-rest-args rest))) ((list* '&aux rest) args) ((list* (list name) rest) (list* (list name ''_) (process-optional-args rest))) ((list* (list name default) rest) (list* (list name default) (process-optional-args rest))) ((list* (list name default pred) rest) (list* (list name default pred) (process-optional-args rest))) ((list* name rest) (list* (list name ''_) (process-optional-args rest))))

Output:
(defmacro ematch0 (what &body clauses)
  `(match0 ,what
     ,@clauses
     (_ (error "level0 match error!"))))

(match0 args (nil nil) ((list* (quote &key) rest) (list* (quote &key) (process-keyword-args rest))) ((list* (quote &rest) rest) (list* (quote &rest) (process-rest-args rest))) ((list* (quote &aux) rest) args) ((list* (list name) rest) (list* (list name (quote (quote _))) (process-optional-args rest))) ((list* (list name default) rest) (list* (list name default) (process-optional-args rest))) ((list* (list name default pred) rest) (list* (list name default pred) (process-optional-args rest))) ((list* name rest) (list* (list name (quote (quote _))) (process-optional-args rest))) (_ (error "level0 match error!")))


Instruction:
Define a macro that eliminates this repetitive pattern:
(slet 42 (alet 43 (slet it it)))

Issue: Macro call that should be transformed by slet

Input: (slet 42 (alet 43 (slet it it)))

Output:
(defmacro slet (form &body body)
  "Binds the FORM to IT (via SYMBOL-MACROLET) in the scope of the BODY. IT can
be set with SETF."
  `(symbolic ignore-first ,form (progn ,@body)))

(symbolic ignore-first 42 (progn (alet 43 (slet it it))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-alias-binding sum summing)

Problem: Macro call that should be transformed by define-alias-binding

Input: (define-alias-binding sum summing)

Output:
(defmacro define-alias-binding (name referenced-binding-name)
  `(progn (setf (binding ',name) ',referenced-binding-name)
          ',name))

(progn (setf (binding (quote sum)) (quote summing)) (quote sum))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-error flow-ids-mandatory (:error-type varjo-critical-error) (for primary-type) "~a must be given flow id/s when created: type - ~s" for primary-type)

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

Input: (define-error flow-ids-mandatory (:error-type varjo-critical-error) (for primary-type) "~a must be given flow id/s when created: type - ~s" for primary-type)

Output:
(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))

(defcondition flow-ids-mandatory (:error-type varjo-critical-error :prefix "Varjo") (for primary-type) "~a must be given flow id/s when created: type - ~s" for primary-type)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defun-compile-time magic-continuation-argument (continuation) (if (or (eq (first (second (second continuation))) '&optional) (eq (first (second (second continuation))) '&rest)) (second (second (second continuation))) (first (second (second continuation)))))

What needs to change: Macro call that should be transformed by defun-compile-time

Input: (defun-compile-time magic-continuation-argument (continuation) (if (or (eq (first (second (second continuation))) '&optional) (eq (first (second (second continuation))) '&rest)) (second (second (second continuation))) (first (second (second continuation)))))

Output:
(defmacro defun-compile-time (function-name lambda-list &body body)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (cl:defun ,function-name ,lambda-list ,@body)
     (eval-when (:compile-toplevel) (compile ',function-name))))

(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun magic-continuation-argument (continuation) (if (or (eq (first (second (second continuation))) (quote &optional)) (eq (first (second (second continuation))) (quote &rest))) (second (second (second continuation))) (first (second (second continuation))))) (eval-when (:compile-toplevel) (compile (quote magic-continuation-argument))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(product-of 'some-name)

Issue: Macro call that should be transformed by PRODUCT-OF

Input: (product-of 'some-name)

Output: (defmacro PRODUCT-OF ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(peek-char*)

Write a macro that addresses: Macro call that should be transformed by peek-char*

Input: (peek-char*)

Output:
(defmacro peek-char* ()
  "Convenience macro because we always peek at the same string with
the same arguments."
  `(peek-char nil *stream* t nil t))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(do+ (for s (symbols-in :doplus-tests :internal)) (for l (maximizing (length (symbol-name s)) :saving s :in symbol-with-longest-name)) (returning symbol-with-longest-name))

Problem: Macro call that should be transformed by do+

Input: (do+ (for s (symbols-in :doplus-tests :internal)) (for l (maximizing (length (symbol-name s)) :saving s :in symbol-with-longest-name)) (returning symbol-with-longest-name))

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

(do+/internal nil (for s (symbols-in :doplus-tests :internal)) (for l (maximizing (length (symbol-name s)) :saving s :in symbol-with-longest-name)) (returning symbol-with-longest-name))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(ematch0 pattern ((list 'guard1 sym test) (pushnew (first (ensure-list sym)) syms)) ((list* 'guard1 sym test more-patterns) (pushnew (first (ensure-list sym)) syms) (analyze-more-patterns more-patterns)) ((list* 'or1 or-subpatterns) (map nil #'analyze-pattern or-subpatterns)))

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

Input: (ematch0 pattern ((list 'guard1 sym test) (pushnew (first (ensure-list sym)) syms)) ((list* 'guard1 sym test more-patterns) (pushnew (first (ensure-list sym)) syms) (analyze-more-patterns more-patterns)) ((list* 'or1 or-subpatterns) (map nil #'analyze-pattern or-subpatterns)))

Output:
(defmacro ematch0 (what &body clauses)
  `(match0 ,what
     ,@clauses
     (_ (error "level0 match error!"))))

(match0 pattern ((list (quote guard1) sym test) (pushnew (first (ensure-list sym)) syms)) ((list* (quote guard1) sym test more-patterns) (pushnew (first (ensure-list sym)) syms) (analyze-more-patterns more-patterns)) ((list* (quote or1) or-subpatterns) (map nil (function analyze-pattern) or-subpatterns)) (_ (error "level0 match error!")))


Instruction:
Define a macro that eliminates this repetitive pattern:
(drelet nil)

Issue: Macro call that should be transformed by DRELET

Input: (drelet nil)

Output: (defmacro DRELET ...)


Instruction:
Generate a defmacro form that transforms code like this:
(define-condition/a dbi-error (simple-error) () (:documentation "Base class of all other error exceptions. Use this to catch all DBI errors."))

Pattern to recognize: Macro call that should be transformed by define-condition/a

Input: (define-condition/a dbi-error (simple-error) () (:documentation "Base class of all other error exceptions. Use this to catch all DBI errors."))

Output:
(defmacro define-condition/a (name parent-types slots &body options)
  `(progn
     (define-condition ,name ,parent-types ,slots ,@options)
     (deftype ,(intern (format nil "<~A>" (symbol-name name))) () ',name)
     (setf (find-class ',(intern (format nil "<~A>" (symbol-name name))))
           (find-class ',name))))

(progn (define-condition dbi-error (simple-error) nil (:documentation "Base class of all other error exceptions. Use this to catch all DBI errors.")) (deftype <dbi-error> nil (quote dbi-error)) (setf (find-class (quote <dbi-error>)) (find-class (quote dbi-error))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-cruft %readtable-name (readtable) "Return the name associated with READTABLE." #+ :common-lisp (values (gethash readtable *readtable-names*)))

Write a macro that addresses: Macro call that should be transformed by define-cruft

Input: (define-cruft %readtable-name (readtable) "Return the name associated with READTABLE." #+ :common-lisp (values (gethash readtable *readtable-names*)))

Output:
(defmacro define-cruft (name lambda-list &body (docstring . alternatives))
  (assert (typep docstring 'string) (docstring) "Docstring missing!")
  (assert (not (null alternatives)))
  `(progn
     (declaim (inline ,name))
     (defun ,name ,lambda-list ,docstring ,(first alternatives))))

(progn (declaim (inline %readtable-name)) (defun %readtable-name (readtable) "Return the name associated with READTABLE." (values (gethash readtable *readtable-names*))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
;; Conditional logic with different variable bindings per branch
;; requires deeply nested lets inside each cond clause
(cond ((> x 0)
       (let ((order :ascending)
             (bound (sqrt x)))
         (process order bound)))
      ((< x 0)
       (let ((order :descending)
             (bound (sqrt (- x))))
         (process order bound)))
      (t
       (let ((order :zero)
             (bound 0))
         (process order bound))))

;; Repetitive: same body structure, different bindings per branch

Write a macro that addresses: Cond with per-branch variable bindings leads to duplicated body code — want shared body with branch-specific bindings

Input:
;; Conditional logic with different variable bindings per branch
;; requires deeply nested lets inside each cond clause
(cond ((> x 0)
       (let ((order :ascending)
             (bound (sqrt x)))
         (process order bound)))
      ((< x 0)
       (let ((order :descending)
             (bound (sqrt (- x))))
         (process order bound)))
      (t
       (let ((order :zero)
             (bound 0))
         (process order bound))))

;; Repetitive: same body structure, different bindings per branch

Output:
(defmacro condlet (clauses &body body)
  (let ((bodfn (gensym))
        (vars (mapcar #'(lambda (v) (cons v (gensym)))
                      (remove-duplicates
                        (mapcar #'car
                                (mappend #'cdr clauses))))))
    `(labels ((,bodfn ,(mapcar #'car vars)
                 ,@body))
       (cond ,@(mapcar #'(lambda (cl)
                           (condlet-clause vars cl bodfn))
                       clauses)))))

;; (condlet (((= x 0) (order :zero)  (bound 0))
;;           ((> x 0) (order :ascending) (bound (sqrt x)))
;;           ((< x 0) (order :descending) (bound (sqrt (- x)))))
;;   (process order bound))
;;
;; Each cond clause specifies test + bindings.
;; The body (process order bound) is shared across all clauses.
;; Variables from ALL clauses are recognized and gensym'd.


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-hamt dict (:test test :hash hash :table table) (flet ((%insert (table key value) (%dict-insert table key value (funcall hash key) 0 test))) (make-instance 'hash-dict :test test :hash hash :table (labels ((f (table args) (if args (let ((key (car args)) (value (cadr args))) (f (%insert table key value) (cddr args))) table))) (f table args)))))

Issue: Macro call that should be transformed by with-hamt

Input: (with-hamt dict (:test test :hash hash :table table) (flet ((%insert (table key value) (%dict-insert table key value (funcall hash key) 0 test))) (make-instance 'hash-dict :test test :hash hash :table (labels ((f (table args) (if args (let ((key (car args)) (value (cadr args))) (f (%insert table key value) (cddr args))) table))) (f table args)))))

Output:
(defmacro with-hamt (hamt (&key test hash table) &body body)
  "Accessing HAMT slots"
  `(with-accessors ((,test hamt-test)
                    (,hash hamt-hash)
                    (,table hamt-table))
       ,hamt
     ,@body))

(with-accessors ((test hamt-test) (hash hamt-hash) (table hamt-table)) dict (flet ((%insert (table key value) (%dict-insert table key value (funcall hash key) 0 test))) (make-instance (quote hash-dict) :test test :hash hash :table (labels ((f (table args) (if args (let ((key (car args)) (value (cadr args))) (f (%insert table key value) (cddr args))) table))) (f table args)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(lret* () 1)

Issue: Macro call that should be transformed by lret*

Input: (lret* () 1)

Output:
(defmacro lret* ((&rest bindings) &body body)
  "Cf. `lret'."
  `(lret-aux let* ,bindings
     ,@body))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(dynamic-let* nil
  nil)

Problem: Macro call that should be transformed by DYNAMIC-LET*

Input:
(dynamic-let* nil
  nil)

Output: (defmacro DYNAMIC-LET* ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defproto nil)

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

Input: (defproto nil)

Output: (defmacro DEFPROTO ...)

(progn
 (declaim (special nil))
 (eval-when (:compile-toplevel))
 (setf (symbol-value 'nil)
         (ensure-object (when (boundp 'nil) (symbol-value 'nil)) (list)
                        :properties (list) :nickname 'nil)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(or nil nil)

Problem: Macro call that should be transformed by OR

Input: (or nil nil)

Output: (defmacro OR ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-shadowed-custom-vars (let ((tricky-json "{\"start_XPos\":98,\"start_YPos\":4}") (*json-symbols-package* (find-package :keyword))) (set-decoder-simple-list-semantics) (is (equal '((:START--*X-POS . 98) (:START--*Y-POS . 4)) (decode-json-from-string tricky-json)))))

Issue: Macro call that should be transformed by with-shadowed-custom-vars

Input: (with-shadowed-custom-vars (let ((tricky-json "{\"start_XPos\":98,\"start_YPos\":4}") (*json-symbols-package* (find-package :keyword))) (set-decoder-simple-list-semantics) (is (equal '((:START--*X-POS . 98) (:START--*Y-POS . 4)) (decode-json-from-string tricky-json)))))

Output:
(defmacro with-shadowed-custom-vars (&body body)
  `(let ,(loop for (var) in *custom-vars*
            collect `(,var (if (boundp ',var) ,var)))
     ,@body))

(let ((*aggregate-scope-variables* (if (boundp (quote *aggregate-scope-variables*)) *aggregate-scope-variables*)) (*string-scope-variables* (if (boundp (quote *string-scope-variables*)) *string-scope-variables*)) (*array-scope-variables* (if (boundp (quote *array-scope-variables*)) *array-scope-variables*)) (*object-scope-variables* (if (boundp (quote *object-scope-variables*)) *object-scope-variables*)) (*internal-decoder* (if (boundp (quote *internal-decoder*)) *internal-decoder*)) (*end-of-object-handler* (if (boundp (quote *end-of-object-handler*)) *end-of-object-handler*)) (*object-value-handler* (if (boundp (quote *object-value-handler*)) *object-value-handler*)) (*object-key-handler* (if (boundp (quote *object-key-handler*)) *object-key-handler*)) (*beginning-of-object-handler* (if (boundp (quote *beginning-of-object-handler*)) *beginning-of-object-handler*)) (*json-array-type* (if (boundp (quote *json-array-type*)) *json-array-type*)) (*end-of-array-handler* (if (boundp (quote *end-of-array-handler*)) *end-of-array-handler*)) (*array-member-handler* (if (boundp (quote *array-member-handler*)) *array-member-handler*)) (*beginning-of-array-handler* (if (boundp (quote *beginning-of-array-handler*)) *beginning-of-array-handler*)) (*end-of-string-handler* (if (boundp (quote *end-of-string-handler*)) *end-of-string-handler*)) (*string-char-handler* (if (boundp (quote *string-char-handler*)) *string-char-handler*)) (*beginning-of-string-handler* (if (boundp (quote *beginning-of-string-handler*)) *beginning-of-string-handler*)) (*boolean-handler* (if (boundp (quote *boolean-handler*)) *boolean-handler*)) (*real-handler* (if (boundp (quote *real-handler*)) *real-handler*)) (*integer-handler* (if (boundp (quote *integer-handler*)) *integer-handler*))) (let ((tricky-json "{\"start_XPos\":98,\"start_YPos\":4}") (*json-symbols-package* (find-package :keyword))) (set-decoder-simple-list-semantics) (is (equal (quote ((:start--*x-pos . 98) (:start--*y-pos . 4))) (decode-json-from-string tricky-json)))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-generic generic ((a a) (b b)) (+ a b))

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

Input: (define-generic generic ((a a) (b b)) (+ a b))

Output:
(defmacro define-generic (name (&rest arglist) &body body)
  "Convenience macro to define generics as if they were methods.
ARGLIST can be a method arglist, in which case it's parsed into
generic function arglist by removing method-specific args.

BODY can be a list of `defgeneric' options (processed as-is, even
:method ones) intermixed with other Lisp forms:
- If there's a docstring as the first form, it's processed into
  :documentation option of `defgeneric'.
- If there are non-option forms, they are put together into a separate
  :method option under ARGLIST.
- If there's a `declare' form:
  - If it's generic-friendly (optimize for speed or space), then it's
    put into both generic body and :method body (if any).
  - Otherwise it's only put into :method (creating it if necessary).
- If there's an `:export-generic-name-p' boolean option, export (T) or
  don't export (NIL) the generic symbol.

Example:

\(define-generic add ((a integer) (b integer) &key coerce-to-fixnum &allow-other-keys)
  \"Adds A and B, coercing them to fixnum if the sum is too big.\"
  (if coerce-to-fixnum
      (coerce (+ a b) 'fixnum)
      (+ a b))
  (:method ((a string) (b integer))
   (error \"Cannot use `add' on strings!\")))
=>
\(defgeneric add (a b &key &allow-other-keys)
  (:method ((a integer) (b integer) &key coerce-to-fixnum &allow-other-keys)
   (if coerce-to-fixnum
      (coerce (+ a b) 'fixnum)
      (+ a b)))
  (:method ((a string) (b integer))
   (error \"Cannot use `add' on strings!\"))
  (:documentation \"Adds A and B, coercing them to fixnum if the sum is too big.\"))"
  (multiple-value-bind (body declarations documentation)
      (uiop:parse-body body :documentation t)
    (when (and (= 1 (length body))
               (stringp (first body)))
      (style-warn "Body of DEFINE-GENERIC contains a single string:
~s.
It's interpreted as a method body by default.

If you meant this string to be a generic docstring, and not a method
body, add an explicit NIL or some other body form:
(define-generic name (arg1 arg2)
  \"Docstring\"
  'body-form)

If you meant it as a body form, do nothing, or provide explicit
documentation or any other option:
(define-generic name (arg1 arg2)
  \"Docstring\"
  (:documentation \"Real docstring\"))" (first body)))
    (let* ((generic-declarations (remove-if (lambda (d)
                                              (or (> (length d) 2)
                                                  (not (eq 'optimize (first (second d))))
                                                  (notevery (lambda (o)
                                                              (let ((feature (first (uiop:ensure-list o))))
                                                                (or (eq feature 'speed)
                                                                    (eq feature 'space))))
                                                            (rest (second d)))))
                                            declarations))
           (options (remove-if-not (lambda (form)
                                     (keywordp (first (uiop:ensure-list form))))
                                   body))
           (method-body (remove-if (lambda (f) (member f options :test #'equal)) body))
           (export-generic-name-p (find :export-generic-name-p options :key #'first))
           (options (remove export-generic-name-p options :test #'equal))
           (export-p (if export-generic-name-p
                         (second export-generic-name-p)
                         *export-generic-name-p*))
           (generalized-arglist (generalize-arglist arglist)))
      (when (and (not (equal generalized-arglist arglist))
                 (every #'null (list method-body options)))
        (style-warn "Specialized arglist used without method body in define-generic: ~a" arglist))
      `(prog1
           (defgeneric ,name ,generalized-arglist
             ,@generic-declarations
             ,@(when (or method-body
                         (not (equal generic-declarations
                                     declarations)))
                 `((:method ,arglist
                     ,@declarations
                     ,@method-body)))
             ,@options
             ,@(when documentation
                 `((:documentation ,documentation))))
         ;; FIXME: Maybe only export if package of generic function name
         ;; matches *PACKAGE*?
         ,@(when export-p
             `((eval-when (:compile-toplevel :load-toplevel :execute)
                 (export ',name ,(package-name *package*)))))
         ,@(let ((documentation (or documentation
                                    (second (first (member :documentation options :key #'first))))))
             (when documentation
               `((setf (documentation ',name 'function) ,documentation)
                 (setf (documentation (fdefinition ',name) 'function) ,documentation))))))))

(prog1 (defgeneric generic (a b) (:method ((a a) (b b)) (+ a b))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with nil
  (progn))

Problem: Macro call that should be transformed by WITH

Input:
(with nil
  (progn))

Output: (defmacro WITH ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(ok t)

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

Input: (ok t)

Output:
(defmacro ok (test &optional desc)
  (with-gensyms (duration result)
    (once-only (test desc)
      `(with-catching-errors (:expected T :description ,desc)
         (with-duration ((,duration ,result) ,test)
           (test ,result t ,desc
                 :duration ,duration
                 :test-fn (lambda (x y)
                            (eq (not (null x)) y))
                 :got-form ,test))))))

(let ((#:test142 t) (#:desc143 nil)) (with-catching-errors (:expected t :description #:desc143) (with-duration ((#:duration140 #:result141) #:test142) (test #:result141 t #:desc143 :duration #:duration140 :test-fn (lambda (x y) (eq (not (null x)) y)) :got-form #:test142))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(->> nil (progn))

Issue: Macro call that should be transformed by ->>

Input: (->> nil (progn))

Output: (defmacro ->> ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(collect-max nil)

What needs to change: Macro call that should be transformed by COLLECT-MAX

Input: (collect-max nil)

Output: (defmacro COLLECT-MAX ...)

(common-lisp:let* ((#:generator-340 (generator nil))
                   #:numbers-334
                   (#:number-336 nil))
  (declare (type generator #:generator-340))
  (tagbody
   #:ll-341
    (setq #:numbers-334 (next-in #:generator-340 (go end)))
    (if (or (null #:number-336) (< #:number-336 #:numbers-334))
        (setq #:number-336 #:numbers-334))
    (go #:ll-341)
   end)
  (if (null #:number-336)
      (setq #:number-336 nil))
  #:number-336)


Instruction:
Generate a defmacro form that transforms code like this:
(all-of nil)

Pattern to recognize: Macro call that should be transformed by ALL-OF

Input: (all-of nil)

Output: (defmacro ALL-OF ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(quasiquote-unexpand-1 #-quasiquote-strict-append 'unquote-splicing #+quasiquote-strict-append 'x-unquote (car (last x)))

Issue: Macro call that should be transformed by quasiquote

Input: (quasiquote-unexpand-1 #-quasiquote-strict-append 'unquote-splicing #+quasiquote-strict-append 'x-unquote (car (last x)))

Output: (defmacro quasiquote (x) (quasiquote-expand x))

(quasiquote-unexpand-1 (quote unquote-splicing) (car (last x)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(pop-preprocessor-directive-token token-list directive-symbol)

Issue: Macro call that should be transformed by pop-preprocessor-directive-token

Input: (pop-preprocessor-directive-token token-list directive-symbol)

Output:
(defmacro pop-preprocessor-directive-token (token-list directive-name &key (errorp t))
  "Pops the next token in TOKEN-LIST ignoring `+whitespace-marker+'"
  (with-gensyms (head_)
    `(let ((,head_
             (check-and-pop-pp-directive-token-1 ,token-list ,directive-name ,errorp)))
       (if (eq +whitespace-marker+ ,head_)
           (check-and-pop-pp-directive-token-1 ,token-list ,directive-name ,errorp)
           ,head_))))

(let ((#:head_264 (check-and-pop-pp-directive-token-1 token-list directive-symbol t))) (if (eq +whitespace-marker+ #:head_264) (check-and-pop-pp-directive-token-1 token-list directive-symbol t) #:head_264))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-op (:+ conjunctive-op))

Problem: Macro call that should be transformed by define-op

Input: (define-op (:+ conjunctive-op))

Output:
(defmacro define-op ((op-name struct-type &key sql-op-name include-slots (package (find-package '#:sxql/operator))) &body body)
  (check-type op-name symbol)
  (let ((struct-name (intern (concatenate 'string (symbol-name op-name) #.(string :-op)) package)))
    `(defstruct (,struct-name (:include ,struct-type
                               (name ,(or sql-op-name
                                          (with-output-to-string (s)
                                            (loop for c across (symbol-name op-name)
                                                  if (char= c #\-)
                                                    do (write-char #\Space s)
                                                  else
                                                    do (write-char c s)))))
                               ,@include-slots)
                              (:constructor ,(intern (concatenate 'string
                                                                  #.(string :make-)
                                                                  (symbol-name op-name)
                                                                  #.(string :-op))
                                                     package)
                                  ,(ecase struct-type
                                     ((unary-op
                                       unary-splicing-op
                                       unary-postfix-op) '(var))
                                     ((infix-op
                                       infix-splicing-op
                                       infix-list-op) '(left right))
                                     (conjunctive-op '(&rest expressions)))))
       ,@body)))

(defstruct (+-op (:include conjunctive-op (name "+")) (:constructor make-+-op (&rest expressions))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(inext-or-error nil)

Issue: Macro call that should be transformed by INEXT-OR-ERROR

Input: (inext-or-error nil)

Output: (defmacro INEXT-OR-ERROR ...)

(let ((vals (multiple-value-list (funcall (i-coro nil) nil))))
  (if (not vals)
      (error 'stop-iteration)
      (values (car vals) t)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(def-neo4j-fun add-to-index ((type :node) name key value object-id) :post (:uri-spec (format nil "index/~A/~A" (string-downcase (symbol-name type)) name)) (:encode (list (list (cons :uri object-id) (case type (:node :node-url) (:relationship :relationship-url))) (list (cons :key key)) (list (cons :value value))) :object) (:status-handlers (201 (decode-neo4j-json-output body))))

Write a macro that addresses: Macro call that should be transformed by def-neo4j-fun

Input: (def-neo4j-fun add-to-index ((type :node) name key value object-id) :post (:uri-spec (format nil "index/~A/~A" (string-downcase (symbol-name type)) name)) (:encode (list (list (cons :uri object-id) (case type (:node :node-url) (:relationship :relationship-url))) (list (cons :key key)) (list (cons :value value))) :object) (:status-handlers (201 (decode-neo4j-json-output body))))

Output:
(defmacro def-neo4j-fun (name lambda-list method &rest args)
  `(progn
     (defun ,name (&key ,@lambda-list)
       (let ((uri ,(cadr (assoc :uri-spec args)))
             (json (encode-neo4j-json-payload ,@(aif (assoc :encode args)
                                                     (cdr it)
                                                     (list '() :string)))))
         (make-neo4j-request ,method uri json
                             (list ,@(mapcar (lambda (handler)
                                               `(list ,(car handler) (lambda (body uri json)
                                                                  ,(cadr handler))))
                                             (cdr (assoc :status-handlers args)))))))))

(progn (defun add-to-index (&key (type :node) name key value object-id) (let ((uri (format nil "index/~A/~A" (string-downcase (symbol-name type)) name)) (json (encode-neo4j-json-payload (list (list (cons :uri object-id) (case type (:node :node-url) (:relationship :relationship-url))) (list (cons :key key)) (list (cons :value value))) :object))) (make-neo4j-request :post uri json (list (list 201 (lambda (body uri json) (decode-neo4j-json-output body))))))))


Instruction:
Generate a defmacro form that transforms code like this:
(*> +opt-fws+ +sliding-quoted-pairs+)

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

Input: (*> +opt-fws+ +sliding-quoted-pairs+)

Output:
(defmacro *> (parser &rest parsers)
  "Combination of parsers yielding the result of the rightmost one."
  (let ((offset (gensym "*>-OFFSET")))
    `(lambda (,offset)
       ,(reduce (lambda (i p)
                  (let ((res  (gensym "*>-RES"))
                        (next (gensym "*>-NEXT")))
                    `(multiple-value-bind (,res ,next) ,i
                       (if (ok? ,res)
                           (funcall ,p ,next)
                           (fail ,next)))))
                parsers
                :initial-value `(funcall ,parser ,offset)))))

(lambda (#:*>-offset149) (multiple-value-bind (#:*>-res150 #:*>-next151) (funcall +opt-fws+ #:*>-offset149) (if (ok? #:*>-res150) (funcall +sliding-quoted-pairs+ #:*>-next151) (fail #:*>-next151))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(resolve
  nil
  :key
  nil)

Issue: Macro call that should be transformed by RESOLVE

Input:
(resolve
  nil
  :key
  nil)

Output: (defmacro RESOLVE ...)

(locally
 (declare)
 (multiple-value-bind (#:assignment153 #:unified-p154)
     (type-unify 'nil 'nil (list))
   (assert #:unified-p154 nil 'simple-type-error :format-control
           "gtypes failed to unify to the actual types:~% ~a~%    against~% ~a"
           :format-arguments (list 'nil (list)))
   (let ()
     (declare (ignorable))
     nil
     :key
     nil)))


Instruction:
Generate a defmacro form that transforms code like this:
(define-template nil (progn))

Pattern to recognize: Macro call that should be transformed by DEFINE-TEMPLATE

Input: (define-template nil (progn))

Output: (defmacro DEFINE-TEMPLATE ...)

(defmacro define-nil (&optional (#:name127))
  (flet ((template-unfulfillable ()
           (error 'template-unfulfillable :template 'nil :arguments (list))))
    (declare (ignorable (function template-unfulfillable)))
    (let ((body (progn)) (name (or #:name127 (compose-name #\SOLIDUS 'nil))))
      `(progn
        (declaim
         (ftype
          (function
           ,(loop with types = (declared-variable-types body)
                  for arg in (quote (progn))
                  collect (or (second (assoc arg types)) (quote t)))
           ,(declared-return-type body))
          ,name)
         ,@(when (find (quote inline) (declarations body)) `((inline ,name))))
        (defun ,name ,'(progn)
          (declare (optimize speed (safety 0) (debug 0) (compilation-speed 0))
                   ,@(remove (quote inline) (declarations body)))
          ,@(remove-if #'declaration-p body))))))


Instruction:
Generate a defmacro form that transforms code like this:
(as->* nil)

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

Input: (as->* nil)

Output: (defmacro AS->* ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defclass/std default () ((with-std)))

Problem: Macro call that should be transformed by defclass/std

Input: (defclass/std default () ((with-std)))

Output:
(defmacro defclass/std (name direct-superclasses direct-slots &rest options
                        &environment env)
  "Shortcut macro to the DEFCLASS macro.

  (defclass/std example ()
    ((slot1 slot2 slot3)))

  expands to:

  (DEFCLASS EXAMPLE ()
    ((SLOT1 :ACCESSOR SLOT1 :INITARG :SLOT1 :INITFORM NIL)
    (SLOT2 :ACCESSOR SLOT2 :INITARG :SLOT2 :INITFORM NIL)
    (SLOT3 :ACCESSOR SLOT3 :INITARG :SLOT3 :INITFORM NIL)))

  Each slot definition accepts options:

    :std 1 => changes the :initform to 1. It can be :unbound.
    :with or :with-prefix => creates accessors with the class name as prefix.

  See the README for more.

  See also `class/std' and `print-object/std'.
  "
  `(defclass ,name ,direct-superclasses
     ,(process-slots env direct-slots name)
     ,@options))

(defclass default nil ((with-std :accessor with-std :initarg :with-std :initform nil)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(inext-noexit nil)

What needs to change: Macro call that should be transformed by INEXT-NOEXIT

Input: (inext-noexit nil)

Output: (defmacro INEXT-NOEXIT ...)

(let ((vals (multiple-value-list (funcall (i-coro nil) nil))))
  (if (not vals)
      (values nil nil)
      (values (car vals) t)))


Instruction:
Generate a defmacro form that transforms code like this:
(make-obsolete mustache-render-to-string render* "0.10.0")

Pattern to recognize: Macro call that should be transformed by make-obsolete

Input: (make-obsolete mustache-render-to-string render* "0.10.0")

Output:
(defmacro make-obsolete (obsolete-name current-name when)
  `(defun ,obsolete-name (&rest args)
     ,(documentation current-name 'function)
     (warn 'deprecation-warning
           :name ',obsolete-name :replacement ',current-name :since ,when)
     (apply ',current-name args)))

(defun mustache-render-to-string (&rest args) #A((48) base-char . "Render TEMPLATE with optional CONTEXT to string.") (warn (quote deprecation-warning) :name (quote mustache-render-to-string) :replacement (quote render*) :since "0.10.0") (apply (quote render*) args))


Instruction:
Define a macro that eliminates this repetitive pattern:
(is (not (< 1 0)))

Issue: Macro call that should be transformed by is

Input: (is (not (< 1 0)))

Output:
(defmacro is (test &rest reason-args)
  "The DWIM checking operator.

If TEST returns a true value a test-passed result is generated,
otherwise a test-failure result is generated. The reason, unless
REASON-ARGS is provided, is generated based on the form of TEST:

 (predicate expected actual) - Means that we want to check
 whether, according to PREDICATE, the ACTUAL value is
 in fact what we EXPECTED.

 (predicate value) - Means that we want to ensure that VALUE
 satisfies PREDICATE.

 Wrapping the TEST form in a NOT simply produces a negated reason
 string."
  (assert (listp test)
          (test)
          "Argument to IS must be a list, not ~S" test)
  (let (bindings effective-test default-reason-args)
    (with-gensyms (e a v)
      (flet ((process-entry (predicate expected actual &optional negatedp)
               ;; make sure EXPECTED is holding the entry that starts with 'values
               (when (and (consp actual)
                          (eq (car actual) 'values))
                 (assert (not (and (consp expected)
                                   (eq (car expected) 'values))) ()
                                   "Both the expected and actual part is a values expression.")
                 (rotatef expected actual))
               (let ((setf-forms))
                 (if (and (consp expected)
                          (eq (car expected) 'values))
                     (progn
                       (setf expected (copy-list expected))
                       (setf setf-forms (loop for cell = (rest expected) then (cdr cell)
                                              for i from 0
                                              while cell
                                              when (eq (car cell) '*)
                                              collect `(setf (elt ,a ,i) nil)
                                              and do (setf (car cell) nil)))
                       (setf bindings (list (list e `(list ,@(rest expected)))
                                            (list a `(multiple-value-list ,actual)))))
                     (setf bindings (list (list e expected)
                                          (list a actual))))
                 (setf effective-test `(progn
                                         ,@setf-forms
                                         ,(if negatedp
                                              `(not (,predicate ,e ,a))
                                              `(,predicate ,e ,a)))))))
        (list-match-case test
          ((not (?predicate ?expected ?actual))
           (process-entry ?predicate ?expected ?actual t)
           (setf default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which is ~2&~S~2%to ~2&~S~2% (it should not be)"
                       `',?actual a `',?predicate e)))
          ((not (?satisfies ?value))
           (setf bindings (list (list v ?value))
                 effective-test `(not (,?satisfies ,v))
                 default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which satisfies ~2&~S~2% (it should not)"
                       `',?value v `',?satisfies)))
          ((?predicate ?expected ?actual)
           (process-entry ?predicate ?expected ?actual)
           (setf default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%"
                       `',?actual a `',?predicate e)))
          ((?satisfies ?value)
           (setf bindings (list (list v ?value))
                 effective-test `(,?satisfies ,v)
                 default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which does not satisfy ~2&~S~2%"
                       `',?value v `',?satisfies)))
          (?_
           (setf bindings '()
                 effective-test test
                 default-reason-args (list "~2&~S~2% was NIL." `',test)))))
      `(let ,bindings
         (if ,effective-test
             (add-result 'test-passed :test-expr ',test)
             (process-failure ',test
                              ,@(or reason-args default-reason-args)))))))

(let ((#:e185 1) (#:a186 0)) (if (progn (not (< #:e185 #:a186))) (add-result (quote test-passed) :test-expr (quote (not (< 1 0)))) (process-failure (quote (not (< 1 0))) "~2&~S~2% evaluated to ~2&~S~2% which is ~2&~S~2%to ~2&~S~2% (it should not be)" (quote 0) #:a186 (quote <) #:e185)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(undefmessage nil)

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

Input: (undefmessage nil)

Output: (defmacro UNDEFMESSAGE ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-assert-observers ("deleting bar" bar bar-1 baz) (store-remove :bar store))

Problem: Macro call that should be transformed by with-assert-observers

Input: (with-assert-observers ("deleting bar" bar bar-1 baz) (store-remove :bar store))

Output:
(defmacro with-assert-observers ((desc &rest asserted-observers) &body body)
  `(let ((*observers* nil))
     (trc ,desc " -- checking observers")
     ,@body
     (let ((superfluous-observers (loop for run in *observers* if (not (member run (list ,@asserted-observers))) collect run))
	   (failed-observers (loop for asserted in (list ,@asserted-observers) if (not (member asserted *observers*)) collect asserted)))
       (trc "called observers on" *observers* :superflous superfluous-observers :failed failed-observers)
       (assert (not superfluous-observers))
       (assert (not failed-observers)))))

(let ((*observers* nil)) (trc "deleting bar" " -- checking observers") (store-remove :bar store) (let ((superfluous-observers (loop for run in *observers* if (not (member run (list bar bar-1 baz))) collect run)) (failed-observers (loop for asserted in (list bar bar-1 baz) if (not (member asserted *observers*)) collect asserted))) (trc "called observers on" *observers* :superflous superfluous-observers :failed failed-observers) (assert (not superfluous-observers)) (assert (not failed-observers))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(do-matches (s e regex target-string count :start start :end end) (incf count))

Write a macro that addresses: Macro call that should be transformed by do-matches

Input: (do-matches (s e regex target-string count :start start :end end) (incf count))

Output:
(defmacro do-matches ((match-start match-end regex
                                   target-string
                                   &optional result-form
                                   &key start end)
                      &body body)
  "Iterates over TARGET-STRING and tries to match REGEX as often as
possible evaluating BODY with MATCH-START and MATCH-END bound to the
start/end positions of each match in turn.  After the last match,
returns RESULT-FORM if provided or NIL otherwise.  An implicit block
named NIL surrounds DO-MATCHES; RETURN may be used to terminate the
loop immediately.  If REGEX matches an empty string the scan is
continued one position behind this match.  BODY may start with
declarations."
  ;; this is a simplified form of DO-SCANS - we just provide two dummy
  ;; vars and ignore them
  (with-unique-names (reg-starts reg-ends)
    `(do-scans (,match-start ,match-end
                ,reg-starts ,reg-ends
                ,regex ,target-string
                ,result-form
                :start ,start :end ,end)
      ,@body)))

(do-scans (s e #:reg-starts137 #:reg-ends138 regex target-string count :start start :end end) (incf count))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(incf nil)

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

Input: (incf nil)

Output: (defmacro INCF ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-html-string (:p (values "foo") "bar" "baz"))

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

Input: (with-html-string (:p (values "foo") "bar" "baz"))

Output:
(defmacro with-html (&body body &environment env)
  "Interpret BODY as HTML. Consult README.txt for the syntax."
  `(let ((*html* (ensure-html-stream *html*)))
     ,(if (and (null (cdr body)) (atom (car body)))
          (car body)
          `(progn ,@(parse-html body env)))))

(with-output-to-string (*html*) (with-html (:p (values "foo") "bar" "baz")))


Instruction:
Generate a defmacro form that transforms code like this:
(ematch0 accessor ((list 'function name) name) ((list 'quote name) name) (_ (error "[access] 1st arg is not a function designator")))

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

Input: (ematch0 accessor ((list 'function name) name) ((list 'quote name) name) (_ (error "[access] 1st arg is not a function designator")))

Output:
(defmacro ematch0 (what &body clauses)
  `(match0 ,what
     ,@clauses
     (_ (error "level0 match error!"))))

(match0 accessor ((list (quote function) name) name) ((list (quote quote) name) name) (_ (error "[access] 1st arg is not a function designator")) (_ (error "level0 match error!")))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defmethod nil)

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

Input: (defmethod nil)

Output: (defmacro DEFMETHOD ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(case 'some-name)

Problem: Macro call that should be transformed by CASE

Input: (case 'some-name)

Output: (defmacro CASE ...)

(let ((#:g196 'some-name))
  (declare (ignorable #:g196))
  (cond))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(all-of nil
  (progn))

What needs to change: Macro call that should be transformed by ALL-OF

Input:
(all-of nil
  (progn))

Output: (defmacro ALL-OF ...)


Instruction:
Generate a defmacro form that transforms code like this:
(continue-whopper 'some-name)

Pattern to recognize: Macro call that should be transformed by CONTINUE-WHOPPER

Input: (continue-whopper 'some-name)

Output: (defmacro CONTINUE-WHOPPER ...)

(call-next-method-fn self class-env inst-env mcs%caller mcs%next-methods
                     (list 'some-name))


Instruction:
Define a macro that eliminates this repetitive pattern:
(set-bop nil nil)

Issue: Macro call that should be transformed by SET-BOP

Input: (set-bop nil nil)

Output: (defmacro SET-BOP ...)

(eval-when (:load-toplevel :compile-toplevel :execute)
  (progn
   (save-binfix)
   (mapc
    (lambda (ops)
      (mapc
       (lambda (op1)
         (when (eq (car op1) 'nil)
           (setf (cadr op1) 'nil)
           (unless t (setf (cddr op1) 'nil))))
       ops))
    *binfix*)
   (assign-properties)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(mvlet* (x) x)

Problem: Macro call that should be transformed by mvlet*

Input: (mvlet* (x) x)

Output:
(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))))))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(when (not (node-slot body)) (format stream ";"))

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

Input: (when (not (node-slot body)) (format stream ";"))

Output:
(defmacro when (test &body forms)
  `(if ,test
	   ,(cl:if (cadr forms)
			   `(progn ,@forms)
			   (car forms))))

(if (not (node-slot body)) (format stream ";"))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(ematch0 clause ((list* patterns body) (list* (expand-multipatterns patterns) body)))

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

Input: (ematch0 clause ((list* patterns body) (list* (expand-multipatterns patterns) body)))

Output:
(defmacro ematch0 (what &body clauses)
  `(match0 ,what
     ,@clauses
     (_ (error "level0 match error!"))))

(match0 clause ((list* patterns body) (list* (expand-multipatterns patterns) body)) (_ (error "level0 match error!")))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(make-simple-collector-to-place nil)

Write a macro that addresses: Macro call that should be transformed by MAKE-SIMPLE-COLLECTOR-TO-PLACE

Input: (make-simple-collector-to-place nil)

Output: (defmacro MAKE-SIMPLE-COLLECTOR-TO-PLACE ...)

(progn
 (setf nil (alexandria:ensure-list nil))
 (let* ((#:tail123 (last nil)))
   (lambda (&rest values) (collect-at-end nil #:tail123 values) nil)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-prepared-query query (*connection* sql :use-prepare-cached *use-prepare-cached*) (setf query (execute-with-retry query binds)) (query-row-count query))

What needs to change: Macro call that should be transformed by with-prepared-query

Input: (with-prepared-query query (*connection* sql :use-prepare-cached *use-prepare-cached*) (setf query (execute-with-retry query binds)) (query-row-count query))

Output:
(defmacro with-prepared-query (query (conn sql &key use-prepare-cached) &body body)
  `(call-with-prepared-query ,conn ,sql (lambda (,query) ,@body) :use-prepare-cached ,use-prepare-cached))

(call-with-prepared-query *connection* sql (lambda (query) (setf query (execute-with-retry query binds)) (query-row-count query)) :use-prepare-cached *use-prepare-cached*)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(is (= a (dummy-add a 0)))

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

Input: (is (= a (dummy-add a 0)))

Output:
(defmacro is (test &rest reason-args)
  "The DWIM checking operator.

If TEST returns a true value a test-passed result is generated,
otherwise a test-failure result is generated. The reason, unless
REASON-ARGS is provided, is generated based on the form of TEST:

 (predicate expected actual) - Means that we want to check
 whether, according to PREDICATE, the ACTUAL value is
 in fact what we EXPECTED.

 (predicate value) - Means that we want to ensure that VALUE
 satisfies PREDICATE.

 Wrapping the TEST form in a NOT simply produces a negated reason
 string."
  (assert (listp test)
          (test)
          "Argument to IS must be a list, not ~S" test)
  (let (bindings effective-test default-reason-args)
    (with-gensyms (e a v)
      (flet ((process-entry (predicate expected actual &optional negatedp)
               ;; make sure EXPECTED is holding the entry that starts with 'values
               (when (and (consp actual)
                          (eq (car actual) 'values))
                 (assert (not (and (consp expected)
                                   (eq (car expected) 'values))) ()
                                   "Both the expected and actual part is a values expression.")
                 (rotatef expected actual))
               (let ((setf-forms))
                 (if (and (consp expected)
                          (eq (car expected) 'values))
                     (progn
                       (setf expected (copy-list expected))
                       (setf setf-forms (loop for cell = (rest expected) then (cdr cell)
                                              for i from 0
                                              while cell
                                              when (eq (car cell) '*)
                                              collect `(setf (elt ,a ,i) nil)
                                              and do (setf (car cell) nil)))
                       (setf bindings (list (list e `(list ,@(rest expected)))
                                            (list a `(multiple-value-list ,actual)))))
                     (setf bindings (list (list e expected)
                                          (list a actual))))
                 (setf effective-test `(progn
                                         ,@setf-forms
                                         ,(if negatedp
                                              `(not (,predicate ,e ,a))
                                              `(,predicate ,e ,a)))))))
        (list-match-case test
          ((not (?predicate ?expected ?actual))
           (process-entry ?predicate ?expected ?actual t)
           (setf default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which is ~2&~S~2%to ~2&~S~2% (it should not be)"
                       `',?actual a `',?predicate e)))
          ((not (?satisfies ?value))
           (setf bindings (list (list v ?value))
                 effective-test `(not (,?satisfies ,v))
                 default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which satisfies ~2&~S~2% (it should not)"
                       `',?value v `',?satisfies)))
          ((?predicate ?expected ?actual)
           (process-entry ?predicate ?expected ?actual)
           (setf default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%"
                       `',?actual a `',?predicate e)))
          ((?satisfies ?value)
           (setf bindings (list (list v ?value))
                 effective-test `(,?satisfies ,v)
                 default-reason-args
                 (list "~2&~S~2% evaluated to ~2&~S~2% which does not satisfy ~2&~S~2%"
                       `',?value v `',?satisfies)))
          (?_
           (setf bindings '()
                 effective-test test
                 default-reason-args (list "~2&~S~2% was NIL." `',test)))))
      `(let ,bindings
         (if ,effective-test
             (add-result 'test-passed :test-expr ',test)
             (process-failure ',test
                              ,@(or reason-args default-reason-args)))))))

(let ((#:e155 a) (#:a156 (dummy-add a 0))) (if (progn (= #:e155 #:a156)) (add-result (quote test-passed) :test-expr (quote (= a (dummy-add a 0)))) (process-failure (quote (= a (dummy-add a 0))) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote (dummy-add a 0)) #:a156 (quote =) #:e155)))


Instruction:
Generate a defmacro form that transforms code like this:
(define-script-symbol-macro nil
  nil)

Pattern to recognize: Macro call that should be transformed by DEFINE-SCRIPT-SYMBOL-MACRO

Input:
(define-script-symbol-macro nil
  nil)

Output: (defmacro DEFINE-SCRIPT-SYMBOL-MACRO ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(is-print (princ "ABCDEFGH") "ABCDEFGHIJKLMNO")

Problem: Macro call that should be transformed by is-print

Input: (is-print (princ "ABCDEFGH") "ABCDEFGHIJKLMNO")

Output:
(defmacro is-print (got expected &optional desc)
  (with-gensyms (output duration duration-inner)
    (once-only (expected desc)
      `(with-catching-errors (:description ,desc :expected ,expected)
         (let* (,duration
                (,output (with-output-to-string (*standard-output*)
                           (with-duration ((,duration-inner ,output) ,got)
                             (declare (ignore ,output))
                             (setq ,duration ,duration-inner)))))
           (test ,output ,expected ,desc
                 :duration ,duration
                 :got-form ',got
                 :test-fn #'string=
                 :report-expected-label "output"))))))

(let ((#:expected203 "ABCDEFGHIJKLMNO") (#:desc204 nil)) (with-catching-errors (:description #:desc204 :expected #:expected203) (let* (#:duration201 (#:output200 (with-output-to-string (*standard-output*) (with-duration ((#:duration-inner202 #:output200) (princ "ABCDEFGH")) (declare (ignore #:output200)) (setq #:duration201 #:duration-inner202))))) (test #:output200 #:expected203 #:desc204 :duration #:duration201 :got-form (quote (princ "ABCDEFGH")) :test-fn (function string=) :report-expected-label "output"))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-hook-type string->string (function (string) string) "Hook that takes a string and produces a new one.")

Issue: Macro call that should be transformed by define-hook-type

Input: (define-hook-type string->string (function (string) string) "Hook that takes a string and produces a new one.")

Output:
(defmacro define-hook-type (name type &optional documentation)
  "Define hook class.
Type must be something like:

  (function (string) (values integer t))

The `handler-type' of the defined hook class has `:class' allocation
type, so that all hooks of such class have the same `handler-type'."
  (let* ((name (string name))
         (hook-class-name (intern (serapeum:concat "HOOK-" name))))
    `(defclass ,hook-class-name (hook)
       ((handler-type :initform ',type :allocation :class))
       (:metaclass closer-mop:funcallable-standard-class)
       ,@(when documentation
           `((:documentation ,documentation))))))

(defclass hook-string->string (hook) ((handler-type :initform (quote (function (string) string)) :allocation :class)) (:metaclass sb-mop:funcallable-standard-class) (:documentation "Hook that takes a string and produces a new one."))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(-<> -<>> some-<> some-<>>)

Write a macro that addresses: Macro call that should be transformed by -<>

Input: (-<> -<>> some-<> some-<>>)

Output: (defmacro -<> (init &body exps) (diamond-wand init exps))


Instruction:
Generate a defmacro form that transforms code like this:
(defclass/std example () ((slot1 slot2 slot3)))

Pattern to recognize: Macro call that should be transformed by defclass/std

Input: (defclass/std example () ((slot1 slot2 slot3)))

Output:
(defmacro defclass/std (name direct-superclasses direct-slots &rest options
                        &environment env)
  "Shortcut macro to the DEFCLASS macro.

  (defclass/std example ()
    ((slot1 slot2 slot3)))

  expands to:

  (DEFCLASS EXAMPLE ()
    ((SLOT1 :ACCESSOR SLOT1 :INITARG :SLOT1 :INITFORM NIL)
    (SLOT2 :ACCESSOR SLOT2 :INITARG :SLOT2 :INITFORM NIL)
    (SLOT3 :ACCESSOR SLOT3 :INITARG :SLOT3 :INITFORM NIL)))

  Each slot definition accepts options:

    :std 1 => changes the :initform to 1. It can be :unbound.
    :with or :with-prefix => creates accessors with the class name as prefix.

  See the README for more.

  See also `class/std' and `print-object/std'.
  "
  `(defclass ,name ,direct-superclasses
     ,(process-slots env direct-slots name)
     ,@options))

(defclass example nil ((slot1 :accessor slot1 :initarg :slot1 :initform nil) (slot2 :accessor slot2 :initarg :slot2 :initform nil) (slot3 :accessor slot3 :initarg :slot3 :initform nil)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(-> :g () 2)

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

Input: (-> :g () 2)

Output:
(defmacro -> (invariant &body args)
  "See flow:atomically"
  `(atomically ,invariant ,@args))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-log-error-handling () (with-wcs-math-error-handling (ret (log1+ x)) (check-wcs-math-result)))

Issue: Macro call that should be transformed by with-log-error-handling

Input: (with-log-error-handling () (with-wcs-math-error-handling (ret (log1+ x)) (check-wcs-math-result)))

Output:
(defmacro with-log-error-handling (() &body body)
  `(handler-case
      (progn ,@body)
    #+allegro
    ;; TODO: rewrite other `simple-error' handler to use arithmetic-error.
    (arithmetic-error (e)
      (let ((operands (arithmetic-error-operands e)))
        (cond ((zerop (first operands))
               (wcs-raise-fe-exception FE_DIVBYZERO :errno ERANGE)
               (- HUGE_VAL))
              (t
               (error e)))))))

(handler-case (progn (with-wcs-math-error-handling (ret (log1+ x)) (check-wcs-math-result))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(signal-reader-error "Could not find character with name '~A'" name)

Problem: Macro call that should be transformed by signal-reader-error

Input: (signal-reader-error "Could not find character with name '~A'" name)

Output:
(defmacro signal-reader-error (format-control &rest format-arguments)
  "Like ERROR but signals a SIMPLE-READER-ERROR for the stream
*STREAM*."
  `(error 'simple-reader-error
          :stream *stream*
          :format-control ,format-control
          :format-arguments (list ,@format-arguments)))

(error (quote simple-reader-error) :stream *stream* :format-control "Could not find character with name '~A'" :format-arguments (list name))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-class some-class (some super classes) ((slot1 :unbound)) (1 2) (:accessor-name-transformer (make-name-transformer name "-ZORK")) (3 4))

Write a macro that addresses: Macro call that should be transformed by define-class

Input: (define-class some-class (some super classes) ((slot1 :unbound)) (1 2) (:accessor-name-transformer (make-name-transformer name "-ZORK")) (3 4))

Output:
(defmacro define-class (name supers slots &rest options)
  "Convenience wrapper of `defclass'.

It automates a lot of boilerplate (like exporting all the accessors of a class)
plus adds some new features.

Slot options:

- The initform can be specified as the second value.

- `:accessor', `:reader' and `:writer' can be set to either a name, NIL or T.
  If NIL, the method is not generated.
  If T, the method is generated using the `:accessor-name-transformer' class option value.

- The `:export' option allows to control the slot-name export on a per-slot basis.

New class options (defaults are NIL unless specified):

- `:slot-definition-transformer' (default: `default-slot-definition-transformer').
  A function that takes a SLOT-DEFINITION and returns a new one.

- `:accessor-name-package': The package of the generated accessors.  See
  `:accessor-name-transformer'.  Some special values are accepted:
  - `:slot-name': The package of the slot-name.
  - `:default': The current package.

- `:accessor-name-transformer' (default `default-accessor-name-transformer').

  A function of (SLOT-NAME SLOT-DEFINITION) arguments that returns the accessor
  name (a symbol).  Other transformer: `dwim-accessor-name-transformer'.

- `:automatic-accessors-p': Whether to generate accessor names automatically for
  all slots.

  As a special case, the accessor is not generated if all following conditions are met:
  - `:accessor-name-package' is `:slot-name',
  - slot name package is different from current package,
  - if the `:accessor' slot option is not provided,

- `:initarg-name-transformer' (default: `default-initarg-name-transformer'.)

  A function of (SLOT-NAME SLOT-DEFINITION) arguments that returns the accessor
  name (a symbol.

- `:automatic-initargs-p' (default: T): Whether to generate accessor names
  automatically for all slots.

- `:predicate-name-transformer' (default: `default-predicate-name-transformer').

  A function of (SLOT-NAME SLOT-DEFINITION) arguments that returns the predicate
  name (a symbol).

- `:automatic-predicates-p' (default: T): Whether to generate a predicate
  for the class.

- `:type-inference' (default: `default-type-inference').

  Function that returns the type of a slot definition (with an initform).  It
  takes 3 arguments:

  - The initform.
  - The slot name.
  - The rest of the slot definition.

- `:automatic-types-p': Whether to generate the type automatically for all
  slots.  The type can still be specified manually with the `:type' slot option.

- Self-explanatory export options (all NIL by default):
  - `:export-class-name-p'
  - `:export-accessor-names-p'
  - `:export-slot-names-p'
  - `:export-predicate-name'"
  (build-defclass-like-expansion
   name supers slots options
   (lambda (processed-slots clean-options)
     `(defclass ,name ,supers
        ,processed-slots
        ,@clean-options))))

(progn (defclass some-class (some super classes) ((slot1 :accessor slot1-zork :initarg :slot1)) (1 2) (3 4)) (unless (fboundp (quote some-class-p)) (define-generic some-class-p (object) #A((75) base-char . "Auto-generated predicate for whether OBJECT is an instance of `some-class'.") (declare (sb-ext:muffle-conditions style-warning)) (typep object (quote some-class)))) (setf (documentation (quote slot1-zork) (quote function)) #A((48) base-char . "Auto-generated accessor function for slot SLOT1.")) (ignore-errors (setf (documentation (fdefinition (quote slot1-zork)) (quote function)) #A((48) base-char . "Auto-generated accessor function for slot SLOT1."))) (ignore-errors (setf (documentation (fdefinition (quote (setf slot1-zork))) (quote function)) #A((48) base-char . "Auto-generated accessor function for slot SLOT1."))) (find-class (quote some-class) nil))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defclass/std unknown () ((slot :wi :unknown keywords :and values)))

Issue: Macro call that should be transformed by defclass/std

Input: (defclass/std unknown () ((slot :wi :unknown keywords :and values)))

Output:
(defmacro defclass/std (name direct-superclasses direct-slots &rest options
                        &environment env)
  "Shortcut macro to the DEFCLASS macro.

  (defclass/std example ()
    ((slot1 slot2 slot3)))

  expands to:

  (DEFCLASS EXAMPLE ()
    ((SLOT1 :ACCESSOR SLOT1 :INITARG :SLOT1 :INITFORM NIL)
    (SLOT2 :ACCESSOR SLOT2 :INITARG :SLOT2 :INITFORM NIL)
    (SLOT3 :ACCESSOR SLOT3 :INITARG :SLOT3 :INITFORM NIL)))

  Each slot definition accepts options:

    :std 1 => changes the :initform to 1. It can be :unbound.
    :with or :with-prefix => creates accessors with the class name as prefix.

  See the README for more.

  See also `class/std' and `print-object/std'.
  "
  `(defclass ,name ,direct-superclasses
     ,(process-slots env direct-slots name)
     ,@options))

(defclass unknown nil ((slot :writer slot :initarg :slot :initform nil :unknown keywords :and values)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(def-dynenv-fun nil
    (progn))

Write a macro that addresses: Macro call that should be transformed by DEF-DYNENV-FUN

Input:
(def-dynenv-fun nil
    (progn))

Output: (defmacro DEF-DYNENV-FUN ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun nil (&rest #:args) (apply (dynenv-function nil) #:args))
  (defvar #:nil144 (lambda (progn)))
  (setf (get 'nil 'dynenv-fun) '#:nil144))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(mapping nil (progn))

Problem: Macro call that should be transformed by MAPPING

Input: (mapping nil (progn))

Output: (defmacro MAPPING ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defsyntax nil
  nil)

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

Input:
(defsyntax nil
  nil)

Output:
(defmacro defsyntax (name &body options)
  `(progn
     (setf (get ',name :options) ',options)
     (defvar ,name (defreadtable ,name ,@options))))

(progn
 (setf (get 'nil :options) '(nil))
 (defvar nil
   (defreadtable nil
     nil)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(builder (:auth-basic :authenticator (lambda (user pass) (declare (ignore user pass)) t)) *app*)

Problem: Macro call that should be transformed by builder

Input: (builder (:auth-basic :authenticator (lambda (user pass) (declare (ignore user pass)) t)) *app*)

Output:
(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)))

(reduce (function funcall) (remove-if (function null) (list (lambda (#:app174) (funcall (find-middleware :auth-basic) #:app174 :authenticator (lambda (user pass) (declare (ignore user pass)) t))))) :initial-value (to-app *app*) :from-end t)


Instruction:
Define a macro that eliminates this repetitive pattern:
(defclass/a dbi-connection () ((auto-commit :type boolean :initarg :auto-commit :initform t) (database-name :initarg :database-name :accessor connection-database-name) (%handle :initarg :handle :accessor connection-handle) (query-cache :initform (make-hash-table :test 'equal) :accessor connection-query-cache) (established-at :initarg :established-at :initform (get-internal-real-time) :accessor connection-established-at)) (:documentation "Base class for managing DB connection."))

Issue: Macro call that should be transformed by defclass/a

Input: (defclass/a dbi-connection () ((auto-commit :type boolean :initarg :auto-commit :initform t) (database-name :initarg :database-name :accessor connection-database-name) (%handle :initarg :handle :accessor connection-handle) (query-cache :initform (make-hash-table :test 'equal) :accessor connection-query-cache) (established-at :initarg :established-at :initform (get-internal-real-time) :accessor connection-established-at)) (:documentation "Base class for managing DB connection."))

Output:
(defmacro defclass/a (name superclasses slots &rest class-options)
  `(progn
     (defclass ,name ,superclasses ,slots ,@class-options)
     (deftype ,(intern (format nil "<~A>" (symbol-name name))) () ',name)
     (setf (find-class ',(intern (format nil "<~A>" (symbol-name name))))
           (find-class ',name))))

(progn (defclass dbi-connection nil ((auto-commit :type boolean :initarg :auto-commit :initform t) (database-name :initarg :database-name :accessor connection-database-name) (%handle :initarg :handle :accessor connection-handle) (query-cache :initform (make-hash-table :test (quote equal)) :accessor connection-query-cache) (established-at :initarg :established-at :initform (get-internal-real-time) :accessor connection-established-at)) (:documentation "Base class for managing DB connection.")) (deftype <dbi-connection> nil (quote dbi-connection)) (setf (find-class (quote <dbi-connection>)) (find-class (quote dbi-connection))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-cached-reader-conditionals
  nil
  (progn))

Write a macro that addresses: Macro call that should be transformed by WITH-CACHED-READER-CONDITIONALS

Input:
(with-cached-reader-conditionals
  nil
  (progn))

Output: (defmacro WITH-CACHED-READER-CONDITIONALS ...)

(call-with-cached-reader-conditionals (lambda () nil (progn)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-yield-binds (format nil "~A(~{~A~^, ~})" (sql-op-name op) (mapcar #'yield (function-op-expressions op))))

What needs to change: Macro call that should be transformed by with-yield-binds

Input: (with-yield-binds (format nil "~A(~{~A~^, ~})" (sql-op-name op) (mapcar #'yield (function-op-expressions op))))

Output:
(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))))

(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "~A(~{~A~^, ~})" (sql-op-name op) (mapcar (function yield) (function-op-expressions op)))) (loop for bind in (reverse *bind-values*) append bind)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(when-let ((x 1) (y nil) (z 3)) :oops)

What needs to change: Macro call that should be transformed by when-let

Input: (when-let ((x 1) (y nil) (z 3)) :oops)

Output:
(defmacro when-let (bindings &body forms)
    "Creates new variable bindings, and conditionally executes FORMS.

BINDINGS must be either single binding of the form:

 (variable initial-form)

or a list of bindings of the form:

 ((variable-1 initial-form-1)
  (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.

If all variables were bound to true values, then FORMS are executed as an
implicit PROGN."
  (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
                           (list bindings)
                           bindings))
         (variables (mapcar #'car binding-list)))
    `(let ,binding-list
       (when (and ,@variables)
         ,@forms))))

(let ((x 1) (y nil) (z 3)) (when (and x y z) :oops))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-quote-char (sxql:yield sql))

What needs to change: Macro call that should be transformed by with-quote-char

Input: (with-quote-char (sxql:yield sql))

Output:
(defmacro with-quote-char (&body body)
  `(let ((sxql:*quote-character* (or sxql:*quote-character*
                                     (connection-quote-character))))
     ,@body))

(let ((*quote-character* (or *quote-character* (connection-quote-character)))) (sxql/sql-type:yield sql))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-fixtures (fixtures test) (call-next-method))

Problem: Macro call that should be transformed by with-fixtures

Input: (with-fixtures (fixtures test) (call-next-method))

Output:
(defmacro with-fixtures (fixtures &body body)
  `(call-with-fixtures (lambda () ,@body) ,fixtures))

(call-with-fixtures (lambda nil (call-next-method)) (fixtures test))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(-> nil () 0)

Problem: Macro call that should be transformed by ->

Input: (-> nil () 0)

Output:
(defmacro -> (invariant &body args)
  "See flow:atomically"
  `(atomically ,invariant ,@args))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(when-let* ((x 2) (y x)) (+ x y))

What needs to change: Macro call that should be transformed by when-let

Input: (when-let* ((x 2) (y x)) (+ x y))

Output:
(defmacro when-let (bindings &body forms)
    "Creates new variable bindings, and conditionally executes FORMS.

BINDINGS must be either single binding of the form:

 (variable initial-form)

or a list of bindings of the form:

 ((variable-1 initial-form-1)
  (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.

If all variables were bound to true values, then FORMS are executed as an
implicit PROGN."
  (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings)))
                           (list bindings)
                           bindings))
         (variables (mapcar #'car binding-list)))
    `(let ,binding-list
       (when (and ,@variables)
         ,@forms))))

(let ((x 2)) (when x (let ((y x)) (when y (progn (+ x y))))))


Instruction:
Generate a defmacro form that transforms code like this:
(defpsmacro nil
    (progn))

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

Input:
(defpsmacro nil
    (progn))

Output: (defmacro DEFPSMACRO ...)

(progn
 nil
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf (gethash 'nil *macro-toplevel*)
           (lambda (#:|ps-macro-form-arg-195|)
             (destructuring-bind (progn) (cdr #:|ps-macro-form-arg-195|))))
   (setf (gethash 'nil *macro-toplevel-lambda-list*) '(progn))
   'nil))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-error duplicate-name () (name) "This name appears more than once in this form list ~a" name)

Write a macro that addresses: Macro call that should be transformed by define-error

Input: (define-error duplicate-name () (name) "This name appears more than once in this form list ~a" name)

Output:
(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))

(defcondition duplicate-name (:error-type varjo-error :prefix "Varjo") (name) "This name appears more than once in this form list ~a" name)