Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-generic generic (a b &key c) "If :export-generic-name-p is true, export the name." (:export-generic-name-p t))

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

Input: (define-generic generic (a b &key c) "If :export-generic-name-p is true, export the name." (:export-generic-name-p t))

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 &key c) (:documentation "If :export-generic-name-p is true, export the name.")) (eval-when (:compile-toplevel :load-toplevel :execute) (export (quote generic) #A((8) base-char . "NCLASSES"))) (setf (documentation (quote generic) (quote function)) "If :export-generic-name-p is true, export the name.") (setf (documentation (fdefinition (quote generic)) (quote function)) "If :export-generic-name-p is true, export the name."))


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

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

Input:
(cond-<>>
  nil
  nil)

Output: (defmacro COND-<>> ...)


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

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

Input: (inext-or-error nil (progn))

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

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


Instruction:
Generate a defmacro form that transforms code like this:
(def-neo4j-fun get-node-property (node-id property) :get (:uri-spec (format nil "node/~A/properties/~A" node-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (:status-handlers (200 (decode-neo4j-json-output body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'property-not-found-error :uri uri))))

Pattern to recognize: Macro call that should be transformed by def-neo4j-fun

Input: (def-neo4j-fun get-node-property (node-id property) :get (:uri-spec (format nil "node/~A/properties/~A" node-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (:status-handlers (200 (decode-neo4j-json-output body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'property-not-found-error :uri uri))))

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 get-node-property (&key node-id property) (let ((uri (format nil "node/~A/properties/~A" node-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (json (encode-neo4j-json-payload nil :string))) (make-neo4j-request :get uri json (list (list 200 (lambda (body uri json) (decode-neo4j-json-output body))) (list 400 (lambda (body uri json) (error (quote invalid-data-sent-error) :uri uri :json json))) (list 404 (lambda (body uri json) (error (quote property-not-found-error) :uri uri))))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-table-name table-name-b (yield clause-b))

Issue: Macro call that should be transformed by with-table-name

Input: (with-table-name table-name-b (yield clause-b))

Output:
(defmacro with-table-name (table-name &body body)
  `(let ((*table-name-scope* ,table-name))
     ,@body))

(let ((*table-name-scope* table-name-b)) (yield clause-b))


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

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

Input: (vect-of nil (progn))

Output: (defmacro VECT-OF ...)

(let ((#:vect139 (make-array 10 :adjustable t :fill-pointer 0)))
  (do-for ((progn))
    (vector-push-extend nil #:vect139))
  #:vect139)


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

Problem: Macro call that should be transformed by PSETQ

Input: (psetq nil nil)

Output: (defmacro PSETQ ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defhandler setq (setq &rest pairs) (declare (ignore setq)) (let ((vars (loop for s in pairs by #'cddr collect (macroexpand s *env*)))) (let ((expanded (loop for n in vars for r in (rest pairs) by #'cddr collect n collect r))) (if (some 'listp vars) (e `(setf ,@expanded)) `(list 'setq ,@(e-list expanded))))))

Problem: Macro call that should be transformed by defhandler

Input: (defhandler setq (setq &rest pairs) (declare (ignore setq)) (let ((vars (loop for s in pairs by #'cddr collect (macroexpand s *env*)))) (let ((expanded (loop for n in vars for r in (rest pairs) by #'cddr collect n collect r))) (if (some 'listp vars) (e `(setf ,@expanded)) `(list 'setq ,@(e-list expanded))))))

Output:
(defmacro defhandler (symbol lambda-list &body body)
  (let ((syms (force-list symbol)))
    (let ((func (intern (format nil "~A~A" 'hander- (first syms)))))
      `(progn
         (defun ,func ,lambda-list
           ,@body)
         (setf
          ,@(loop for sym in syms
               collect `(gethash ',sym *form-handler*)
               collect `',func))))))

(progn (defun hander-setq (setq &rest pairs) (declare (ignore setq)) (let ((vars (loop for s in pairs by (function cddr) collect (macroexpand s *env*)))) (let ((expanded (loop for n in vars for r in (rest pairs) by (function cddr) collect n collect r))) (if (some (quote listp) vars) (e (sb-int:quasiquote (setf #S(sb-impl::comma :expr expanded :kind 2)))) (sb-int:quasiquote (list (quote setq) #S(sb-impl::comma :expr (e-list expanded) :kind 2))))))) (setf (gethash (quote setq) *form-handler*) (quote hander-setq)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-preprocessor-state-slots (state) (when if-section-skip-reason (return-from process-preprocessing-directive nil)) (let ((identifier (pop-last-preprocessor-directive-token directive-token-list directive-symbol))) (remove-local-preprocessor-macro state identifier)))

Write a macro that addresses: Macro call that should be transformed by with-preprocessor-state-slots

Input: (with-preprocessor-state-slots (state) (when if-section-skip-reason (return-from process-preprocessing-directive nil)) (let ((identifier (pop-last-preprocessor-directive-token directive-token-list directive-symbol))) (remove-local-preprocessor-macro state identifier)))

Output:
(defmacro with-preprocessor-state-slots ((state) &body body)
  `(with-accessors ((file-pathname pp-state-file-pathname)
                    (token-list pp-state-token-list)
                    (result-list pp-state-result-list)
                    (line-number pp-state-line-number)
                    (tokens-in-line pp-state-tokens-in-line)
                    (macro-alist pp-state-macro-alist)
                    (if-section-stack pp-state-if-section-stack)
                    (if-section-skip-reason pp-state-if-section-skip-reason)
                    (include-stack pp-state-include-stack))
       ,state
     ,@body))

(with-accessors ((file-pathname pp-state-file-pathname) (token-list pp-state-token-list) (result-list pp-state-result-list) (line-number pp-state-line-number) (tokens-in-line pp-state-tokens-in-line) (macro-alist pp-state-macro-alist) (if-section-stack pp-state-if-section-stack) (if-section-skip-reason pp-state-if-section-skip-reason) (include-stack pp-state-include-stack)) state (when if-section-skip-reason (return-from process-preprocessing-directive nil)) (let ((identifier (pop-last-preprocessor-directive-token directive-token-list directive-symbol))) (remove-local-preprocessor-macro state identifier)))


Instruction:
Generate a defmacro form that transforms code like this:
(enable-quasi-quoted-bivalent-to-bivalent-emitting-form-syntax nil)

Pattern to recognize: Macro call that should be transformed by ENABLE-QUASI-QUOTED-BIVALENT-TO-BIVALENT-EMITTING-FORM-SYNTAX

Input: (enable-quasi-quoted-bivalent-to-bivalent-emitting-form-syntax nil)

Output: (defmacro ENABLE-QUASI-QUOTED-BIVALENT-TO-BIVALENT-EMITTING-FORM-SYNTAX ...)

(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-quasi-quoted-bivalent-to-bivalent-emitting-form-syntax-in-readtable nil
                                                                           :with-inline-emitting
                                                                           nil
                                                                           :declarations
                                                                           'nil
                                                                           :start-character
                                                                           nil
                                                                           :end-character
                                                                           nil
                                                                           :unquote-character
                                                                           #\COMMA
                                                                           :splice-character
                                                                           #\COMMERCIAL_AT
                                                                           :destructive-splice-character
                                                                           #\FULL_STOP
                                                                           :dispatched-quasi-quote-name
                                                                           "biv")
  (values))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(draw scene (:rect :x 40 :y 40 :height 30 :width 30) :stroke "blue" :stroke-width 1 :fill "yellow")

Problem: Macro call that should be transformed by draw

Input: (draw scene (:rect :x 40 :y 40 :height 30 :width 30) :stroke "blue" :stroke-width 1 :fill "yellow")

Output:
(defmacro draw (scene (shape &rest params) &rest opts)
  (let ((element (gensym)))
    `(let ((,element (funcall #'make-svg-element ,shape (append (list ,@params) (list ,@opts)))))
       (add-element ,scene ,element)
       ,element)))

(let ((#:g143 (funcall (function make-svg-element) :rect (append (list :x 40 :y 40 :height 30 :width 30) (list :stroke "blue" :stroke-width 1 :fill "yellow"))))) (add-element scene #:g143) #:g143)


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-error for-loop-only-one-var () () "for loops can only iterate over one variable")

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

Input: (define-error for-loop-only-one-var () () "for loops can only iterate over one variable")

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 for-loop-only-one-var (:error-type varjo-error :prefix "Varjo") nil "for loops can only iterate over one variable")


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-special-initargs nil)

Issue: Macro call that should be transformed by WITH-SPECIAL-INITARGS

Input: (with-special-initargs nil)

Output: (defmacro WITH-SPECIAL-INITARGS ...)

(funcall-with-special-initargs (list) (lambda ()))


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

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

Input: (define-modf-rewrite cadar (expr) `(car (cdar ,(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 cadar) *modf-rewrites*) (lambda (expr) (sb-int:quasiquote (car (cdar #S(sb-impl::comma :expr (second expr) :kind 0)))))))


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

Problem: Macro call that should be transformed by ->*

Input:
(->*
  nil
  nil)

Output: (defmacro ->* ...)


Instruction:
Generate a defmacro form that transforms code like this:
(define SEEK_END 2)

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

Input: (define SEEK_END 2)

Output:
(defmacro define (name value &rest docstring)
  "Like a #define but also visible to Lisp code."
  `(progn
     (eval-when (:compile-toplevel :load-toplevel :execute)
       (defvar ,(pp-defines *package*) (make-hash-table))
       (setf (gethash ',name ,(pp-defines *package*)) ,(prin1-to-string value)))
     (defparameter ,name ,value ,@docstring)))

(progn (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *preprocessor-defines* (make-hash-table)) (setf (gethash (quote seek_end) *preprocessor-defines*) #A((1) base-char . "2"))) (defparameter seek_end 2))


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

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

Input: (quasiquote nil (progn))

Output: (defmacro QUASIQUOTE ...)

(let ((#:source123 nil))
  (%append #:source123 (common-lisp:list (%quote #:source123 'progn))
           (%quote #:source123 'nil)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(def-neo4j-fun set-node-properties (node-id properties) :put (:encode properties :string) (:uri-spec (format nil "node/~A/properties" node-id)) (:status-handlers (204 (values t body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'node-not-found-error :uri uri))))

What needs to change: Macro call that should be transformed by def-neo4j-fun

Input: (def-neo4j-fun set-node-properties (node-id properties) :put (:encode properties :string) (:uri-spec (format nil "node/~A/properties" node-id)) (:status-handlers (204 (values t body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'node-not-found-error :uri uri))))

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 set-node-properties (&key node-id properties) (let ((uri (format nil "node/~A/properties" node-id)) (json (encode-neo4j-json-payload properties :string))) (make-neo4j-request :put uri json (list (list 204 (lambda (body uri json) (values t body))) (list 400 (lambda (body uri json) (error (quote invalid-data-sent-error) :uri uri :json json))) (list 404 (lambda (body uri json) (error (quote node-not-found-error) :uri uri))))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-cruft %list-all-readtable-names () "Return a list of all available readtable names." #+ :common-lisp (list* :standard :current :modern (loop for name being each hash-value of *readtable-names* collect name)))

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

Input: (define-cruft %list-all-readtable-names () "Return a list of all available readtable names." #+ :common-lisp (list* :standard :current :modern (loop for name being each hash-value of *readtable-names* collect name)))

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 %list-all-readtable-names)) (defun %list-all-readtable-names nil "Return a list of all available readtable names." (list* :standard :current :modern (loop for name being each hash-value of *readtable-names* collect name))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-shared-method nil
    :key
  nil)

What needs to change: Macro call that should be transformed by DEFINE-SHARED-METHOD

Input:
(define-shared-method nil
    :key
  nil)

Output: (defmacro DEFINE-SHARED-METHOD ...)

(define-incongruent-method incongruent-methods.methods::nil
    :key
  nil)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time self-evaluating? (thing) (and (not (consp thing)) (or (not (symbolp thing)) (null thing) (eq thing t) (eq (symbol-package thing) (symbol-package :x)))))

Problem: Macro call that should be transformed by defun-compile-time

Input: (defun-compile-time self-evaluating? (thing) (and (not (consp thing)) (or (not (symbolp thing)) (null thing) (eq thing t) (eq (symbol-package thing) (symbol-package :x)))))

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 self-evaluating? (thing) (and (not (consp thing)) (or (not (symbolp thing)) (null thing) (eq thing t) (eq (symbol-package thing) (symbol-package :x))))) (eval-when (:compile-toplevel) (compile (quote self-evaluating?))))


Instruction:
Generate a defmacro form that transforms code like this:
(alist-bind (name fields) form (let ((sym (foreign-type-symbol name :cunion *package*))) (let ((cunion-fields (parse-fields fields))) (when (symbol-package sym) (pushnew `(:union (,sym)) *foreign-record-list* :test #'equal)) `(define-foreign-record ',sym :union ,(aval :bit-size form) ,(aval :bit-alignment form) ',cunion-fields))))

Pattern to recognize: Macro call that should be transformed by alist-bind

Input: (alist-bind (name fields) form (let ((sym (foreign-type-symbol name :cunion *package*))) (let ((cunion-fields (parse-fields fields))) (when (symbol-package sym) (pushnew `(:union (,sym)) *foreign-record-list* :test #'equal)) `(define-foreign-record ',sym :union ,(aval :bit-size form) ,(aval :bit-alignment form) ',cunion-fields))))

Output:
(defmacro alist-bind ((&rest vars) alist &body body)
  "Inefficient but doesn't really matter here"
  (once-only (alist)
    `(let (,@(mapcar (lambda (x)
                       (if (consp x)
                           `(,(car x) (aval ,(cadr x) ,alist))
                           `(,x (aval ,(make-keyword x) ,alist))))
                     vars))
       ,@body)))

(let ((#:alist242 form)) (let ((name (aval :name #:alist242)) (fields (aval :fields #:alist242))) (let ((sym (foreign-type-symbol name :cunion *package*))) (let ((cunion-fields (parse-fields fields))) (when (symbol-package sym) (pushnew (sb-int:quasiquote (:union (#S(sb-impl::comma :expr sym :kind 0)))) *foreign-record-list* :test (function equal))) (sb-int:quasiquote (define-foreign-record (quote #S(sb-impl::comma :expr sym :kind 0)) :union #S(sb-impl::comma :expr (aval :bit-size form) :kind 0) #S(sb-impl::comma :expr (aval :bit-alignment form) :kind 0) (quote #S(sb-impl::comma :expr cunion-fields :kind 0))))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-global-parameter nil :key nil)

What needs to change: Macro call that should be transformed by DEFINE-GLOBAL-PARAMETER

Input: (define-global-parameter nil :key nil)

Output: (defmacro DEFINE-GLOBAL-PARAMETER ...)

(progn
 (store-in-symbol-plist nil :key .value-key.)
 (sb-ext:defglobal nil (get 'nil +value-key+))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf nil (get 'nil +value-key+)))
 (remprop 'nil +value-key+)
 'nil)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(deferror "08003" connection-does-not-exist)

Problem: Macro call that should be transformed by deferror

Input: (deferror "08003" connection-does-not-exist)

Output:
(defmacro deferror (code typename &optional (superclass 'database-error))
  `(progn (define-condition ,typename (,superclass) ())
          (setf (gethash ,code *error-table*) ',typename)))

(progn (define-condition connection-does-not-exist (database-error) nil) (setf (gethash "08003" *error-table*) (quote connection-does-not-exist)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(*> (take-while (lambda (c) (eql #\a c))) (take-while (lambda (c) (or (eql #\b c) (eql #\c c) (eql #\d c)))))

Issue: Macro call that should be transformed by *>

Input: (*> (take-while (lambda (c) (eql #\a c))) (take-while (lambda (c) (or (eql #\b c) (eql #\c c) (eql #\d c)))))

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 (#:*>-offset212) (multiple-value-bind (#:*>-res213 #:*>-next214) (funcall (take-while (lambda (c) (eql #\LATIN_SMALL_LETTER_A c))) #:*>-offset212) (if (ok? #:*>-res213) (funcall (take-while (lambda (c) (or (eql #\LATIN_SMALL_LETTER_B c) (eql #\LATIN_SMALL_LETTER_C c) (eql #\LATIN_SMALL_LETTER_D c)))) #:*>-next214) (fail #:*>-next214))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define SEEK_CUR 1)

Issue: Macro call that should be transformed by define

Input: (define SEEK_CUR 1)

Output:
(defmacro define (name value &rest docstring)
  "Like a #define but also visible to Lisp code."
  `(progn
     (eval-when (:compile-toplevel :load-toplevel :execute)
       (defvar ,(pp-defines *package*) (make-hash-table))
       (setf (gethash ',name ,(pp-defines *package*)) ,(prin1-to-string value)))
     (defparameter ,name ,value ,@docstring)))

(progn (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *preprocessor-defines* (make-hash-table)) (setf (gethash (quote seek_cur) *preprocessor-defines*) #A((1) base-char . "1"))) (defparameter seek_cur 1))


Instruction:
Generate a defmacro form that transforms code like this:
(receive (k v) (apply fn args) (setf (gethash k hash-table) v))

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

Input: (receive (k v) (apply fn args) (setf (gethash k hash-table) v))

Output:
(defmacro receive (formals expr &body body)
  "Stricter version of `multiple-value-bind'.

Use `receive' when you want to enforce that EXPR should return a
certain number of values, or a minimum number of values.

If FORMALS is a proper list, then EXPR must return exactly as many
values -- no more and no less -- as there are variables in FORMALS.

If FORMALS is an improper list (VARS . REST), then EXPR must return at
least as many values as there are VARS, and any further values are
bound, as a list, to REST.

Lastly, if FORMALS is a symbol, bind that symbol to all the values
returned by EXPR, as if by `multiple-value-list'.

From Scheme (SRFI-8)."
  ;; It's probably not worth stack-allocating the thunk.
  (cond ((null formals)
         `(multiple-value-call
              (lambda ()
                ,@body)
            ,expr))
        ((atom formals)
         ;; This could also be written:
         #+(or) `(let ((,formals (multiple-value-list ,expr)))
                   ,@body)
         ;; But I want it to be possible to declare FORMALS to have
         ;; dynamic extent, and most Lisps support that for &rest
         ;; lists.
         `(multiple-value-call
              (lambda (&rest ,formals)
                ,@body)
            ,expr))
        ((proper-list-p formals)
         (when (intersection formals lambda-list-keywords)
           (error "Lambda list keywords in formals: ~a" formals))
         `(multiple-value-call
              (lambda ,formals
                ,@body)
            ,expr))
        (t (let* ((last (last formals))
                  (vars (append (butlast formals)
                                (list (car last))))
                  (rest (cdr last)))
             (when (intersection (cons rest vars) lambda-list-keywords)
               (error "Lambda list keywords in formals: ~a" formals))
             `(multiple-value-call
                  (lambda (,@vars &rest ,rest)
                    ,@body)
                ,expr)))))

(multiple-value-call (lambda (k v) (setf (gethash k hash-table) v)) (apply fn args))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-element-maker :clip-path "clipPath" '(:id))

Issue: Macro call that should be transformed by define-element-maker

Input: (define-element-maker :clip-path "clipPath" '(:id))

Output:
(defmacro define-element-maker (element name required-attributes)
  `(progn
     (defmethod assert-required-attributes ((element (eql ,element)) attributes)
       (declare (ignore element))
       (unless (evenp (length attributes))
         (warn "attribute list may be missing data: ~A" attributes))
       (let ((missing (set-difference ,required-attributes attributes)))
	 (when missing
	   (error 'missing-attributes :message (format nil "~A missing attributes: ~{~A~^ ~}" ,element missing)))))
     (defmethod make-svg-element ((element (eql ,element)) attributes)
       (when *check-required-attributes*
         (assert-required-attributes element attributes))
       (make-instance 'svg-element :name ,name :attributes attributes))))

(progn (defmethod assert-required-attributes ((element (eql :clip-path)) attributes) (declare (ignore element)) (unless (evenp (length attributes)) (warn "attribute list may be missing data: ~A" attributes)) (let ((missing (set-difference (quote (:id)) attributes))) (when missing (error (quote missing-attributes) :message (format nil "~A missing attributes: ~{~A~^ ~}" :clip-path missing))))) (defmethod make-svg-element ((element (eql :clip-path)) attributes) (when *check-required-attributes* (assert-required-attributes element attributes)) (make-instance (quote svg-element) :name "clipPath" :attributes attributes)))


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

Issue: Macro call that should be transformed by LAMBDA*

Input:
(lambda* nil
  nil)

Output: (defmacro LAMBDA* ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(match* (pattern qualifiers) (('* _) t) ((nil nil) t) (((type symbol) (type symbol)) (eql pattern qualifiers)) (((list* pfirst prest) (list* qualifier qualifiers)) (and (matches? qualifier pfirst) (matches? qualifiers prest))))

Issue: Macro call that should be transformed by match*

Input: (match* (pattern qualifiers) (('* _) t) ((nil nil) t) (((type symbol) (type symbol)) (eql pattern qualifiers)) (((list* pfirst prest) (list* qualifier qualifiers)) (and (matches? qualifier pfirst) (matches? qualifiers prest))))

Output:
(defmacro match* ((&rest things) &body clauses)
  `(multiple-value-match (values ,@things)
     ,@clauses))

(multiple-value-match (values pattern qualifiers) (((quote *) _) t) ((nil nil) t) (((type symbol) (type symbol)) (eql pattern qualifiers)) (((list* pfirst prest) (list* qualifier qualifiers)) (and (matches? qualifier pfirst) (matches? qualifiers prest))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(*> +octothorp+ +skip-til-end+)

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

Input: (*> +octothorp+ +skip-til-end+)

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 (#:*>-offset224) (multiple-value-bind (#:*>-res225 #:*>-next226) (funcall +octothorp+ #:*>-offset224) (if (ok? #:*>-res225) (funcall +skip-til-end+ #:*>-next226) (fail #:*>-next226))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-custom-var (:beginning-of-string *beginning-of-string-handler*))

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

Input: (define-custom-var (:beginning-of-string *beginning-of-string-handler*))

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 (*beginning-of-string-handler* . :beginning-of-string)) *custom-vars* :test (function equal)) (defvar *beginning-of-string-handler*)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(sunless x (setf it :ok))

Issue: Macro call that should be transformed by sunless

Input: (sunless x (setf it :ok))

Output:
(defmacro sunless (test &body body)
  "Like UNLESS, except binds the test form to IT (via SYMBOL-MACROLET) for the
scope of the body. IT can be set with SETF."
  `(symbolic unless ,test ,@body))


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

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

Input: (with-space (call-next-method))

Output:
(defmacro with-space (&body body)
  (with-thunk (body)
    `(call-with-space ,body)))

(flet ((#:stack-fn-body1 nil (call-next-method))) (declare (dynamic-extent (function #:stack-fn-body1))) (symbol-macrolet ((#:stack-fn-body1 (function #:stack-fn-body1))) (call-with-space #:stack-fn-body1)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-active-layers nil)

Issue: Macro call that should be transformed by WITH-ACTIVE-LAYERS

Input: (with-active-layers nil)

Output: (defmacro WITH-ACTIVE-LAYERS ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(serially (atomically nil () (decf counter)))

Problem: Macro call that should be transformed by serially

Input: (serially (atomically nil () (decf counter)))

Output:
(defmacro serially (&body flow)
  "Executes child elements serially (but possibly in different threads)
returning a value of the last atomic block or flow. Non-consing."
  (with-flow-let-macro (flow-list flow)
    (flow-lambda-macro (flow-context)
      `(dispatch-serially ,flow-context ,flow-list))))

(let ((#:flow-list162 (list (atomically nil nil (decf counter))))) (%flow-lambda (#:flow-context163) (dispatch-serially #:flow-context163 #:flow-list162)))


Instruction:
Define a macro that eliminates this repetitive pattern:
;; Accessing pandoric variables requires verbose funcall
(let ((sum (funcall box :pandoric-get 'sum))
      (count (funcall box :pandoric-get 'count)))
  (format t "sum=~a count=~a~%" sum count))

;; Setting is even worse:
(progn
  (funcall box :pandoric-set 'sum new-value)
  new-value)

;; Want: regular variable syntax for pandoric access

Issue: Pandoric get/set requires verbose keyword funcalls — want transparent variable syntax using symbol-macrolet

Input:
;; Accessing pandoric variables requires verbose funcall
(let ((sum (funcall box :pandoric-get 'sum))
      (count (funcall box :pandoric-get 'count)))
  (format t "sum=~a count=~a~%" sum count))

;; Setting is even worse:
(progn
  (funcall box :pandoric-set 'sum new-value)
  new-value)

;; Want: regular variable syntax for pandoric access

Output:
(defun get-pandoric (box sym)
  (funcall box :pandoric-get sym))

(defsetf get-pandoric (box sym) (val)
  `(progn
     (funcall ,box :pandoric-set ,sym ,val)
     ,val))

(defmacro with-pandoric (syms box &rest body)
  (let ((g!box (gensym "box")))
    `(let ((,g!box ,box))
       (declare (ignorable ,g!box))
       (symbol-macrolet
         (,@(mapcar #`(,a1 (get-pandoric ,g!box ',a1))
                    syms))
         ,@body))))

;; (with-pandoric (sum count) #'counter
;;   (format t "sum=~a count=~a~%" sum count)
;;   (incf sum 10)
;;   (setf count 0))
;;
;; Expands to:
;; (SYMBOL-MACROLET
;;   ((SUM (GET-PANDORIC #:BOX123 'SUM))
;;    (COUNT (GET-PANDORIC #:BOX123 'COUNT)))
;;   (FORMAT T "sum=~a count=~a~%" SUM COUNT)
;;   (INCF SUM 10)
;;   (SETF COUNT 0))
;;
;; Reading SUM expands to (GET-PANDORIC ... 'SUM)
;; Writing SUM expands to setf -> get-pandoric setf expander


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-interpreter oid:+int2+ "int2" int 2)

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

Input: (define-interpreter oid:+int2+ "int2" int 2)

Output:
(defmacro define-interpreter (oid name fields &body value)
  "Shorthand for defining binary readers."
  (declare (ignore name)) ;; Names are there just for clarity
  `(set-sql-reader ,oid (binary-reader ,fields ,@value) :binary-p t))

(set-sql-reader cl-postgres-oid:+int2+ (binary-reader int 2) :binary-p t)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-column-type enum (&rest candidates) `(:enum ,@(mapcar #'(lambda (candidate) (if (symbolp candidate) (symbol-name-literally candidate) candidate)) candidates)))

What needs to change: Macro call that should be transformed by define-column-type

Input: (define-column-type enum (&rest candidates) `(:enum ,@(mapcar #'(lambda (candidate) (if (symbolp candidate) (symbol-name-literally candidate) candidate)) candidates)))

Output:
(defmacro define-column-type (type-symbol lambda-list &body body)
  (let ((type (gensym "TYPE"))
        (args (gensym "ARGS")))
    `(defmethod cltype-to-dbtype ((,type (eql ',type-symbol)) &rest ,args)
       (declare (ignore ,type))
       (destructuring-bind ,lambda-list ,args
         ,@body))))

(defmethod cltype-to-dbtype ((#:type228 (eql (quote enum))) &rest #:args229) (declare (ignore #:type228)) (destructuring-bind (&rest candidates) #:args229 (sb-int:quasiquote (:enum #S(sb-impl::comma :expr (mapcar (function (lambda (candidate) (if (symbolp candidate) (symbol-name-literally candidate) candidate))) candidates) :kind 2)))))


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

Problem: Macro call that should be transformed by -<>>

Input: (-<>> nil :key nil)

Output: (defmacro -<>> ...)


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

Problem: Macro call that should be transformed by DEFGENERIC*

Input:
(defgeneric* nil
    (progn))

Output: (defmacro DEFGENERIC* ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-decoder-simple-clos-semantics (setf x (decode-json-from-string "{\"x\":1}")) (is (equal (symbol-package (first-bound-slot-name x)) (find-package :json-test))))

What needs to change: Macro call that should be transformed by with-decoder-simple-clos-semantics

Input: (with-decoder-simple-clos-semantics (setf x (decode-json-from-string "{\"x\":1}")) (is (equal (symbol-package (first-bound-slot-name x)) (find-package :json-test))))

Output:
(defmacro with-decoder-simple-clos-semantics (&body body)
  "Execute BODY in a dynamic environement where the decoder semantics
is such as set by SET-DECODER-SIMPLE-CLOS-SEMANTICS."
  `(with-shadowed-custom-vars
     (set-decoder-simple-clos-semantics)
     ,@body))

(with-shadowed-custom-vars (set-decoder-simple-clos-semantics) (setf x (decode-json-from-string "{\"x\":1}")) (is (equal (symbol-package (first-bound-slot-name x)) (find-package :json-test))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defvariant 'some-name)

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

Input: (defvariant 'some-name)

Output: (defmacro DEFVARIANT ...)

(progn
 (defstruct (quote (:constructor nil) some-name))
 (defmacro match-quote (expr &body match-cases)
   #A((36) base-char . "Match values of variant type: QUOTE.")
   (let ((expr-var (gensym "-val")))
     `(let ((,expr-var ,expr))
        ,(build-dispatch `,'quote `,'nil match-cases expr-var)))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(assoc-cdr "state" parameters #'equal)

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

Input: (assoc-cdr "state" parameters #'equal)

Output:
(defmacro assoc-cdr (key alist &optional (test '#'eql))
  `(cdr (assoc ,key ,alist :test ,test)))

(cdr (assoc "state" parameters :test (function equal)))


Instruction:
Generate a defmacro form that transforms code like this:
(check-cursor-attached cluffer:item-before-cursor (cursor))

Pattern to recognize: Macro call that should be transformed by check-cursor-attached

Input: (check-cursor-attached cluffer:item-before-cursor (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:item-before-cursor :before ((cursor cluffer:cursor)) (declare (ignore)) (unless (cluffer:cursor-attached-p cursor) (error (quote cluffer:cursor-detached))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(*> (char #\e) (alt (char #\M) (char #\m)))

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

Input: (*> (char #\e) (alt (char #\M) (char #\m)))

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 (#:*>-offset169) (multiple-value-bind (#:*>-res170 #:*>-next171) (funcall (char #\LATIN_SMALL_LETTER_E) #:*>-offset169) (if (ok? #:*>-res170) (funcall (alt (char #\LATIN_CAPITAL_LETTER_M) (char #\LATIN_SMALL_LETTER_M)) #:*>-next171) (fail #:*>-next171))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(binary-reader ((days int 4)) (funcall f days))

Problem: Macro call that should be transformed by binary-reader

Input: (binary-reader ((days int 4)) (funcall f days))

Output:
(defmacro binary-reader (fields &body value)
  "A slightly convoluted macro for defining interpreter functions. It
allows two forms. The first is to pass a single type identifier, in
which case a value of this type will be read and returned directly.
The second is to pass a list of lists containing names and types, and
then a body. In this case the names will be bound to values read from
the socket and interpreted as the given types, and then the body will
be run in the resulting environment. If the last field is of type
bytes, string, or uint2s, all remaining data will be read and
interpreted as an array of the given type."
  (let ((stream-name (gensym))
        (size-name (gensym))
        (length-used 0))
    (flet ((read-type (type &optional modifier)
             (ecase type
               (bytes `(read-bytes ,stream-name (- ,size-name ,length-used)))
               (string `(enc-read-string ,stream-name
                                         :byte-length (- ,size-name ,length-used)))
               (uint2s `(let* ((size (/ (- ,size-name ,length-used) 2))
                               (result
                                 (make-array size
                                             :element-type '(unsigned-byte 16)
                                             :initial-element 0)))
                          (dotimes (i size)
                            (setf (elt result i) (read-uint2 ,stream-name)))
                          result))
               (int (assert (integerp modifier))
                (incf length-used modifier)
                `(,(integer-reader-name modifier t) ,stream-name))
               (uint (assert (integerp modifier))
                (incf length-used modifier)
                `(,(integer-reader-name modifier nil) ,stream-name)))))
      `(lambda (,stream-name ,size-name)
         (declare (type stream ,stream-name)
                  (type integer ,size-name)
                  (ignorable ,size-name))
         ,(if (consp fields)
              (progn
                `(let ,(loop :for field :in fields
                            :collect `(,(first field)
                                       ,(apply #'read-type (cdr field))))
                  ,@value))
              (read-type fields (car value)))))))

(lambda (#:g206 #:g207) (declare (type stream #:g206) (type integer #:g207) (ignorable #:g207)) (let ((days (read-int4 #:g206))) (funcall f days)))


Instruction:
Generate a defmacro form that transforms code like this:
(builder (lambda (app) (lambda (env) (funcall app env))) *app*)

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

Input: (builder (lambda (app) (lambda (env) (funcall app env))) *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 (let ((#:res165 (lambda (app) (lambda (env) (funcall app env))))) (typecase #:res165 (keyword (find-middleware #:res165)) (cons (if (keywordp (car #:res165)) (let ((#:res-mw164 (find-middleware (car #:res165)))) (lambda (#:app163) (apply #:res-mw164 #:app163 (cdr #:res165)))) #:res165)) (standard-object (lambda (#:app163) (funcall (intern (string :wrap) :clack.middleware) #:res165 #:app163))) (otherwise #:res165))))) :initial-value (to-app *app*) :from-end t)


Instruction:
Generate a defmacro form that transforms code like this:
(defvar-compile-time *ordered-lambda-list-keywords* '(&optional &rest &key &allow-other-keys &aux) "The allowed lambda list keywords in order.")

Pattern to recognize: Macro call that should be transformed by defvar-compile-time

Input: (defvar-compile-time *ordered-lambda-list-keywords* '(&optional &rest &key &allow-other-keys &aux) "The allowed lambda list keywords in order.")

Output:
(defmacro defvar-compile-time (name &optional initial-value documentation)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (defvar ,name ,initial-value ,documentation)))

(eval-when (:compile-toplevel :load-toplevel :execute) (defvar *ordered-lambda-list-keywords* (quote (&optional &rest &key &allow-other-keys &aux)) "The allowed lambda list keywords in order."))


Instruction:
Define a macro that eliminates this repetitive pattern:
(is (<= less more))

Issue: Macro call that should be transformed by is

Input: (is (<= less more))

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 ((#:e128 less) (#:a129 more)) (if (progn (<= #:e128 #:a129)) (add-result (quote test-passed) :test-expr (quote (<= less more))) (process-failure (quote (<= less more)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote more) #:a129 (quote <=) #:e128)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(macroexpand-convention (form) (if (consp form) (expand-documentation-using-head (first form) docstring form) form))

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

Input: (macroexpand-convention (form) (if (consp form) (expand-documentation-using-head (first form) docstring form) form))

Output:
(defmacro macroexpand-convention ((original-form) &body body)
  "Executes BODY as like `progn' and return the result as the first
value.  As the second value, returns a boolean whether the result is
not same with ORIGINAL-FORM or not.
This macro is designed to follow the `macroexpand' convention."
  `(multiple-value-bind (result expanded-p)
       (progn ,@body)
     (values result
             (or expanded-p
                 (not (eq result ,original-form))))))

(multiple-value-bind (result expanded-p) (progn (if (consp form) (expand-documentation-using-head (first form) docstring form) form)) (values result (or expanded-p (not (eq result form)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(action (:after node-application) #'apply-specialization)

Problem: Macro call that should be transformed by action

Input: (action (:after node-application) #'apply-specialization)

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

(make-action (quote :after) (quote node-application) (function apply-specialization))


Instruction:
Generate a defmacro form that transforms code like this:
(is (< 0 -1))

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

Input: (is (< 0 -1))

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)))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(if-generator (x gen) nil (if fail-if-short (error 'insufficient-items "Insufficient items in generator") (return nil)))

Write a macro that addresses: Macro call that should be transformed by if-generator

Input: (if-generator (x gen) nil (if fail-if-short (error 'insufficient-items "Insufficient items in generator") (return nil)))

Output:
(defmacro if-generator ((var gen) true-clause &optional false-clause)
  "Pulls a single iteration out of gen. If a single var is specified, it places all the values from the iteration in a list under var. If var is a list, destructures values into the vars in the list. If the generator has stopped, evaluates false-clause, otherwise evaluates true-clause."
  `(,@(if (listp var)
	 `(multiple-value-bind ,var
	      (funcall ,gen))
	 `(let ((,var (multiple-value-list (funcall ,gen))))))
      (if (eq 'generator-stop
	      ,(if (listp var)
		   (car var)
		   `(car ,var)))
	  ,false-clause
	  ,true-clause)))

(let ((x (multiple-value-list (funcall gen)))) (if (eq (quote generator-stop) (car x)) (if fail-if-short (error (quote insufficient-items) "Insufficient items in generator") (return nil)) nil))


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

Problem: Macro call that should be transformed by M

Input:
(m nil
  :key
  nil)

Output: (defmacro M ...)

(lambda (&rest #:|macro-lambda-list123|)
  (destructuring-bind () #:|macro-lambda-list123| :key nil))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-table-name nil (yield (when-op-left op)))

Issue: Macro call that should be transformed by with-table-name

Input: (with-table-name nil (yield (when-op-left op)))

Output:
(defmacro with-table-name (table-name &body body)
  `(let ((*table-name-scope* ,table-name))
     ,@body))

(let ((*table-name-scope* nil)) (yield (when-op-left op)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(summing-to total)

Issue: Macro call that should be transformed by sum

Input: (summing-to total)

Output:
(defmacro sum (value &key (to (error "sum requires a target accumulator (:to key)")))
  "Syntactic sugar for collect, intended to be used when the accumulator computes a sum."
  `(collect ,value :into ,to))

(accumulating-to total :initially 0 :by (function +) :finally nil)


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

Problem: Macro call that should be transformed by IGNORE-ERRORS

Input: (ignore-errors nil (progn))

Output: (defmacro IGNORE-ERRORS ...)

(handler-case (progn nil (progn)) (error (condition) (values nil condition)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-path curvy (move-to 350 350))

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

Input: (with-path curvy (move-to 350 350))

Output:
(defmacro with-path (path &body cmds)
  (let ((s (gensym "stream"))
        (n (gensym)))
    `(flet ((assert-string (s)
              (error-unless-string s)))
       (with-output-to-string (,s ,path)
         ;; Do trivial breaking up of the path data - SVG does not have
         ;; to accept indefinitely long lines of data.
         (let ((,n 0))
           (dolist (inst (mapcar #'assert-string (list ,@cmds)) (format ,s "~&"))
             (format ,s "~@{~A~}" inst)
             (incf ,n)
             (when (= (mod ,n 10) 0)
               (format ,s "~&"))))))))

(flet ((assert-string (s) (error-unless-string s))) (with-output-to-string (#:|stream136| curvy) (let ((#:g137 0)) (dolist (inst (mapcar (function assert-string) (list (move-to 350 350))) (format #:|stream136| "~&")) (format #:|stream136| "~@{~A~}" inst) (incf #:g137) (when (= (mod #:g137 10) 0) (format #:|stream136| "~&"))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-global-var nil (progn))

Problem: Macro call that should be transformed by DEFINE-GLOBAL-VAR

Input: (define-global-var nil (progn))

Output: (defmacro DEFINE-GLOBAL-VAR ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-modf-method pathname-type 1 (new-val path) (make-pathname :type new-val :defaults path))

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

Input: (define-modf-method pathname-type 1 (new-val path) (make-pathname :type new-val :defaults path))

Output:
(defmacro define-modf-method (name nth-arg (new-val &rest args) &body body)
  "Define a new modf method.  It inverts NAME forms by modifying the NTH-ARG
term of the arguments of the place form in the MODF macro.  This method can
specialize on any of ARGS."
  ;; Side effect in a macro, I know.  How can you do this via EVAL-WHEN if I
  ;; want it to run even if not a toplevel macro?
  (setf (gethash name *modf-nth-arg*)
        nth-arg)
  `(progn
     (eval-when (:compile-toplevel :load-toplevel :execute)
       (setf (gethash ',name *modf-nth-arg*)
             ,nth-arg))
     (defmethod ,(intern (modf-name name) :modf) (,new-val ,@args)
       ,@body)))

(progn (eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote pathname-type) *modf-nth-arg*) 1)) (defmethod |BUILDER:COMMON-LISP:PATHNAME-TYPE| (new-val path) (make-pathname :type new-val :defaults path)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(is (= 2 (length *toplevel-suites*)))

Issue: Macro call that should be transformed by is

Input: (is (= 2 (length *toplevel-suites*)))

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 ((#:e280 2) (#:a281 (length *toplevel-suites*))) (if (progn (= #:e280 #:a281)) (add-result (quote test-passed) :test-expr (quote (= 2 (length *toplevel-suites*)))) (process-failure (quote (= 2 (length *toplevel-suites*))) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote (length *toplevel-suites*)) #:a281 (quote =) #:e280)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-mustache-character #\> (make-instance 'partial-tag :text arg-text))

Issue: Macro call that should be transformed by define-mustache-character

Input: (define-mustache-character #\> (make-instance 'partial-tag :text arg-text))

Output:
(defmacro define-mustache-character (char &body body)
  `(set-mustache-character
    ,char (lambda (raw-text arg-text escapep start end)
            (declare (ignorable raw-text arg-text escapep start end)
                     (type simple-string raw-text arg-text)
                     (boolean escapep)
                     (offset start end))
            ,@body)))

(set-mustache-character #\GREATER-THAN_SIGN (lambda (raw-text arg-text escapep start end) (declare (ignorable raw-text arg-text escapep start end) (type simple-string raw-text arg-text) (boolean escapep) (offset start end)) (make-instance (quote partial-tag) :text arg-text)))


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

Problem: Macro call that should be transformed by DECLARE-DEPRECATED-OPERATORS

Input: (declare-deprecated-operators 'some-name)

Output: (defmacro DECLARE-DEPRECATED-OPERATORS ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (define-compiler-macro 'some-name
      (&whole form &rest arguments)
    (declare (ignore arguments))
    (let ((where-from (or *compile-file-truename* *load-truename*)))
      (when *deprecation-warnings*
        (warn 'deprecation-warning :operator-name ''some-name :source-file
              where-from :source-form form))
      (when where-from
        (pushnew where-from (gethash ''some-name *deprecation-locations*) :test
                 #'equalp))
      form))
  (values))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-path-instruction-pair arc-to "A" (rx ry x-rotation large-arc-flag sweep-flag x y))

Issue: Macro call that should be transformed by define-path-instruction-pair

Input: (define-path-instruction-pair arc-to "A" (rx ry x-rotation large-arc-flag sweep-flag x y))

Output:
(defmacro define-path-instruction-pair (name instruction (&rest args))
  (let ((draw-relative (intern (concatenate 'string (string name) "-R"))))
    `(progn
       (defun ,name (,@args)
         (format-instruction ,instruction ,@args))
       (defun ,draw-relative (,@args)
         (format-instruction ,(string-downcase instruction) ,@args)))))

(progn (defun arc-to (rx ry x-rotation large-arc-flag sweep-flag x y) (format-instruction "A" rx ry x-rotation large-arc-flag sweep-flag x y)) (defun arc-to-r (rx ry x-rotation large-arc-flag sweep-flag x y) (format-instruction "a" rx ry x-rotation large-arc-flag sweep-flag x y)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(matrix-ctypecase 'some-name)

Write a macro that addresses: Macro call that should be transformed by MATRIX-CTYPECASE

Input: (matrix-ctypecase 'some-name)

Output: (defmacro MATRIX-CTYPECASE ...)

(let ((#:g248 quote))
  (ctypecase #:g248))


Instruction:
Generate a defmacro form that transforms code like this:
(draw scene (:rect :x (- (random 750) 25) :y (- (random 750) 25) :rx 4 :ry 4 :height (+ 5 (random 65)) :width (+ 5 (random 65))) :stroke "rgb(232, 229, 148)" :opacity (+ 0.3 (random 0.2)) :fill (one-of *groovy-test-colors*))

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

Input: (draw scene (:rect :x (- (random 750) 25) :y (- (random 750) 25) :rx 4 :ry 4 :height (+ 5 (random 65)) :width (+ 5 (random 65))) :stroke "rgb(232, 229, 148)" :opacity (+ 0.3 (random 0.2)) :fill (one-of *groovy-test-colors*))

Output:
(defmacro draw (scene (shape &rest params) &rest opts)
  (let ((element (gensym)))
    `(let ((,element (funcall #'make-svg-element ,shape (append (list ,@params) (list ,@opts)))))
       (add-element ,scene ,element)
       ,element)))

(let ((#:g147 (funcall (function make-svg-element) :rect (append (list :x (- (random 750) 25) :y (- (random 750) 25) :rx 4 :ry 4 :height (+ 5 (random 65)) :width (+ 5 (random 65))) (list :stroke "rgb(232, 229, 148)" :opacity (+ 0.3 (random 0.2)) :fill (one-of *groovy-test-colors*)))))) (add-element scene #:g147) #:g147)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-option-expander intern (package &rest symbols) (mapcar #'(lambda (s) (intern (string s) package)) symbols))

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

Input: (define-option-expander intern (package &rest symbols) (mapcar #'(lambda (s) (intern (string s) package)) symbols))

Output:
(defmacro define-option-expander (name (package &rest arguments) &body body)
  (let ((args (gensym "ARGS")))
    `(defmethod expand-option ((,(gensym "TYPE") (eql ,(intern (string name) "KEYWORD"))) ,package ,args)
       (destructuring-bind ,arguments ,args
         ,@body))))

(defmethod expand-option ((#:type136 (eql :intern)) package #:args135) (destructuring-bind (&rest symbols) #:args135 (mapcar (function (lambda (s) (intern (string s) package))) symbols)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-html-string (:div (:p "Hello") (:a "world")))

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

Input: (with-html-string (:div (:p "Hello") (:a "world")))

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 (:div (:p "Hello") (:a "world"))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(draw scene (:path :d "M 1000 750 L 2000 750 L 2500 1250") :fill "none" :stroke "black" :stroke-width 100 :marker-end (xlink-href marker))

Problem: Macro call that should be transformed by draw

Input: (draw scene (:path :d "M 1000 750 L 2000 750 L 2500 1250") :fill "none" :stroke "black" :stroke-width 100 :marker-end (xlink-href marker))

Output:
(defmacro draw (scene (shape &rest params) &rest opts)
  (let ((element (gensym)))
    `(let ((,element (funcall #'make-svg-element ,shape (append (list ,@params) (list ,@opts)))))
       (add-element ,scene ,element)
       ,element)))

(let ((#:g153 (funcall (function make-svg-element) :path (append (list :d "M 1000 750 L 2000 750 L 2500 1250") (list :fill "none" :stroke "black" :stroke-width 100 :marker-end (xlink-href marker)))))) (add-element scene #:g153) #:g153)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(assoc-cdr :message uinfo)

Problem: Macro call that should be transformed by assoc-cdr

Input: (assoc-cdr :message uinfo)

Output:
(defmacro assoc-cdr (key alist &optional (test '#'eql))
  `(cdr (assoc ,key ,alist :test ,test)))

(cdr (assoc :message uinfo :test (function eql)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-op (:similar-to infix-op))

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

Input: (define-op (:similar-to infix-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 (similar-to-op (:include infix-op (name "SIMILAR TO")) (:constructor make-similar-to-op (left right))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(rem-bops nil :key nil)

Issue: Macro call that should be transformed by REM-BOPS

Input: (rem-bops nil :key nil)

Output: (defmacro REM-BOPS ...)

(eval-when (:load-toplevel :compile-toplevel :execute)
  (progn (save-binfix) (mapc 'rmbop '(nil :key nil)) (assign-properties)))


Instruction:
Generate a defmacro form that transforms code like this:
(who-ps-html nil)

Pattern to recognize: Macro call that should be transformed by WHO-PS-HTML

Input: (who-ps-html nil)

Output: (defmacro WHO-PS-HTML ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defun-compile-time walk-full (map-function form) (unless (null (rest (last form))) (error "Improper FULL: ~S" form)) (unless (= (length form) 2) (error "FULL must have exactly one argument, a FORM: ~S" form)) (funcall map-function form 'full))

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

Input: (defun-compile-time walk-full (map-function form) (unless (null (rest (last form))) (error "Improper FULL: ~S" form)) (unless (= (length form) 2) (error "FULL must have exactly one argument, a FORM: ~S" form)) (funcall map-function form 'full))

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 walk-full (map-function form) (unless (null (rest (last form))) (error "Improper FULL: ~S" form)) (unless (= (length form) 2) (error "FULL must have exactly one argument, a FORM: ~S" form)) (funcall map-function form (quote full))) (eval-when (:compile-toplevel) (compile (quote walk-full))))


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

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

Input: (-<>> nil)

Output: (defmacro -<>> ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defclause-sequence in-string index-of-string :access-fn 'char :size-fn 'length :sequence-type 'string :element-type 'character :element-doc-string "Characters in a string" :index-doc-string "Indices of a string")

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

Input: (defclause-sequence in-string index-of-string :access-fn 'char :size-fn 'length :sequence-type 'string :element-type 'character :element-doc-string "Characters in a string" :index-doc-string "Indices of a string")

Output:
(defmacro defclause (clause-template &body body)
  (define-clause 'defun clause-template body nil))

(progn (defclause-driver (for var in-string seq &sequence) "Characters in a string" (return-sequence-code :element-var var :sequence seq :access-fn (quote char) :size-fn (quote length) :element-type (quote character) :sequence-type (quote string))) (defclause-driver (for var index-of-string seq &sequence) "Indices of a string" (cond (with-index (clause-error "WITH-INDEX should not be specified for this clause")) (t (setq with-index var) (return-sequence-code :sequence seq :size-fn (quote length) :sequence-type (quote string))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(match 1 (2 2))

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

Input: (match 1 (2 2))

Output:
(defmacro match (arg &body clauses)
  "Matches ARG with CLAUSES. CLAUSES is a list of the form of (PATTERN
. BODY) where PATTERN is a pattern specifier and BODY is an implicit
progn. If ARG matches some PATTERN, `match` then evaluates
the corresponding BODY and returns the evaluated value.  If no pattern matches,
then returns NIL.

Evaluating a form (FAIL) in the clause body causes the latest pattern
matching to fail. For example,

    (match 1
      (x (if (eql x 1)
             (fail)
             x))
      (_ 'ok))

returns OK, because the form (FAIL) in the first clause is
evaluated.

If BODY starts with the symbols WHEN or UNLESS, then the next form
will be used to introduce (FAIL). That is,

    (match list ((list x) when (oddp x) x))
    (match list ((list x) unless (evenp x) x))

will be translated to

    (match list ((list x) (if (oddp x) x (fail))))
    (match list ((list x) (if (evenp x) (fail) x)))

Examples:

    (match 1 (1 1))
    => 1
    (match 1 (2 2))
    => 2
    (match 1 (x x))
    => 1
    (match (list 1 2 3)
      (list x y z) (+ x y z))
    => 6"
  (compile-match-1 arg clauses nil))

(let ((#:var149 1)) (declare (ignorable #:var149)) (%or (%if (%equals #:var149 2) (%or 2 (fail)) (fail)) nil))


Instruction:
Generate a defmacro form that transforms code like this:
(is (< a (dummy-add a 1)))

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

Input: (is (< a (dummy-add a 1)))

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 ((#:e161 a) (#:a162 (dummy-add a 1))) (if (progn (< #:e161 #:a162)) (add-result (quote test-passed) :test-expr (quote (< a (dummy-add a 1)))) (process-failure (quote (< a (dummy-add a 1))) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote (dummy-add a 1)) #:a162 (quote <) #:e161)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(defsynonym else :else)

Problem: Macro call that should be transformed by defsynonym

Input: (defsynonym else :else)

Output:
(defmacro defsynonym (symbol synonym)
  "Set SYNONYM for a SYMBOL. "
  `(eval-always
     (setf (get ',symbol 'synonym) ',synonym)))

(eval-always (setf (get (quote else) (quote synonym)) (quote :else)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-reader-syntax (run-program)- (is (string= "hello world" (er "(with-output-to-string (*standard-output*) #!echo -n hello world )"))))

Problem: Macro call that should be transformed by with-reader-syntax

Input: (with-reader-syntax (run-program)- (is (string= "hello world" (er "(with-output-to-string (*standard-output*) #!echo -n hello world )"))))

Output:
(defmacro with-reader-syntax (reader-macro-identifiers &body body)
  "This macro is only made for use by read-and-eval functionality,
and rather directed towards tests than users. So, do not export."
  (let ((identifiers (loop :for identifier :in reader-macro-identifiers
                           :collect `(quote ,identifier))))
    `(let ((*array-function*         'make-t-array-from-initial-contents)
           (*hash-table-function*    'alexandria:plist-hash-table)
           (*get-val-function*       'get-val)
           (*get-val-array-function* 'cl:aref)
           (*set-function*           'cl:remove-duplicates)
           (*alists-are-lists*       nil)
           (*plists-are-lists*       nil)
           (*readtable*             (%enable-reader-syntax *readtable* ,@identifiers)))
       ,@body)))

(let ((*array-function* (quote make-t-array-from-initial-contents)) (*hash-table-function* (quote alexandria:plist-hash-table)) (*get-val-function* (quote get-val)) (*get-val-array-function* (quote aref)) (*set-function* (quote remove-duplicates)) (*alists-are-lists* nil) (*plists-are-lists* nil) (*readtable* (%enable-reader-syntax *readtable* (quote run-program)))) - (is (string= "hello world" (er "(with-output-to-string (*standard-output*) #!echo -n hello world )"))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(prepend (default-driver-code) body)

Problem: Macro call that should be transformed by prepend

Input: (prepend (default-driver-code) body)

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

(setf body (nconc (default-driver-code) body))


Instruction:
Generate a defmacro form that transforms code like this:
(define-op (:< infix-op))

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

Input: (define-op (:< infix-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 infix-op (name "<")) (:constructor make-<-op (left right))))


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

Issue: Macro call that should be transformed by UNLESS

Input: (unless 'some-name)

Output: (defmacro UNLESS ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(*> (char #\a) (char #\b))

Issue: Macro call that should be transformed by *>

Input: (*> (char #\a) (char #\b))

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 (#:*>-offset189) (multiple-value-bind (#:*>-res190 #:*>-next191) (funcall (char #\LATIN_SMALL_LETTER_A) #:*>-offset189) (if (ok? #:*>-res190) (funcall (char #\LATIN_SMALL_LETTER_B) #:*>-next191) (fail #:*>-next191))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-yield-binds (format nil (if *inside-function-op* "(~A ~{~A~^ ~})" "~A ~{~A~^ ~}") (sql-statement-name statement) (mapcar #'yield (sql-composed-statement-children statement))))

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

Input: (with-yield-binds (format nil (if *inside-function-op* "(~A ~{~A~^ ~})" "~A ~{~A~^ ~}") (sql-statement-name statement) (mapcar #'yield (sql-composed-statement-children statement))))

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 (if *inside-function-op* "(~A ~{~A~^ ~})" "~A ~{~A~^ ~}") (sql-statement-name statement) (mapcar (function yield) (sql-composed-statement-children statement)))) (loop for bind in (reverse *bind-values*) append bind)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(rem-plist-val! nil (progn))

Problem: Macro call that should be transformed by REM-PLIST-VAL!

Input: (rem-plist-val! nil (progn))

Output:
(defmacro rem-plist-val! (id place &key (test '(default-test)) (key '(default-key)))
  `(setf ,place
    (rem-plist-val ,id ,place :test ,test :key ,key)))

(setf (progn)
        (rem-plist-val nil (progn) :test (default-test) :key (default-key)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-error merge-env-func-scope-mismatch () (env-a env-b) "Attempting to merge two environments with different function scopes ~s~%~s~%~s" (cons (v-function-scope env-a) (v-function-scope env-b)) env-a env-b)

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

Input: (define-error merge-env-func-scope-mismatch () (env-a env-b) "Attempting to merge two environments with different function scopes ~s~%~s~%~s" (cons (v-function-scope env-a) (v-function-scope env-b)) env-a env-b)

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 merge-env-func-scope-mismatch (:error-type varjo-error :prefix "Varjo") (env-a env-b) "Attempting to merge two environments with different function scopes ~s~%~s~%~s" (cons (v-function-scope env-a) (v-function-scope env-b)) env-a env-b)


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

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

Input: (any-of nil)

Output: (defmacro ANY-OF ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(insert-char-class-tester (regex (schar *string* curr-pos)) (greedy-constant-length-closure (char-class-test)))

Problem: Macro call that should be transformed by insert-char-class-tester

Input: (insert-char-class-tester (regex (schar *string* curr-pos)) (greedy-constant-length-closure (char-class-test)))

Output:
(defmacro insert-char-class-tester ((char-class chr-expr) &body body)
  "Utility macro to replace each occurence of '\(CHAR-CLASS-TEST)
within BODY with the correct test (corresponding to CHAR-CLASS)
against CHR-EXPR."
  (with-rebinding (char-class)
    (with-unique-names (test-function)
      (flet ((substitute-char-class-tester (new)
               (subst new '(char-class-test) body
                      :test #'equalp)))
        `(let ((,test-function (test-function ,char-class)))
           ,@(substitute-char-class-tester
              `(funcall ,test-function ,chr-expr)))))))

(let ((#:char-class157 regex)) (let ((#:test-function158 (test-function #:char-class157))) (greedy-constant-length-closure (funcall #:test-function158 (schar *string* curr-pos)))))