Instruction:
Define a macro that eliminates this repetitive pattern:
(defstore example (&key (a (init-a)) (b a)))

Issue: Macro call that should be transformed by defstore

Input: (defstore example (&key (a (init-a)) (b a)))

Output:
(defmacro defstore (store-name store-lambda-list &body body &environment env)
  (let* ((store-class-name (second (find :store-class body :key #'first)))
         (store-class (etypecase store-class-name
                        (null (find-class 'standard-store))
                        (symbol (find-class store-class-name))))
         (form (apply #'defstore-using-class store-class store-name store-lambda-list
                      :environment env
                      (mapcan #'(lambda (item)
                                  (cond ((eql (first item) :store-class)
                                         `(:store-class ',store-class-name))
                                        ((and (member (first item) '(:documentation :specialization-class)))
                                         (if (= 2 (length item))
                                             item
                                             (error "Invalid store definition option: ~W." item)))
                                        (t
                                         (list (first item) (rest item)))))
                              body))))
    `(eval-when (:compile-toplevel :load-toplevel :execute)
       ,form)))

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (defun a-init-function152 nil (declare (ignorable)) (init-a)) (defun b-init-function154 (a #:a?156) (declare (ignorable a #:a?156)) a) (ensure-store (quote example) (quote (&key (a (the t (a-init-function152)) #:a?156) (b (the t (b-init-function154 a #:a?156)) #:b?157))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-screamer-package :screamer-user)

Problem: Macro call that should be transformed by define-screamer-package

Input: (define-screamer-package :screamer-user)

Output:
(defmacro define-screamer-package (defined-package-name &body options)
  "Convenience wrapper around DEFPACKAGE. Passes its argument directly
to DEFPACKAGE, and automatically injects two additional options:

    \(:shadowing-import-from :screamer :defun :multiple-value-bind :y-or-n-p)
    \(:use :cl :screamer)"
  `(defpackage ,defined-package-name
     ,@options
     (:shadowing-import-from :screamer :defun :multiple-value-bind :y-or-n-p)
     (:use :cl :screamer)))

(defpackage :screamer-user (:shadowing-import-from :screamer :defun :multiple-value-bind :y-or-n-p) (:use :cl :screamer))


Instruction:
Define a macro that eliminates this repetitive pattern:
(with-decoder-simple-clos-semantics (is (equal-objects-p (json:make-object '((hello . "hej") (hi . "tjena")) nil) (decode-json-from-string input))) (is-false (#-cmu identity #+cmu symbol-package (class-name (class-of (decode-json-from-string input))))) (is (equal-objects-p (decode-json-from-string "{ }") (json:make-object nil nil))))

Issue: Macro call that should be transformed by with-decoder-simple-clos-semantics

Input: (with-decoder-simple-clos-semantics (is (equal-objects-p (json:make-object '((hello . "hej") (hi . "tjena")) nil) (decode-json-from-string input))) (is-false (#-cmu identity #+cmu symbol-package (class-name (class-of (decode-json-from-string input))))) (is (equal-objects-p (decode-json-from-string "{ }") (json:make-object nil nil))))

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) (is (equal-objects-p (make-object (quote ((hello . "hej") (hi . "tjena"))) nil) (decode-json-from-string input))) (is-false (identity (class-name (class-of (decode-json-from-string input))))) (is (equal-objects-p (decode-json-from-string "{ }") (make-object nil nil))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-op (:a< infix-op :sql-op-name "@<"))

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

Input: (define-op (:a< infix-op :sql-op-name "@<"))

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 (a<-op (:include infix-op (name "@<")) (:constructor make-a<-op (left right))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defclause-driver (for var next next) "General driver; VAR is set to value of NEXT" (return-driver-code :variable var :next (list (do-dsetq var (walk-expr next)))))

Issue: Macro call that should be transformed by defclause

Input: (defclause-driver (for var next next) "General driver; VAR is set to value of NEXT" (return-driver-code :variable var :next (list (do-dsetq var (walk-expr next)))))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-for-next-8 (&key ((:for var)) ((:next next)) generate) "General driver; VAR is set to value of NEXT" (return-driver-code :variable var :next (list (do-dsetq var (walk-expr next))))) (install-clause-info (quote (for :next)) (quote (for :next)) (quote clause-for-next-8) "General driver; VAR is set to value of NEXT" t) (quote (for var next next)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-error invalid-v-defun-template () (func-name template) "Template passed to v-def-glsl-template-fun must be a format string: ~a~%~a~%" func-name template)

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

Input: (define-error invalid-v-defun-template () (func-name template) "Template passed to v-def-glsl-template-fun must be a format string: ~a~%~a~%" func-name template)

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 invalid-v-defun-template (:error-type varjo-error :prefix "Varjo") (func-name template) "Template passed to v-def-glsl-template-fun must be a format string: ~a~%~a~%" func-name template)


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

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

Input: (-> :g (a) (put a))

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


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-destructured-lambda-form nil
    nil)

What needs to change: Macro call that should be transformed by WITH-DESTRUCTURED-LAMBDA-FORM

Input:
(with-destructured-lambda-form nil
    nil)

Output: (defmacro WITH-DESTRUCTURED-LAMBDA-FORM ...)

(destructuring-bind
    (#:function121 #:name122 #:qualifiers123 #:lambda-list124 #:docstring125
     #:declarations126 #:forms127)
    (split-lambda-form nil)
  (declare
   (ignore #:function121 #:name122 #:qualifiers123 #:lambda-list124
    #:docstring125 #:declarations126 #:forms127)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(static-method-function-test-hook)

What needs to change: Macro call that should be transformed by static-method-function-test-hook

Input: (static-method-function-test-hook)

Output:
(defmacro static-method-function-test-hook ()
  "A form of this macro is inserted in method functions, in order to
   allow test code to be inserted."

  nil)


Instruction:
Generate a defmacro form that transforms code like this:
(define-error none-type-in-out-vars () (glsl-name) "One of the values being returned from the shader (~s) is of type :none." glsl-name)

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

Input: (define-error none-type-in-out-vars () (glsl-name) "One of the values being returned from the shader (~s) is of type :none." glsl-name)

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

(defcondition none-type-in-out-vars (:error-type varjo-error :prefix "Varjo") (glsl-name) "One of the values being returned from the shader (~s) is of type :none." glsl-name)


Instruction:
Define a macro that eliminates this repetitive pattern:
(defclause minimizing (form &key (test ''<) saving in) "Same as optimizing but with < as the default test." `(optimizing ,form :test ,test :saving ,saving :in ,in))

Issue: Macro call that should be transformed by defclause

Input: (defclause minimizing (form &key (test ''<) saving in) "Same as optimizing but with < as the default test." `(optimizing ,form :test ,test :saving ,saving :in ,in))

Output:
(defmacro defclause (name arglist &body body)
  "Same as cl:defmacro, but additionally records <name> in *clauses* as a known clause macro."
  `(progn
     (defmacro ,name ,arglist ,@body)
     (pushnew ',name *clauses*)))

(progn (defmacro minimizing (form &key (test (quote (quote <))) saving in) "Same as optimizing but with < as the default test." (sb-int:quasiquote (optimizing #S(sb-impl::comma :expr form :kind 0) :test #S(sb-impl::comma :expr test :kind 0) :saving #S(sb-impl::comma :expr saving :kind 0) :in #S(sb-impl::comma :expr in :kind 0)))) (pushnew (quote minimizing) *clauses*))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-method pathname-name 1 (new-val path) (make-pathname :name new-val :defaults path))

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

Input: (define-modf-method pathname-name 1 (new-val path) (make-pathname :name 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-name) *modf-nth-arg*) 1)) (defmethod |BUILDER:COMMON-LISP:PATHNAME-NAME| (new-val path) (make-pathname :name new-val :defaults path)))


Instruction:
Generate a defmacro form that transforms code like this:
(-> nil (value) (setf result value) (mt:open-latch latch))

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

Input: (-> nil (value) (setf result value) (mt:open-latch latch))

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

(atomically nil (value) (setf result value) (cl-muth:open-latch latch))


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

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

Input: (with-rules nil)

Output: (defmacro WITH-RULES ...)

(dolist (nil (alexandria:hash-table-keys cl-rules.core::*rules*)))


Instruction:
Generate a defmacro form that transforms code like this:
(with-unique-names (this-s) (let ((current-s (get s-indicator current-s-indicator))) (setf (get s-indicator current-s-indicator) this-s) `(symbol-macrolet ((,this-s (internal-symbol-macrolet ((it ,current-s)) ,test)) (it ,this-s)) (,operation it ,@other-args))))

Pattern to recognize: Macro call that should be transformed by with-unique-names

Input: (with-unique-names (this-s) (let ((current-s (get s-indicator current-s-indicator))) (setf (get s-indicator current-s-indicator) this-s) `(symbol-macrolet ((,this-s (internal-symbol-macrolet ((it ,current-s)) ,test)) (it ,this-s)) (,operation it ,@other-args))))

Output:
(defmacro with-unique-names ((&rest bindings) &body body)
  `(let ,(mapcar #'(lambda (binding)
		     (destructuring-bind (var prefix)
			 (if (consp binding) binding (list binding binding))
		       `(,var (gensym ,(string prefix)))))
		 bindings)
     ,@body))

(let ((this-s (gensym #A((7) base-char . "THIS-S-")))) (let ((current-s (get s-indicator current-s-indicator))) (setf (get s-indicator current-s-indicator) this-s) (quasiquote (symbol-macrolet ((#S(sb-impl::comma :expr this-s :kind 0) (internal-symbol-macrolet ((it #S(sb-impl::comma :expr current-s :kind 0))) #S(sb-impl::comma :expr test :kind 0))) (it #S(sb-impl::comma :expr this-s :kind 0))) (#S(sb-impl::comma :expr operation :kind 0) it #S(sb-impl::comma :expr other-args :kind 2))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(bind ((obj (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5)) ((:accessors a c e) obj)) (setf a :a c :c) (list (e obj) (c obj) (a obj)))

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

Input: (bind ((obj (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5)) ((:accessors a c e) obj)) (setf a :a c :c) (list (e obj) (c obj) (a obj)))

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

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

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

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

(let* ((obj (make-instance (quote metabang-bind-class-2) :a 1 :b 2 :c 3 :d 4 :e 5)) (#:|values-176| obj)) (declare (ignorable #:|values-176|)) (with-accessors ((a a) (c c) (e e)) #:|values-176| (progn (setf a :a c :c) (list (e obj) (c obj) (a obj)))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-simple-definition-resolver structure designator-structure-p)

Pattern to recognize: Macro call that should be transformed by define-simple-definition-resolver

Input: (define-simple-definition-resolver structure designator-structure-p)

Output:
(defmacro define-simple-definition-resolver (class lookup-function &body body)
  (let ((package (gensym "PACKAGE")))
    `(define-definition-resolver ,class (,class ,package)
       (when (ignore-errors ,(if body
                                 `(let ((,(first lookup-function) ,class))
                                    ,@body)
                                 `(,lookup-function ,class)))
         (list (make-instance ',class :designator ,class :package ,package))))))

(define-definition-resolver structure (structure #:package139) (when (ignore-errors (designator-structure-p structure)) (list (make-instance (quote structure) :designator structure :package #:package139))))


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

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

Input: (->* nil (progn))

Output: (defmacro ->* ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-condition/a dbi-operational-error (dbi-database-error) () (:documentation "Exception for errors related to the database's operation which are not necessarily under the control of the programmer. This includes such things as unexpected disconnect, datasource name not found, transaction could not be processed, a memory allocation error occured during processing, etc."))

What needs to change: Macro call that should be transformed by define-condition/a

Input: (define-condition/a dbi-operational-error (dbi-database-error) () (:documentation "Exception for errors related to the database's operation which are not necessarily under the control of the programmer. This includes such things as unexpected disconnect, datasource name not found, transaction could not be processed, a memory allocation error occured during processing, etc."))

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

(progn (define-condition dbi-operational-error (dbi-database-error) nil (:documentation "Exception for errors related to the database's operation which are not necessarily under the control of the programmer. This includes such things as unexpected disconnect, datasource name not found, transaction could not be processed, a memory allocation error occured during processing, etc.")) (deftype <dbi-operational-error> nil (quote dbi-operational-error)) (setf (find-class (quote <dbi-operational-error>)) (find-class (quote dbi-operational-error))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(answer foo 1 2 3)

Problem: Macro call that should be transformed by answer

Input: (answer foo 1 2 3)

Output:
(defmacro answer (call &body forms)
  (let ((name (if (listp call) (car call) call))
        (sym (gensym)))
    `(if-called
      ',name
      (let ((,sym (fdefinition ',name)))
        (declare (ignorable ,sym))
        (let ((times 0))
          (lambda (&rest args)
            (declare (ignorable args))
            ,(let ((cases
                     `(case (prog1 times (incf times))
                        ,.(loop
                            for i from 0
                            for (form . rest) on forms
                            collect `(,(if rest i T) ,form)))))
               (if (listp call)
                   `(trivia:match args
                     ((list . ,(cdr call)) ,cases)
                     (_ (unhandled)))
                   cases))))))))

(if-called (quote foo) (let ((#:g163 (fdefinition (quote foo)))) (declare (ignorable #:g163)) (let ((times 0)) (lambda (&rest args) (declare (ignorable args)) (case (prog1 times (incf times)) (0 1) (1 2) (t 3))))))


Instruction:
Generate a defmacro form that transforms code like this:
(defjs reduce5(k vals) (let ((sum 0)) (dolist (c vals) (incf sum c)) (return sum)))

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

Input: (defjs reduce5(k vals) (let ((sum 0)) (dolist (c vals) (incf sum c)) (return sum)))

Output:
(defmacro defjs (name args &body body)
  "Define client side javascript. Works like defun; body is in lisp, with parenscript
   additions, like return. So (defjs hello (x y) (return (+ x y))) defines an adder.
   macro creates a lisp function which sends the javascript function over to the mongo
   server to be evaluated. Result is processed and returned to the reader.
   This will execute 10 times on the server :
   (mapcar (lambda (x) (hello 10 x)) (list 1 2 3 4 5 6 7 8 9 10))"
  `(let* ((js-body (parenscript:ps (lambda ,args ,@body))))
     (setf (gethash ',name *js-definitions*) js-body)
     (defun ,name ,args
       (get-element "retval" (car (docs (db.eval js-body ,@args)))))))

(let* ((js-body (parenscript:ps (lambda (k vals) (let ((sum 0)) (dolist (c vals) (incf sum c)) (return sum)))))) (setf (gethash (quote reduce5) *js-definitions*) js-body) (defun reduce5 (k vals) (get-element "retval" (car (docs (db.eval js-body k vals))))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-column-type serial () :integer)

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

Input: (define-column-type serial () :integer)

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 ((#:type224 (eql (quote serial))) &rest #:args225) (declare (ignore #:type224)) (destructuring-bind nil #:args225 :integer))


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

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

Input: (with* nil)

Output: (defmacro WITH* ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(signal-syntax-error "Empty character class.")

What needs to change: Macro call that should be transformed by signal-syntax-error

Input: (signal-syntax-error "Empty character class.")

Output:
(defmacro signal-syntax-error (format-control &rest format-arguments)
  `(signal-syntax-error* nil ,format-control ,@format-arguments))

(signal-syntax-error* nil "Empty character class.")


Instruction:
Write a Common Lisp macro to handle this code pattern:
(enable-readtime-wrapper-syntax nil nil)

Problem: Macro call that should be transformed by ENABLE-READTIME-WRAPPER-SYNTAX

Input: (enable-readtime-wrapper-syntax nil nil)

Output: (defmacro ENABLE-READTIME-WRAPPER-SYNTAX ...)

(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-readtime-wrapper-syntax-in-readtable nil nil)
  (values))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(define-error emit-type-mismatch () (sets) "Some of the emit statements emit different types:~{~%~a~}" (mapcar (lambda (x) (map 'list #'type->type-spec x)) sets))

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

Input: (define-error emit-type-mismatch () (sets) "Some of the emit statements emit different types:~{~%~a~}" (mapcar (lambda (x) (map 'list #'type->type-spec x)) sets))

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 emit-type-mismatch (:error-type varjo-error :prefix "Varjo") (sets) "Some of the emit statements emit different types:~{~%~a~}" (mapcar (lambda (x) (map (quote list) (function type->type-spec) x)) sets))


Instruction:
Define a macro that eliminates this repetitive pattern:
(printing-unreadably (id name) (class/std employee name id salary))

Issue: Macro call that should be transformed by printing-unreadably

Input: (printing-unreadably (id name) (class/std employee name id salary))

Output:
(defmacro printing-unreadably (fields-list class-std-form
                               &key (type t) (identity t))
  "Automatically generates the unreadable printing boiler plate to print classes and its fields (from FIELDS-LIST)."
  (let ((g!stream (gensym "STREAM"))
        (name (cadr class-std-form)))
    `(progn ,class-std-form
            (defmethod print-object ((,name ,name) ,g!stream)
              (print-unreadable-object (,name ,g!stream
                                        :type ,type
                                        :identity ,identity)
                (format ,g!stream
                        ,(format nil "~{~a: ~~s~^,~^ ~}" fields-list)
                        ,@(mapcar (lambda (a1)
                                    `(,a1 ,name))
                                  fields-list)))))))

(progn (class/std employee name id salary) (defmethod print-object ((employee employee) #:stream125) (print-unreadable-object (employee #:stream125 :type t :identity t) (format #:stream125 #A((16) base-char . "ID: ~s, NAME: ~s") (id employee) (name employee)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(deferror "0A" feature-not-supported)

Issue: Macro call that should be transformed by deferror

Input: (deferror "0A" feature-not-supported)

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

(progn (define-condition feature-not-supported (database-error) nil) (setf (gethash "0A" *error-table*) (quote feature-not-supported)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(do-generators ((g (some-numbers)) (:list l data :fill-value 0)) (yield (+ l g)))

Problem: Macro call that should be transformed by do-generator

Input: (do-generators ((g (some-numbers)) (:list l data :fill-value 0)) (yield (+ l g)))

Output:
(defmacro do-generator ((var &rest vars-and-generator) &body body)
  "Steps through the specified generator, binding the value it returns to var, then executing the body for each step. If multiple variables are specified and the generator returns multiple values, the extra values will be bound to the extra variables."
  (let ((g (gensym)))
    `(let ((,g ,(car (last vars-and-generator))))
       (loop
	  do (if-generator ((,var ,@(butlast vars-and-generator)) ,g)
			   (progn
			     ,@body)
			   (return))))))

(let ((#:g175 (multi-gen (some-numbers) (list (list->generator data) :fill-value 0)))) (loop do (destructuring-bind (#:g177 . #:g176) (multiple-value-list (next-generator-value #:g175)) (unless #:g177 (return)) (let ((g (elt (elt #:g176 0) 0)) (l (elt (elt #:g176 1) 0))) (yield (+ l g))))))


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

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

Input:
(defun-advisable nil
    (progn))

Output: (defmacro DEFUN-ADVISABLE ...)

(let ((#:oldfn135
       (handler-case (symbol-function 'nil) (undefined-function nil nil))))
  (defun nil (progn))
  (make-advisable 'nil :arguments '(progn))
  (when
      (and #:oldfn135
           (not (eql (advisable-function-arguments #:oldfn135) :not-provided))
           (equal (advisable-function-arguments #:oldfn135) '(progn)))
    (copy-advice #:oldfn135 (symbol-function 'nil))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(lret (x y) (declare (ignore x)) 1)

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

Input: (lret (x y) (declare (ignore x)) 1)

Output:
(defmacro lret ((&rest bindings) &body body)
  "Return the initial value of the last binding in BINDINGS. The idea
is to create something, initialize it, and then return it.

    (lret ((x 1)
           (y (make-array 1)))
      (setf (aref y 0) x))
    => #(1)

Note that the value returned is the value initially bound. Subsequent
assignments are ignored.

    (lret ((x 1))
      (setf x 2))
    => 1

Furthermore, on Lisps that support it, the variable may be made
read-only, making assignment a compiler-time error.

`lret' may seem trivial, but it fufills the highest purpose a macro
can: it eliminates a whole class of bugs (initializing an object, but
forgetting to return it).

Cf. `aprog1' in Anaphora."
  `(lret-aux let ,bindings
     ,@body))

(lret-aux let (x y) (declare (ignore x)) 1)


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-alias-binding count counting)

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

Input: (define-alias-binding count counting)

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

(progn (setf (binding (quote count)) (quote counting)) (quote count))


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

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

Input:
(all-of nil
  :key
  nil)

Output: (defmacro ALL-OF ...)


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

Write a macro that addresses: Macro call that should be transformed by WITH-STANDARD-DEFINER-OPTIONS

Input: (with-standard-definer-options nil)

Output: (defmacro WITH-STANDARD-DEFINER-OPTIONS ...)

`(progn
  ,@(when (getf -options- :export)
      `((eval-when (:compile-toplevel :load-toplevel :execute)
          (export ',nil)))))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defcategory :debug (or :debug :info))

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

Input: (defcategory :debug (or :debug :info))

Output:
(defmacro defcategory (category &optional expands-as set)
  `(defcategory-fn ',category ',expands-as ,set))

(defcategory-fn (quote :debug) (quote (or :debug :info)) nil)


Instruction:
Generate a defmacro form that transforms code like this:
(with-temp (input-file :tmpdir d :template "XXXXXX.prolog" :debug (<= 1 *debug-prolog*)) (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (run-command-with-debug-print `(,*xsb* "--nobanner" "--quietload" "--noprompt" "-e" ,(format nil "consult('~a')." input-file) ,@args) :input input :output output :error error))

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

Input: (with-temp (input-file :tmpdir d :template "XXXXXX.prolog" :debug (<= 1 *debug-prolog*)) (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (run-command-with-debug-print `(,*xsb* "--nobanner" "--quietload" "--noprompt" "-e" ,(format nil "consult('~a')." input-file) ,@args) :input input :output output :error error))

Output:
(defmacro with-temp ((var &key directory template (tmpdir "/tmp/") debug) &body body)
  "Create a temporary file, then remove the file by unwind-protect.
Most arguments are analogous to mktemp.
When DIRECTORY is non-nil, creates a directory instead.
DEBUG is a form.
When evaluated to non-nil, it does not remove the directory so that you can investigate what happened inside the directory.
It may be evaluated multiple times."
  (with-gensyms (command)
    `(let ((,var (uiop:run-program
                  (let ((,command (format nil "mktemp --tmpdir='~a' ~@[-d~*~] ~@[~a~]"
                                          ,tmpdir ,directory ,template)))
                    (when ,debug
                      (format *error-output* "~&; ~a~%" ,command))
                    ,command)
                  :output '(:string :stripped t))))
       (unwind-protect
            (progn ,@body)
         (if ,debug
             (format *error-output* "~&; not removing ~a for debugging~%" ,var)
             (uiop:run-program (format nil "rm -rf ~a" (namestring ,var)) :ignore-error-status t))))))

(let ((input-file (uiop/run-program:run-program (let ((#:command178 (format nil "mktemp --tmpdir='~a' ~@[-d~*~] ~@[~a~]" d nil "XXXXXX.prolog"))) (when (<= 1 *debug-prolog*) (format *error-output* "~&; ~a~%" #:command178)) #:command178) :output (quote (:string :stripped t))))) (unwind-protect (progn (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (run-command-with-debug-print (sb-int:quasiquote (#S(sb-impl::comma :expr *xsb* :kind 0) "--nobanner" "--quietload" "--noprompt" "-e" #S(sb-impl::comma :expr (format nil "consult('~a')." input-file) :kind 0) #S(sb-impl::comma :expr args :kind 2))) :input input :output output :error error)) (if (<= 1 *debug-prolog*) (format *error-output* "~&; not removing ~a for debugging~%" input-file) (uiop/run-program:run-program (format nil "rm -rf ~a" (namestring input-file)) :ignore-error-status t))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(matrix-ccase nil)

Issue: Macro call that should be transformed by MATRIX-CCASE

Input: (matrix-ccase nil)

Output: (defmacro MATRIX-CCASE ...)


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

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

Input:
(ps
  'some-name)

Output: (defmacro PS ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(deferror "57" operator-intervention)

Issue: Macro call that should be transformed by deferror

Input: (deferror "57" operator-intervention)

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

(progn (define-condition operator-intervention (database-error) nil) (setf (gethash "57" *error-table*) (quote operator-intervention)))


Instruction:
Generate a defmacro form that transforms code like this:
(defhandler lambda (lambda lambda-list &rest body) (apply 'dump-fbinding lambda lambda-list body))

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

Input: (defhandler lambda (lambda lambda-list &rest body) (apply 'dump-fbinding lambda lambda-list body))

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-lambda (lambda lambda-list &rest body) (apply (quote dump-fbinding) lambda lambda-list body)) (setf (gethash (quote lambda) *form-handler*) (quote hander-lambda)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(dynamic-wind)

Write a macro that addresses: Macro call that should be transformed by DYNAMIC-WIND

Input: (dynamic-wind)

Output: (defmacro DYNAMIC-WIND ...)

(flet ((#:dynamic-wind-thunk213 (#:proceed-thunk214)
         (macrolet ((proceed (&body #:proceed-body215)
                     `(if ,'#:proceed-thunk214
                          (funcall (the function ,'#:proceed-thunk214))
                          (progn ,@#:proceed-body215)))))))
  (declare (inline #:dynamic-wind-thunk213))
  (let ((*dynamic-wind-stack*
         (cons #'#:dynamic-wind-thunk213 *dynamic-wind-stack*)))
    (#:dynamic-wind-thunk213 nil)))


Instruction:
Define a macro that eliminates this repetitive pattern:
(fgather-next nil nil)

Issue: Macro call that should be transformed by FGATHER-NEXT

Input: (fgather-next nil nil)

Output: (defmacro FGATHER-NEXT ...)


Instruction:
Generate a defmacro form that transforms code like this:
(xor tmp true)

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

Input: (xor tmp true)

Output:
(defmacro xor (&rest datums)
  "Evaluates its arguments one at a time, from left to right. If more than one
argument evaluates to a true value no further DATUMS are evaluated, and NIL is
returned as both primary and secondary value. If exactly one argument
evaluates to true, its value is returned as the primary value after all the
arguments have been evaluated, and T is returned as the secondary value. If no
arguments evaluate to true NIL is returned as primary, and T as secondary
value."
  (with-gensyms (xor tmp true)
    `(let (,tmp ,true)
       (declare (ignorable ,tmp))
       (block ,xor
         ,@(mapcar (lambda (datum)
                     `(if (setf ,tmp ,datum)
                          (if ,true
                              (return-from ,xor (values nil nil))
                              (setf ,true ,tmp))))
                   datums)
         (return-from ,xor (values ,true t))))))

(let (#:tmp138 #:true139) (declare (ignorable #:tmp138)) (block #:xor137 (if (setf #:tmp138 tmp) (if #:true139 (return-from #:xor137 (values nil nil)) (setf #:true139 #:tmp138))) (if (setf #:tmp138 true) (if #:true139 (return-from #:xor137 (values nil nil)) (setf #:true139 #:tmp138))) (return-from #:xor137 (values #:true139 t))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defclause stop-when (condition) "Synonym for until." `(until ,condition))

Issue: Macro call that should be transformed by defclause

Input: (defclause stop-when (condition) "Synonym for until." `(until ,condition))

Output:
(defmacro defclause (name arglist &body body)
  "Same as cl:defmacro, but additionally records <name> in *clauses* as a known clause macro."
  `(progn
     (defmacro ,name ,arglist ,@body)
     (pushnew ',name *clauses*)))

(progn (defmacro stop-when (condition) "Synonym for until." (sb-int:quasiquote (until #S(sb-impl::comma :expr condition :kind 0)))) (pushnew (quote stop-when) *clauses*))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defclause (finding expr minimizing min-expr &optional into variable) "Return value which minimizes expression" (return-find-extremum-code expr min-expr variable :min))

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

Input: (defclause (finding expr minimizing min-expr &optional into variable) "Return value which minimizes expression" (return-find-extremum-code expr min-expr variable :min))

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

(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-finding-minimizing-17 (&key ((:finding expr)) ((:minimizing min-expr)) ((:into variable))) "Return value which minimizes expression" (return-find-extremum-code expr min-expr variable :min)) (install-clause-info (quote (finding :minimizing)) (quote (finding :minimizing &optional :into)) (quote clause-finding-minimizing-17) "Return value which minimizes expression" nil) (quote (finding expr minimizing min-expr &optional into variable)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(defun/1 frexp (x nptr) (let ((n (ceiling (log (abs x) 2)))) (setf (deref* nptr) n) (/ x (expt 2 n))))

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

Input: (defun/1 frexp (x nptr) (let ((n (ceiling (log (abs x) 2)))) (setf (deref* nptr) n) (/ x (expt 2 n))))

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

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

(progn (defun frexp (x nptr) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (let ((n (ceiling (log (abs x) 2)))) (setf (deref* nptr) n) (/ x (expt 2 n)))) (defparameter frexp (vacietis.c:mkptr& (symbol-function (quote frexp)))))


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

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

Input: (newq nil)

Output: (defmacro NEWQ ...)


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

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

Input: (do* () (progn))

Output: (defmacro DO* ...)

(block nil
  (let* ()
    (declare (ignorable))
    (tagbody
      (go #:g189)
     #:g188
      (tagbody)
      (setq)
     #:g189
      (unless progn (go #:g188))
      (return-from nil (progn)))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(with-active-layers* 'some-name)

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

Input: (with-active-layers* 'some-name)

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

(dynamic-wind
  :proceed
  #:proceed212
  (%with-active-layers 'some-name
    (#:proceed212)))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(lret* ((y 1) (y 2)) (declare (ignorable y)) 3)

Problem: Macro call that should be transformed by lret*

Input: (lret* ((y 1) (y 2)) (declare (ignorable y)) 3)

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

(lret-aux let* ((y 1) (y 2)) (declare (ignorable y)) 3)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-custom-var (:aggregate-scope *aggregate-scope-variables*) nil "A list of symbols naming dynamic variables which should be re-bound in the scope of every JSON aggregate value (Object, Array or String).")

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

Input: (define-custom-var (:aggregate-scope *aggregate-scope-variables*) nil "A list of symbols naming dynamic variables which should be re-bound in the scope of every JSON aggregate value (Object, Array or String).")

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 (*aggregate-scope-variables* . :aggregate-scope)) *custom-vars* :test (function equal)) (defvar *aggregate-scope-variables* nil "A list of symbols naming dynamic variables which should be re-bound in the scope of every JSON aggregate value (Object, Array or String).")))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(with-env [clos-object 'a])

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

Input: (with-env [clos-object 'a])

Output:
(defmacro with-env (&body body)
  (let ((body-value (gensym)))
    `(let (,body-value)
       (defclass foo () ((a :initform 3)))
       (defmethod get-val ((object foo) &rest slot/s) (slot-value object (car slot/s)))
       (defmethod (setf get-val) (new-value (object foo) &rest slot/s)
         (setf (slot-value object (car slot/s)) new-value))
       (defstruct bar a)
       (setq ,body-value
             (let ((str (alexandria:copy-array "abcde"))
                   (vec (alexandria:copy-array #(a b c d e)))
                   (arr (alexandria:copy-array #2A((1 2 3)
                                                   (4 5 6))))
                   (list      (copy-list '(a b c d e)))
                   (ht        (eval (read-from-string "{'a 'b 'c 'd}")))
                   (ht-eq     (eval (read-from-string "{eq \"a\" 1
                                                    \"b\" 2}")))
                   (ht-equalp (eval (read-from-string "{equalp '(1 2 3) \"a\"
                                                               '(4 5 6) \"b\"}")))
                   (assoc-list (copy-tree '((a . 1) (b . 2))))
                   (plist      (copy-list '(:a 4 :c 5)))
                   (clos-object (make-instance 'foo))
                   (struct      (make-bar :a 3)))
               (declare (ignorable str vec arr list ht ht-eq ht-equalp
                                   assoc-list plist clos-object struct))
               ,@body))
       (setf (find-class 'foo nil) nil)
       (setf (find-class 'bar nil) nil)
       ,body-value))

(let (#:g131) (defclass foo nil ((a :initform 3))) (defmethod get-val ((object foo) &rest slot/s) (slot-value object (car slot/s))) (defmethod (setf get-val) (new-value (object foo) &rest slot/s) (setf (slot-value object (car slot/s)) new-value)) (defstruct bar a) (setq #:g131 (let ((str (alexandria:copy-array "abcde")) (vec (alexandria:copy-array #(a b c d e))) (arr (alexandria:copy-array #2A((1 2 3) (4 5 6)))) (list (copy-list (quote (a b c d e)))) (ht (eval (read-from-string "{'a 'b 'c 'd}"))) (ht-eq (eval (read-from-string "{eq \"a\" 1
                                                    \"b\" 2}"))) (ht-equalp (eval (read-from-string "{equalp '(1 2 3) \"a\"
                                                               '(4 5 6) \"b\"}"))) (assoc-list (copy-tree (quote ((a . 1) (b . 2))))) (plist (copy-list (quote (:a 4 :c 5)))) (clos-object (make-instance (quote foo))) (struct (make-bar :a 3))) (declare (ignorable str vec arr list ht ht-eq ht-equalp assoc-list plist clos-object struct)) [clos-object (quote a]))) (setf (find-class (quote foo) nil) nil) (setf (find-class (quote bar) nil) nil) #:g131)


Instruction:
Define a macro that eliminates this repetitive pattern:
(do+ (returning 1) (returning 2 3) (returning (values 4 5) 6) (returning 7) (terminate))

Issue: Macro call that should be transformed by do+

Input: (do+ (returning 1) (returning 2 3) (returning (values 4 5) 6) (returning 7) (terminate))

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

(do+/internal nil (returning 1) (returning 2 3) (returning (values 4 5) 6) (returning 7) (terminate))


Instruction:
Generate a defmacro form that transforms code like this:
(when (eql (info-size) 0) (format stream ";"))

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

Input: (when (eql (info-size) 0) (format stream ";"))

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

(if (eql (info-size) 0) (format stream ";"))


Instruction:
Define a macro that eliminates this repetitive pattern:
(sccase (car x) (:y (setf it :no)) (:x (setf it :yes)))

Issue: Macro call that should be transformed by sccase

Input: (sccase (car x) (:y (setf it :no)) (:x (setf it :yes)))

Output:
(defmacro sccase (keyform &body cases)
  "Like CCASE, except binds the keyform to IT (via SYMBOL-MACROLET) for the
scope of the cases. IT can be set with SETF."
  `(symbolic ccase ,keyform ,@cases))

(symbolic ccase (car x) (:y (setf it :no)) (:x (setf it :yes)))


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

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

Output: (defmacro -<> ...)


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

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

Input:
(max-of nil
  (progn))

Output: (defmacro MAX-OF ...)


Instruction:
Generate a defmacro form that transforms code like this:
(js)

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

Input: (js)

Output: (defmacro JS ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(defvar-compile-time *screamer?* nil "This must be NIL except when defining internal Screamer functions.")

Write a macro that addresses: Macro call that should be transformed by defvar-compile-time

Input: (defvar-compile-time *screamer?* nil "This must be NIL except when defining internal Screamer functions.")

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 *screamer?* nil "This must be NIL except when defining internal Screamer functions."))


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

Problem: Macro call that should be transformed by THE-PART

Input: (the-part nil nil)

Output: (defmacro THE-PART ...)


Instruction:
Generate a defmacro form that transforms code like this:
(some->>)

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

Input: (some->>)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(fail "This is supposed to fail")

Problem: Macro call that should be transformed by fail

Input: (fail "This is supposed to fail")

Output:
(defmacro fail (&rest message-args)
  "Simply generate a FAIL."
  `(process-failure ',message-args
                    ,@message-args))

(process-failure (quote ("This is supposed to fail")) "This is supposed to fail")


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(define-templated-dispatch nil
    (progn))

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

Input:
(define-templated-dispatch nil
    (progn))

Output: (defmacro DEFINE-TEMPLATED-DISPATCH ...)


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

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

Input:
(unwind-protect nil
    (progn))

Output: (defmacro UNWIND-PROTECT ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(defhandler let* (let* bindings &rest body) (if (not bindings) (e `(locally ,@body)) (destructuring-bind (first &rest rest) bindings (e `(let (,first) ,@(if rest `((,let* ,rest ,@body)) body))))))

Issue: Macro call that should be transformed by defhandler

Input: (defhandler let* (let* bindings &rest body) (if (not bindings) (e `(locally ,@body)) (destructuring-bind (first &rest rest) bindings (e `(let (,first) ,@(if rest `((,let* ,rest ,@body)) body))))))

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-let* (let* bindings &rest body) (if (not bindings) (e (sb-int:quasiquote (locally #S(sb-impl::comma :expr body :kind 2)))) (destructuring-bind (first &rest rest) bindings (e (sb-int:quasiquote (let (#S(sb-impl::comma :expr first :kind 0)) #S(sb-impl::comma :expr (if rest (sb-int:quasiquote ((#S(sb-impl::comma :expr let* :kind 0) #S(sb-impl::comma :expr rest :kind 0) #S(sb-impl::comma :expr body :kind 2)))) body) :kind 2))))))) (setf (gethash (quote let*) *form-handler*) (quote hander-let*)))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(disable-curly-syntax)

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

Input: (disable-curly-syntax)

Output: (defmacro DISABLE-CURLY-SYNTAX ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (unless *original-readtable* (error "Curly syntax not enabled."))
  (setf *readtable* *original-readtable*
        *original-readtable* nil))


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

Problem: Macro call that should be transformed by CT-LET

Input: (ct-let nil)

Output: (defmacro CT-LET ...)

(cond
 (*within-captured-dynenv*
  (let ()
    (let ((#:new-var-space146
           (reduce
            (lambda (#:accum147 #:item148)
              (destructuring-bind
                  (#:name149 . #:value150)
                  #:item148
                (update-alist #:name149 #:value150 #:accum147)))
            (list) :initial-value *var-space*)))
      `(symbol-macrolet ((var-space ,#:new-var-space146))
         ,(let ((*var-space* #:new-var-space146)))))))
 (t
  (error
   "No macrodynamic environment has been captured to establish CT-LET bindings.")))


Instruction:
Generate a defmacro form that transforms code like this:
(def-iter iterator-nfold-product (iterable-length product-length item-vec indices stopped) (nfold-product (n iterable) "Computes the n-fold Cartesian product of an iterable with itself. Essentially equivalent to `(apply #'product (iter-to-list (tee n iterable))`, but with much better memory usage ``` (nfold-product 3 '(1 2)) ;; #(1 1 1), #(1 1 2), #(1 2 1), #(1 2 2), #(2 1 1), #(2 1 2), #(2 2 1), #(2 2 2) ``` " (let* ((item-vec (iter-to-vec iterable)) (iterable-length (length item-vec))) (if (zerop iterable-length) (empty-iterator) (init-state iterable-length item-vec (product-length n) (indices (make-array n :initial-element 0)))))) (if stopped (values nil nil) (multiple-value-prog1 (loop with product = (make-array product-length) for i below product-length for ii = (aref indices i) do (setf (aref product i) (aref item-vec ii)) finally (return (values product t))) (labels ((next-combo (i) (if (< i 0) (setf stopped t) (progn (incf (aref indices i)) (when (>= (aref indices i) iterable-length) (setf (aref indices i) 0) (next-combo (1- i))))))) (next-combo (1- product-length))))))

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

Input: (def-iter iterator-nfold-product (iterable-length product-length item-vec indices stopped) (nfold-product (n iterable) "Computes the n-fold Cartesian product of an iterable with itself. Essentially equivalent to `(apply #'product (iter-to-list (tee n iterable))`, but with much better memory usage ``` (nfold-product 3 '(1 2)) ;; #(1 1 1), #(1 1 2), #(1 2 1), #(1 2 2), #(2 1 1), #(2 1 2), #(2 2 1), #(2 2 2) ``` " (let* ((item-vec (iter-to-vec iterable)) (iterable-length (length item-vec))) (if (zerop iterable-length) (empty-iterator) (init-state iterable-length item-vec (product-length n) (indices (make-array n :initial-element 0)))))) (if stopped (values nil nil) (multiple-value-prog1 (loop with product = (make-array product-length) for i below product-length for ii = (aref indices i) do (setf (aref product i) (aref item-vec ii)) finally (return (values product t))) (labels ((next-combo (i) (if (< i 0) (setf stopped t) (progn (incf (aref indices i)) (when (>= (aref indices i) iterable-length) (setf (aref indices i) 0) (next-combo (1- i))))))) (next-combo (1- product-length))))))

Output:
(defmacro def-iter (name state-vars (constructor-name constructor-params &body constructor-body)
                    &body next-body)
  "An anaphoric convenience macro which can be re-implemented to change how iterators are
  structured. Exposes the local `init-state` macro within `constructor-body`

  If you don't want to-use this macro (which I totally understand) just write constructors for your
  iterators returning 0-argument closures representing the `next` function and you'll be fine. This
  macro just helped me get through a lot of waffling during development

  Parameters
  ----------
  `name` is a synbol naming the iterator's backing state. However it's actually
  ignored, since PICL doesn't currently expose iterators' backing state

  `state-vars` is a list of symbols naming the iterator's state variables.

  The `constructor-name/params/body` will be `defun`'d to create the user-facing constructor
  function. In `constructor-body`, the return value should be an iterator or a call to local
  `init-state` macro

  `next-body` The definition of the `next` function for this iterator, which will be run in a
   lexical environment consisting of the state vars

  Both `constructor-body` and `next-body` are defined in the lexical environment of the `def-iter`
  form, and as such can access any lexical bindings not shadowed by the `constructor-params` and
  `state-vars` respectively

  The local `init-state` macro.
  ----------------------------
  The arguments to `init-state` should be of the form `(statevar-symbol value-form)`or
  `statevar-symbol`. In the first case, the value of `value-form` will be used to initialize the
  state variable named by `symbol`. In the second case, `statevar-symbol` is also used as the
  corresponding `value-form`

  Example
  -------
  What follows is a sample implementation of the `count` iterator using this macro
  ```
  (def-iter ignored-backing-name (curr-val step)
    (count (start step)
      (init-state (curr-val start) step))
    (prog1 curr-val (incf curr-val step))))
  ````"

  (declare (ignore name))
  (alexandria:with-gensyms (next-fname)
    (let ((docstring "Function had no docstring, so this one was inserted"))
      (when (and (cdr constructor-body) (stringp (car constructor-body)))
        (setf docstring (car constructor-body)
              constructor-body (cdr constructor-body)))
      `(labels ((,next-fname (&key ,@state-vars)
                  (labels ((self () ,@next-body)) #'self)))
         (defun ,constructor-name ,constructor-params
           ,docstring
           (macrolet
               ((init-state (&rest argspecs)
                  (list 'apply '#',next-fname
                        (apply #'append
                               '(list )
                               (mapcar (lambda (aspec)
                                         (if (symbolp aspec)
                                             (list (alx:make-keyword aspec) aspec)
                                             (destructuring-bind (aname adef) aspec
                                               (list (alx:make-keyword aname) adef))))
                                       argspecs)))))
             ,@constructor-body))))))

(labels ((#:next-fname126 (&key iterable-length product-length item-vec indices stopped) (labels ((self nil (if stopped (values nil nil) (multiple-value-prog1 (loop with product = (make-array product-length) for i below product-length for ii = (aref indices i) do (setf (aref product i) (aref item-vec ii)) finally (return (values product t))) (labels ((next-combo (i) (if (< i 0) (setf stopped t) (progn (incf (aref indices i)) (when (>= (aref indices i) iterable-length) (setf (aref indices i) 0) (next-combo (1- i))))))) (next-combo (1- product-length))))))) (function self)))) (defun nfold-product (n iterable) "Computes the n-fold Cartesian product of an iterable with itself. Essentially equivalent to `(apply #'product (iter-to-list (tee n iterable))`, but with much better memory usage ``` (nfold-product 3 '(1 2)) ;; #(1 1 1), #(1 1 2), #(1 2 1), #(1 2 2), #(2 1 1), #(2 1 2), #(2 2 1), #(2 2 2) ``` " (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname126)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (let* ((item-vec (iter-to-vec iterable)) (iterable-length (length item-vec))) (if (zerop iterable-length) (empty-iterator) (init-state iterable-length item-vec (product-length n) (indices (make-array n :initial-element 0))))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(define-screamer-package :screamer-tests (:use :cl :hu.dwim.stefil) (:export #:test-screamer #:screamer-tests))

Problem: Macro call that should be transformed by define-screamer-package

Input: (define-screamer-package :screamer-tests (:use :cl :hu.dwim.stefil) (:export #:test-screamer #:screamer-tests))

Output:
(defmacro define-screamer-package (defined-package-name &body options)
  "Convenience wrapper around DEFPACKAGE. Passes its argument directly
to DEFPACKAGE, and automatically injects two additional options:

    \(:shadowing-import-from :screamer :defun :multiple-value-bind :y-or-n-p)
    \(:use :cl :screamer)"
  `(defpackage ,defined-package-name
     ,@options
     (:shadowing-import-from :screamer :defun :multiple-value-bind :y-or-n-p)
     (:use :cl :screamer)))

(defpackage :screamer-tests (:use :cl :hu.dwim.stefil) (:export #:test-screamer #:screamer-tests) (:shadowing-import-from :screamer :defun :multiple-value-bind :y-or-n-p) (:use :cl :screamer))


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

Write a macro that addresses: Macro call that should be transformed by DESTRUCTURING-MATCH

Input: (destructuring-match nil)

Output: (defmacro DESTRUCTURING-MATCH ...)

(let ((#:form nil))
  (block #:done
    (let ((#:done
           (lambda (&rest values)
             (declare (dynamic-extent values))
             (return-from #:done (values-list values)))))
      (tagbody))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(do-matches-as-strings (match regex target-string (nreverse result-list) :start start :end end :sharedp sharedp) (push match result-list))

Problem: Macro call that should be transformed by do-matches

Input: (do-matches-as-strings (match regex target-string (nreverse result-list) :start start :end end :sharedp sharedp) (push match result-list))

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

(let ((#:target-string141 target-string)) (let ((#:substr-fn144 (if sharedp (function nsubseq) (function subseq)))) (do-matches (#:match-start142 #:match-end143 regex #:target-string141 (nreverse result-list) :start start :end end) (let ((match (funcall #:substr-fn144 #:target-string141 #:match-start142 #:match-end143))) (push match result-list)))))


Instruction:
Generate a defmacro form that transforms code like this:
(c-assert (eql :nascent (md-state self)))

Pattern to recognize: Macro call that should be transformed by c-assert

Input: (c-assert (eql :nascent (md-state self)))

Output:
(defmacro c-assert (assertion &optional places fmt$ &rest fmt-args)
  (declare (ignorable assertion places fmt$ fmt-args))
   #+(or)`(progn)
  `(unless *stop*
     (unless ,assertion
       ,(if fmt$
            `(c-break ,fmt$ ,@fmt-args)
          `(c-break "failed assertion: ~a" ',assertion)))))

(unless *stop* (unless (eql :nascent (md-state self)) (c-break "failed assertion: ~a" (quote (eql :nascent (md-state self))))))


Instruction:
Write a Common Lisp macro to handle this code pattern:
(def-neo4j-fun get-paths (node-id to-node-id relationships (max-depth 3) (algorithm :shortest-path)) :post (:uri-spec (format nil "node/~A/paths" node-id)) (:encode (list (list (cons "to" to-node-id) :node-url) (list (cons "relationships" relationships)) (list (cons "max_depth" max-depth)) (list (cons "algorithm" (case algorithm (:shortest-path "shortestPath") (:all-paths "allPaths") (:all-simple-paths "allSimplePaths") (:dijkstra "dijkstra"))))) :object) (:status-handlers (200 (decode-neo4j-json-output body)) (204 (error 'path-not-found-error :uri uri))))

Problem: Macro call that should be transformed by def-neo4j-fun

Input: (def-neo4j-fun get-paths (node-id to-node-id relationships (max-depth 3) (algorithm :shortest-path)) :post (:uri-spec (format nil "node/~A/paths" node-id)) (:encode (list (list (cons "to" to-node-id) :node-url) (list (cons "relationships" relationships)) (list (cons "max_depth" max-depth)) (list (cons "algorithm" (case algorithm (:shortest-path "shortestPath") (:all-paths "allPaths") (:all-simple-paths "allSimplePaths") (:dijkstra "dijkstra"))))) :object) (:status-handlers (200 (decode-neo4j-json-output body)) (204 (error 'path-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-paths (&key node-id to-node-id relationships (max-depth 3) (algorithm :shortest-path)) (let ((uri (format nil "node/~A/paths" node-id)) (json (encode-neo4j-json-payload (list (list (cons "to" to-node-id) :node-url) (list (cons "relationships" relationships)) (list (cons "max_depth" max-depth)) (list (cons "algorithm" (case algorithm (:shortest-path "shortestPath") (:all-paths "allPaths") (:all-simple-paths "allSimplePaths") (:dijkstra "dijkstra"))))) :object))) (make-neo4j-request :post uri json (list (list 200 (lambda (body uri json) (decode-neo4j-json-output body))) (list 204 (lambda (body uri json) (error (quote path-not-found-error) :uri uri))))))))


Instruction:
Generate a defmacro form that transforms code like this:
(define-cfun c-calloc)

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

Input: (define-cfun c-calloc)

Output:
(defmacro define-cfun (name-or-function &optional (package *package*))
  (when-let ((fun (find-function name-or-function)))
    (with-wrap-attempt ("function ~S" name-or-function) name-or-function
      (with-slots (name type c-symbol fields) fun
        (let* ((fun-name (intern (symbol-name name) package))
               (param-names (mapcar #'foreign-type-name fields))
               (param-syms (mapcar (lambda (x) (gensym (symbol-name x))) param-names))
               (make-function-p (not (foreign-function-variadic-p fun)))
               (maybe-cbv-return
                 (when (cbv-return-p fun)
                   (list 'return-value))))
          (with-gensyms (!fun !fields rest)
            (let ((form
                    (if make-function-p
                        `(defun ,fun-name (,@maybe-cbv-return
                                           ,@param-names ,@(when (foreign-function-variadic-p fun) `(&rest ,rest)))
                           ,@(when maybe-cbv-return `((declare (ignorable ,@maybe-cbv-return))))
                           ,(let ((!fun (find-function name-or-function)))
                              (with-slots ((!fields fields)) !fun
                                (foreign-to-ffi
                                 (and (car !fields) (foreign-type (car !fields)))
                                 param-syms
                                 param-names
                                 !fields
                                 (make-foreign-funcall !fun (and maybe-cbv-return 'return-value)
                                                       param-syms (when (foreign-function-variadic-p fun) rest))))))
                        `(defmacro ,fun-name (,@maybe-cbv-return
                                              ,@param-names ,@(when (foreign-function-variadic-p fun) `(&rest ,rest)))
                           ,@(when maybe-cbv-return `((declare (ignorable ,@maybe-cbv-return))))
                           (let ((,!fun (find-function ',name-or-function)))
                             (with-slots ((,!fields fields)) ,!fun
                               (foreign-to-ffi
                                (and (car ,!fields) (foreign-type (car ,!fields)))
                                ',param-syms
                                (list ,@param-names)
                                ,!fields
                                (make-foreign-funcall ,!fun ,(and maybe-cbv-return 'return-value)
                                                      ',param-syms ,(when (foreign-function-variadic-p fun) rest)))))))))
              `(progn
                 ,@(when (foreign-function-cbv-p fun)
                     (list (funcall *build-libffi-definition* fun)))
                 ,form))))))))

(progn (defun c-calloc (nmemb size) (let ((#:nmemb204 nmemb)) (declare (ignorable #:nmemb204)) (let ((#:size205 size)) (declare (ignorable #:size205)) (cffi-sys:%foreign-funcall "calloc" (:unsigned-long-long #:nmemb204 :unsigned-long-long #:size205 :pointer) :convention :cdecl)))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(defstore nxpy (y x &optional (a 1) (b 1)))

Issue: Macro call that should be transformed by defstore

Input: (defstore nxpy (y x &optional (a 1) (b 1)))

Output:
(defmacro defstore (store-name store-lambda-list &body body &environment env)
  (let* ((store-class-name (second (find :store-class body :key #'first)))
         (store-class (etypecase store-class-name
                        (null (find-class 'standard-store))
                        (symbol (find-class store-class-name))))
         (form (apply #'defstore-using-class store-class store-name store-lambda-list
                      :environment env
                      (mapcan #'(lambda (item)
                                  (cond ((eql (first item) :store-class)
                                         `(:store-class ',store-class-name))
                                        ((and (member (first item) '(:documentation :specialization-class)))
                                         (if (= 2 (length item))
                                             item
                                             (error "Invalid store definition option: ~W." item)))
                                        (t
                                         (list (first item) (rest item)))))
                              body))))
    `(eval-when (:compile-toplevel :load-toplevel :execute)
       ,form)))

(eval-when (:compile-toplevel :load-toplevel :execute) (progn (ensure-store (quote nxpy) (quote (y x &optional (a 1 #:a?149) (b 1 #:b?150))))))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-modf-rewrite third (expr) `(caddr ,(second expr)))

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

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(when (not (slot-value parent 'tail-qualifiers)) (format stream " "))

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

Input: (when (not (slot-value parent 'tail-qualifiers)) (format stream " "))

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

(if (not (slot-value parent (quote tail-qualifiers))) (format stream " "))


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
;; Threading a value through multiple dependent checks
(let ((user (find-user id)))
  (if user
      (let ((orders (get-orders user)))
        (if orders
            (let ((latest (first orders)))
              (if latest
                  (process latest)
                  :no-orders))
            :no-orders))
      :no-user))
;; Deeply nested ifs obscure the linear flow

Write a macro that addresses: Threading a value through dependent operations creates deep if-nesting — want linear, pipeline-like syntax

Input:
;; Threading a value through multiple dependent checks
(let ((user (find-user id)))
  (if user
      (let ((orders (get-orders user)))
        (if orders
            (let ((latest (first orders)))
              (if latest
                  (process latest)
                  :no-orders))
            :no-orders))
      :no-user))
;; Deeply nested ifs obscure the linear flow

Output:
(defmacro aand (&rest args)
  (cond ((null args) t)
        ((null (cdr args)) (car args))
        (t `(aif ,(car args) (aand ,@(cdr args))))))

;; (aand (find-user id)
;;       (get-orders it)
;;       (first it)
;;       (process it))
;;
;; Each form's result is bound to 'it' for the next form.
;; If any form returns nil, the chain stops and returns nil.
;; Linear, readable, no nesting.


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(integer-reader 8)

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

Input: (integer-reader 8)

Output:
(defmacro integer-reader (bytes)
  "Create a function to read integers from a binary stream."
  (let ((bits (* bytes 8)))
    (labels ((return-form (signed)
               (if signed
                   `(if (logbitp ,(1- bits) result)
                        (dpb result (byte ,(1- bits) 0) -1)
                        result)
                   `result))
             (generate-reader (signed)
               `(defun ,(integer-reader-name bytes signed) (socket)
                  (declare (type stream socket)
                           #.*optimize*)
                  ,(if (= bytes 1)
                       `(let ((result (the (unsigned-byte 8) (read-byte socket))))
                          (declare (type (unsigned-byte 8) result))
                          ,(return-form signed))
                       `(let ((result 0))
                          (declare (type (unsigned-byte ,bits) result))
                          ,@(loop :for byte :from (1- bytes) :downto 0
                                  :collect `(setf (ldb (byte 8 ,(* 8 byte))
                                                       result)
                                                  (the (unsigned-byte 8)
                                                       (read-byte socket))))
                          ,(return-form signed))))))
      `(progn
         ;; This causes weird errors on SBCL in some circumstances. Disabled for now.
         ;;         (declaim (inline ,(integer-reader-name bytes t)
         ;;                          ,(integer-reader-name bytes nil)))
         (declaim (ftype (function (t) (signed-byte ,bits))
                         ,(integer-reader-name bytes t)))
         ,(generate-reader t)
         (declaim (ftype (function (t) (unsigned-byte ,bits))
                         ,(integer-reader-name bytes nil)))
         ,(generate-reader nil)))))

(progn (declaim (ftype (function (t) (signed-byte 64)) read-int8)) (defun read-int8 (socket) (declare (type stream socket) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (let ((result 0)) (declare (type (unsigned-byte 64) result)) (setf (ldb (byte 8 56) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 48) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 40) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 32) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 24) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 16) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 8) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 0) result) (the (unsigned-byte 8) (read-byte socket))) (if (logbitp 63 result) (dpb result (byte 63 0) -1) result))) (declaim (ftype (function (t) (unsigned-byte 64)) read-uint8)) (defun read-uint8 (socket) (declare (type stream socket) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (let ((result 0)) (declare (type (unsigned-byte 64) result)) (setf (ldb (byte 8 56) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 48) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 40) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 32) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 24) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 16) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 8) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 0) result) (the (unsigned-byte 8) (read-byte socket))) result)))


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:
You are a Common Lisp macro expert. Given this code pattern:
(defun+ nil
    nil)

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

Input:
(defun+ nil
    nil)

Output: (defmacro DEFUN+ ...)


Instruction:
Define a macro that eliminates this repetitive pattern:
(defun-compile-time cps-convert-function-name (function-name) (if (symbolp function-name) (intern (format nil "~A-NONDETERMINISTIC" (string function-name)) (symbol-package function-name)) `(setf ,(intern (format nil "~A-NONDETERMINISTIC" (string (second function-name))) (symbol-package (second function-name))))))

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

Input: (defun-compile-time cps-convert-function-name (function-name) (if (symbolp function-name) (intern (format nil "~A-NONDETERMINISTIC" (string function-name)) (symbol-package function-name)) `(setf ,(intern (format nil "~A-NONDETERMINISTIC" (string (second function-name))) (symbol-package (second function-name))))))

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 cps-convert-function-name (function-name) (if (symbolp function-name) (intern (format nil "~A-NONDETERMINISTIC" (string function-name)) (symbol-package function-name)) (sb-int:quasiquote (setf #S(sb-impl::comma :expr (intern (format nil "~A-NONDETERMINISTIC" (string (second function-name))) (symbol-package (second function-name))) :kind 0))))) (eval-when (:compile-toplevel) (compile (quote cps-convert-function-name))))


Instruction:
Generate a defmacro form that transforms code like this:
(let-syntax common-lisp:nil (common-lisp:progn))

Pattern to recognize: Macro call that should be transformed by LET-SYNTAX

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

Output: (defmacro LET-SYNTAX ...)


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(augment steppers step)

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

Input: (augment steppers step)

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list ,@body))

Problem: Macro call that should be transformed by destructure-specialized-lambda-list

Input: (destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list ,@body))

Output:
(defmacro destructure-specialized-lambda-list (descriptive-lambda-list-sym vanilla-lambda-list-sym type-list-sym specialized-lambda-list &body body)
  "if specialized-lambda-list is ((a integer) b):
descriptive-lambda-list will be ((x integer) (x t))
type-list will be (integer t) and vanilla-lambda-list is (a b)"
  (let ((item (gensym)))
    `(let* ((,descriptive-lambda-list-sym
             (loop :for ,item :in ,specialized-lambda-list
                :if (listp ,item)
                :collect ,item
                :else :collect (list ,item t)))
            (,vanilla-lambda-list-sym (mapcar #'first ,descriptive-lambda-list-sym))
            (,type-list-sym (mapcar #'second ,descriptive-lambda-list-sym)))
       (declare (ignorable ,descriptive-lambda-list-sym ,vanilla-lambda-list-sym ,type-list-sym))
       ,@body)))

(let* ((descriptive-lambda-list (loop :for #:g127 :in specialized-lambda-list :if (listp #:g127) :collect #:g127 :else :collect (list #:g127 t))) (vanilla-lambda-list (mapcar (function first) descriptive-lambda-list)) (type-list (mapcar (function second) descriptive-lambda-list))) (declare (ignorable descriptive-lambda-list vanilla-lambda-list type-list)) (sb-int:quasiquote (%lay-method-base-for-dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr type-list :kind 0) #S(sb-impl::comma :expr descriptive-lambda-list :kind 0) #S(sb-impl::comma :expr body :kind 2))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(disable-infix-reader)

What needs to change: Macro call that should be transformed by DISABLE-INFIX-READER

Input: (disable-infix-reader)

Output: (defmacro DISABLE-INFIX-READER ...)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (setq *readtable* (pop *readtables*)))


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

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

Input: (defsynonym for :for)

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

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


Instruction:
Define a macro that eliminates this repetitive pattern:
(signal-syntax-error* (1- (lexer-pos lexer)) "Character '~A' may not follow '(?<'." next-char )

Issue: Macro call that should be transformed by signal-syntax-error*

Input: (signal-syntax-error* (1- (lexer-pos lexer)) "Character '~A' may not follow '(?<'." next-char )

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

(error (quote ppcre-syntax-error) :pos (1- (lexer-pos lexer)) :format-control "Character '~A' may not follow '(?<'." :format-arguments (list next-char))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define BUFSIZ 512)

Issue: Macro call that should be transformed by define

Input: (define BUFSIZ 512)

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 bufsiz) *preprocessor-defines*) #A((3) base-char . "512"))) (defparameter bufsiz 512))


Instruction:
Define a macro that eliminates this repetitive pattern:
(define-modf-rewrite cdaadr (expr) `(cdr (caadr ,(second expr))))

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

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


Instruction:
Write a Common Lisp macro to handle this code pattern:
(letrec* ((f (constantly t)) (a (funcall f))) (is-true a))

Problem: Macro call that should be transformed by letrec*

Input: (letrec* ((f (constantly t)) (a (funcall f))) (is-true a))

Output:
(defmacro letrec* ((&rest bindings) &body body)
  "Like LETREC, but the bindings are evaluated in order.
See Waddell et al., *Fixing Letrec* for motivation.

Cf. `fbindrec*'."
  `(letrec-with setq ,bindings
     ,@body))

(letrec-with setq ((f (constantly t)) (a (funcall f))) (is-true a))


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

Problem: Macro call that should be transformed by GATHER-NEXT

Input: (gather-next nil nil)

Output: (defmacro GATHER-NEXT ...)


Instruction:
Write a Common Lisp macro to handle this code pattern:
(bind ((#2a((a b c) (d e f)) #2a((1 2 3) (4 5 6)))) (list a b c d e f))

Problem: Macro call that should be transformed by bind

Input: (bind ((#2a((a b c) (d e f)) #2a((1 2 3) (4 5 6)))) (list a b c d e f))

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

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

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

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

(let* ((#:|values-167| #2A((1 2 3) (4 5 6))) (a (row-major-aref #:|values-167| 0)) (b (row-major-aref #:|values-167| 1)) (c (row-major-aref #:|values-167| 2)) (d (row-major-aref #:|values-167| 3)) (e (row-major-aref #:|values-167| 4)) (f (row-major-aref #:|values-167| 5))) (declare (ignorable #:|values-167|)) (progn (list a b c d e f)))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(ps-once-only nil
  :key
  nil)

What needs to change: Macro call that should be transformed by PS-ONCE-ONLY

Input:
(ps-once-only nil
  :key
  nil)

Output: (defmacro PS-ONCE-ONLY ...)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(match maybe m ((just x) x) (nothing else))

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

Input: (match maybe m ((just x) x) (nothing else))

Output:
(defmacro match (adt obj &body clauses)
  "Perform pattern matching on OBJ with (adt-type) ADT.

Each clause must have the following syntax:

<var> := <symbol> | '_'
<lhs> := '_'
       | (<symbol> <var>*)
<clause> := (<lhs> <lisp code>)

The symbol '_' denotes a wildcard, as well as a fallthough.

Note that pattern matching is only shallow (patterns are one-level
deep).
"
  (assert (symbolp adt)
          (adt)
          "MATCH requires a symbol for the first argument. Given ~S."
          adt)

  (let ((ctors (mapcar #'car (get-constructors adt)))
        (types (mapcar (lambda (clause)
                         (ensure-car (car clause)))
                       clauses))
        (once (gensym "OBJ-")))

    ;; Check for duplicate matches.
    (let ((dupes (duplicates types)))
      (when dupes
        (warn "Duplicate matching clauses exist. Duplicate pattern ~
               constructors:~{ ~S~}"
              dupes)))

    ;; Check for match exhaustiveness.
    (unless (some #'wild? types)
      (let ((diff (set-difference ctors types)))
        (when diff
          (warn "Non-exhaustive match on ~A data ~
                 type. Missing cases:~{ ~S~}" adt diff))))

    ;; Generate the matching code.
    `(let ((,once ,obj))
       (check-type ,once ,adt)
       (etypecase ,once
         ,@(loop :for (bindings . body) :in clauses
                 :collect (let ((type (ensure-car bindings)))
                            (if (wild? type)
                                `(t ,@body)
                                `(,type
                                  (with-data ,(ensure-list bindings)
                                             ,once
                                    ,@body)))))))))

(let ((#:obj-147 m)) (check-type #:obj-147 maybe) (etypecase #:obj-147 (just (with-data (just x) #:obj-147 x)) (nothing (with-data (nothing) #:obj-147 else))))


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

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

Input: (dig 'some-name)

Output: (defmacro DIG ...)


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

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

Input: (as->* nil nil)

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


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(when (slot-boundp item slot) (when (eq (slot-value item slot) nil) (setf subnodes (remove slot subnodes))) (let ((position (position slot subnodes))) (setf (slot-value node-copy slot) (if position (nth position subnode-copies) (slot-value item slot)))))

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

Input: (when (slot-boundp item slot) (when (eq (slot-value item slot) nil) (setf subnodes (remove slot subnodes))) (let ((position (position slot subnodes))) (setf (slot-value node-copy slot) (if position (nth position subnode-copies) (slot-value item slot)))))

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

(if (slot-boundp item slot) (progn (when (eq (slot-value item slot) nil) (setf subnodes (remove slot subnodes))) (let ((position (position slot subnodes))) (setf (slot-value node-copy slot) (if position (nth position subnode-copies) (slot-value item slot))))))


Instruction:
Create a Common Lisp macro for the following transformation. Before code:
(with-env [str 0])

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

Input: (with-env [str 0])

Output:
(defmacro with-env (&body body)
  (let ((body-value (gensym)))
    `(let (,body-value)
       (defclass foo () ((a :initform 3)))
       (defmethod get-val ((object foo) &rest slot/s) (slot-value object (car slot/s)))
       (defmethod (setf get-val) (new-value (object foo) &rest slot/s)
         (setf (slot-value object (car slot/s)) new-value))
       (defstruct bar a)
       (setq ,body-value
             (let ((str (alexandria:copy-array "abcde"))
                   (vec (alexandria:copy-array #(a b c d e)))
                   (arr (alexandria:copy-array #2A((1 2 3)
                                                   (4 5 6))))
                   (list      (copy-list '(a b c d e)))
                   (ht        (eval (read-from-string "{'a 'b 'c 'd}")))
                   (ht-eq     (eval (read-from-string "{eq \"a\" 1
                                                    \"b\" 2}")))
                   (ht-equalp (eval (read-from-string "{equalp '(1 2 3) \"a\"
                                                               '(4 5 6) \"b\"}")))
                   (assoc-list (copy-tree '((a . 1) (b . 2))))
                   (plist      (copy-list '(:a 4 :c 5)))
                   (clos-object (make-instance 'foo))
                   (struct      (make-bar :a 3)))
               (declare (ignorable str vec arr list ht ht-eq ht-equalp
                                   assoc-list plist clos-object struct))
               ,@body))
       (setf (find-class 'foo nil) nil)
       (setf (find-class 'bar nil) nil)
       ,body-value))

(let (#:g123) (defclass foo nil ((a :initform 3))) (defmethod get-val ((object foo) &rest slot/s) (slot-value object (car slot/s))) (defmethod (setf get-val) (new-value (object foo) &rest slot/s) (setf (slot-value object (car slot/s)) new-value)) (defstruct bar a) (setq #:g123 (let ((str (alexandria:copy-array "abcde")) (vec (alexandria:copy-array #(a b c d e))) (arr (alexandria:copy-array #2A((1 2 3) (4 5 6)))) (list (copy-list (quote (a b c d e)))) (ht (eval (read-from-string "{'a 'b 'c 'd}"))) (ht-eq (eval (read-from-string "{eq \"a\" 1
                                                    \"b\" 2}"))) (ht-equalp (eval (read-from-string "{equalp '(1 2 3) \"a\"
                                                               '(4 5 6) \"b\"}"))) (assoc-list (copy-tree (quote ((a . 1) (b . 2))))) (plist (copy-list (quote (:a 4 :c 5)))) (clos-object (make-instance (quote foo))) (struct (make-bar :a 3))) (declare (ignorable str vec arr list ht ht-eq ht-equalp assoc-list plist clos-object struct)) [str 0])) (setf (find-class (quote foo) nil) nil) (setf (find-class (quote bar) nil) nil) #:g123)


Instruction:
You are a Common Lisp macro expert. Given this code pattern:
(without-symbol-access
  nil
  nil)

Write a macro that addresses: Macro call that should be transformed by WITHOUT-SYMBOL-ACCESS

Input:
(without-symbol-access
  nil
  nil)

Output: (defmacro WITHOUT-SYMBOL-ACCESS ...)

(let ((*symbol-access* nil))
  nil
  nil)


Instruction:
Generate a defmacro form that transforms code like this:
(matrix-typecase nil)

Pattern to recognize: Macro call that should be transformed by MATRIX-TYPECASE

Input: (matrix-typecase nil)

Output: (defmacro MATRIX-TYPECASE ...)