[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-class foo-type-infer () ((name "foo") (nickname street-name) (age 1) (height 2.0) (width 2 :type number) (lisper t) (nil-is-not-bool nil) (empty-list '()) (nonempty-list '(1 2 3)) (mark :foo) (binding :unbound) (sym 'sims) (fun #'list) (composite (error "Should not eval, type should not be inferred"))) (:automatic-types-p t))

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

(define-class foo-type-infer () ((name "foo") (nickname street-name) (age 1) (height 2.0) (width 2 :type number) (lisper t) (nil-is-not-bool nil) (empty-list '()) (nonempty-list '(1 2 3)) (mark :foo) (binding :unbound) (sym 'sims) (fun #'list) (composite (error "Should not eval, type should not be inferred"))) (:automatic-types-p t))

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

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

Slot options:

- The initform can be specified as the second value.

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

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

New class options (defaults are NIL unless specified):

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

;; macroexpand:
(progn (defclass foo-type-infer nil ((name :initform "foo" :accessor name :initarg :name :type string) (nickname :initform street-name :accessor nickname :initarg :nickname) (age :initform 1 :accessor age :initarg :age :type integer) (height :initform 2.0 :accessor height :initarg :height :type number) (width :initform 2 :accessor width :initarg :width :type number) (lisper :initform t :accessor lisper :initarg :lisper :type boolean) (nil-is-not-bool :initform nil :accessor nil-is-not-bool :initarg :nil-is-not-bool) (empty-list :initform (quote nil) :accessor empty-list :initarg :empty-list :type list) (nonempty-list :initform (quote (1 2 3)) :accessor nonempty-list :initarg :nonempty-list :type list) (mark :initform :foo :accessor mark :initarg :mark :type keyword) (binding :accessor binding :initarg :binding) (sym :initform (quote sims) :accessor sym :initarg :sym :type symbol) (fun :initform (function list) :accessor fun :initarg :fun :type function) (composite :initform (error "Should not eval, type should not be inferred") :accessor composite :initarg :composite))) (unless (fboundp (quote foo-type-infer-p)) (define-generic foo-type-infer-p (object) #A((79) base-char . "Auto-generated predicate for whether OBJECT is an instance of `foo-type-infer'.") (declare (sb-ext:muffle-conditions style-warning)) (typep object (quote foo-type-infer)))) (setf (documentation (quote composite) (quote function)) #A((52) base-char . "Auto-generated accessor function for slot COMPOSITE.")) (ignore-errors (setf (documentation (fdefinition (quote composite)) (quote function)) #A((52) base-char . "Auto-generated accessor function for slot COMPOSITE."))) (ignore-errors (setf (documentation (fdefinition (quote (setf composite))) (quote function)) #A((52) base-char . "Auto-generated accessor function for slot COMPOSITE."))) (setf (documentation (quote fun) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot FUN.")) (ignore-errors (setf (documentation (fdefinition (quote fun)) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot FUN."))) (ignore-errors (setf (documentation (fdefinition (quote (setf fun))) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot FUN."))) (setf (documentation (quote sym) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot SYM.")) (ignore-errors (setf (documentation (fdefinition (quote sym)) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot SYM."))) (ignore-errors (setf (documentation (fdefinition (quote (setf sym))) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot SYM."))) (setf (documentation (quote binding) (quote function)) #A((50) base-char . "Auto-generated accessor function for slot BINDING.")) (ignore-errors (setf (documentation (fdefinition (quote binding)) (quote function)) #A((50) base-char . "Auto-generated accessor function for slot BINDING."))) (ignore-errors (setf (documentation (fdefinition (quote (setf binding))) (quote function)) #A((50) base-char . "Auto-generated accessor function for slot BINDING."))) (setf (documentation (quote mark) (quote function)) #A((47) base-char . "Auto-generated accessor function for slot MARK.")) (ignore-errors (setf (documentation (fdefinition (quote mark)) (quote function)) #A((47) base-char . "Auto-generated accessor function for slot MARK."))) (ignore-errors (setf (documentation (fdefinition (quote (setf mark))) (quote function)) #A((47) base-char . "Auto-generated accessor function for slot MARK."))) (setf (documentation (quote nonempty-list) (quote function)) #A((56) base-char . "Auto-generated accessor function for slot NONEMPTY-LIST.")) (ignore-errors (setf (documentation (fdefinition (quote nonempty-list)) (quote function)) #A((56) base-char . "Auto-generated accessor function for slot NONEMPTY-LIST."))) (ignore-errors (setf (documentation (fdefinition (quote (setf nonempty-list))) (quote function)) #A((56) base-char . "Auto-generated accessor function for slot NONEMPTY-LIST."))) (setf (documentation (quote empty-list) (quote function)) #A((53) base-char . "Auto-generated accessor function for slot EMPTY-LIST.")) (ignore-errors (setf (documentation (fdefinition (quote empty-list)) (quote function)) #A((53) base-char . "Auto-generated accessor function for slot EMPTY-LIST."))) (ignore-errors (setf (documentation (fdefinition (quote (setf empty-list))) (quote function)) #A((53) base-char . "Auto-generated accessor function for slot EMPTY-LIST."))) (setf (documentation (quote nil-is-not-bool) (quote function)) #A((58) base-char . "Auto-generated accessor function for slot NIL-IS-NOT-BOOL.")) (ignore-errors (setf (documentation (fdefinition (quote nil-is-not-bool)) (quote function)) #A((58) base-char . "Auto-generated accessor function for slot NIL-IS-NOT-BOOL."))) (ignore-errors (setf (documentation (fdefinition (quote (setf nil-is-not-bool))) (quote function)) #A((58) base-char . "Auto-generated accessor function for slot NIL-IS-NOT-BOOL."))) (setf (documentation (quote lisper) (quote function)) #A((49) base-char . "Auto-generated accessor function for slot LISPER.")) (ignore-errors (setf (documentation (fdefinition (quote lisper)) (quote function)) #A((49) base-char . "Auto-generated accessor function for slot LISPER."))) (ignore-errors (setf (documentation (fdefinition (quote (setf lisper))) (quote function)) #A((49) base-char . "Auto-generated accessor function for slot LISPER."))) (setf (documentation (quote width) (quote function)) #A((48) base-char . "Auto-generated accessor function for slot WIDTH.")) (ignore-errors (setf (documentation (fdefinition (quote width)) (quote function)) #A((48) base-char . "Auto-generated accessor function for slot WIDTH."))) (ignore-errors (setf (documentation (fdefinition (quote (setf width))) (quote function)) #A((48) base-char . "Auto-generated accessor function for slot WIDTH."))) (setf (documentation (quote height) (quote function)) #A((49) base-char . "Auto-generated accessor function for slot HEIGHT.")) (ignore-errors (setf (documentation (fdefinition (quote height)) (quote function)) #A((49) base-char . "Auto-generated accessor function for slot HEIGHT."))) (ignore-errors (setf (documentation (fdefinition (quote (setf height))) (quote function)) #A((49) base-char . "Auto-generated accessor function for slot HEIGHT."))) (setf (documentation (quote age) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot AGE.")) (ignore-errors (setf (documentation (fdefinition (quote age)) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot AGE."))) (ignore-errors (setf (documentation (fdefinition (quote (setf age))) (quote function)) #A((46) base-char . "Auto-generated accessor function for slot AGE."))) (setf (documentation (quote nickname) (quote function)) #A((51) base-char . "Auto-generated accessor function for slot NICKNAME.")) (ignore-errors (setf (documentation (fdefinition (quote nickname)) (quote function)) #A((51) base-char . "Auto-generated accessor function for slot NICKNAME."))) (ignore-errors (setf (documentation (fdefinition (quote (setf nickname))) (quote function)) #A((51) base-char . "Auto-generated accessor function for slot NICKNAME."))) (setf (documentation (quote name) (quote function)) #A((47) base-char . "Auto-generated accessor function for slot NAME.")) (ignore-errors (setf (documentation (fdefinition (quote name)) (quote function)) #A((47) base-char . "Auto-generated accessor function for slot NAME."))) (ignore-errors (setf (documentation (fdefinition (quote (setf name))) (quote function)) #A((47) base-char . "Auto-generated accessor function for slot NAME."))) (find-class (quote foo-type-infer) nil))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-declaration nil
    nil)

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

(define-declaration nil
    nil)

[Assistant]
(defmacro DEFINE-DECLARATION ...)

;; macroexpand:
(sb-cltl2:define-declaration nil
    nil)


[User]
Define a macro that eliminates this repetitive pattern:
(with-unique-js-names 'some-name)

Issue: Macro call that should be transformed by WITH-UNIQUE-JS-NAMES

(with-unique-js-names 'some-name)

[Assistant]
(defmacro WITH-UNIQUE-JS-NAMES ...)

;; macroexpand:
(with-ps-gensyms 'some-name)


[User]
Write a Common Lisp macro to handle this code pattern:
(with* nil
  (progn))

Problem: Macro call that should be transformed by WITH*

(with* nil
  (progn))

[Assistant]
(defmacro WITH* ...)

;; macroexpand:
(progn)


[User]
Generate a defmacro form that transforms code like this:
(dlet nil
  (progn))

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

(dlet nil
  (progn))

[Assistant]
(defmacro DLET ...)

;; macroexpand:
(dynamic-let nil
  (progn))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-html-string (:html (:head) (:body (:a "hai"))))

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

(with-html-string (:html (:head) (:body (:a "hai"))))

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

;; macroexpand:
(with-output-to-string (*html*) (with-html (:html (:head) (:body (:a "hai")))))


[User]
Generate a defmacro form that transforms code like this:
(with-attributes nil
    (progn))

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

(with-attributes nil
    (progn))

[Assistant]
(defmacro WITH-ATTRIBUTES ...)

;; macroexpand:
(let ((#:unit161 (progn)))
  (symbol-macrolet ()))


[User]
Write a Common Lisp macro to handle this code pattern:
(make-name-transformer \"FOO-\" name \"-BAR\") Use the slot name directly: :accessor-name-transformer (make-name-transformer name)" `(lambda (name definition) (declare (ignorable definition)) (concatenate-symbol ,@(mapcar (lambda (el) (if (and (symbolp el) (string= (symbol-name el) "NAME")) 'name el)) elements))))

Problem: Macro call that should be transformed by make-name-transformer

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

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

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

Use the slot name directly:

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

;; macroexpand:
(lambda (name definition) (declare (ignorable definition)) (concatenate-symbol |"FOO-"| name |"-BAR"|))


[User]
Generate a defmacro form that transforms code like this:
(aif 1 (sif it it))

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

(aif 1 (sif it it))

[Assistant]
(defmacro aif (test then &optional else)
  "Like IF, except binds the result of the test to IT (via LET) for
the scope of the then and else expressions."
  `(anaphoric if ,test ,then ,else))

;; macroexpand:
(anaphoric if 1 (sif it it) nil)


[User]
Define a macro that eliminates this repetitive pattern:
(define-dispatch dispatch-for-no-result (args specific-hooks) (mapc (lambda (f) (apply f args)) specific-hooks))

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

(define-dispatch dispatch-for-no-result (args specific-hooks) (mapc (lambda (f) (apply f args)) specific-hooks))

[Assistant]
(defmacro define-dispatch (name lambda-list &body body)
  "the lambda list should accept two arguments:
the list of arguments given by the current method call.
the specific hooks (as named or unamed functions) for the qualified method (that we will be dispatching from).

you should then use the arguments to dispatch the specific hooks as you wish in the body.
if the body returns a result, by default the method will also return that result, this can be overriden with finalize-dispatch-method.

See finalize-dispatch-method
See dispatch"
  `(let ((new-dispatch (make-dispatcher (lambda ,lambda-list ,@body))))
     (setf (gethash ',name *dispatch-table*)
           new-dispatch)))

;; macroexpand:
(let ((new-dispatch (make-dispatcher (lambda (args specific-hooks) (mapc (lambda (f) (apply f args)) specific-hooks))))) (setf (gethash (quote dispatch-for-no-result) *dispatch-table*) new-dispatch))


[User]
Define a macro that eliminates this repetitive pattern:
(true 4)

Issue: Macro call that should be transformed by true

(true 4)

[Assistant]
(defmacro true (form &optional description &rest format-args)
  `(eval-in-context
    *context*
    (make-instance 'comparison-result
                   :expression '(true ,form)
                   :value-form ',form
                   :body (lambda () ,form)
                   :expected 'T
                   :comparison 'geq
                   ,@(when description
                       `(:description (format NIL ,description ,@format-args))))))

;; macroexpand:
(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (true 4)) :value-form (quote 4) :body (lambda nil 4) :expected (quote t) :comparison (quote geq)))


[User]
Generate a defmacro form that transforms code like this:
(finalize-savepoint :rolled-back (call-next-method conn identifier))

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

(finalize-savepoint :rolled-back (call-next-method conn identifier))

[Assistant]
(defmacro finalize-savepoint (new-state &body body)
  `(let ((state (get-transaction-state conn)))
     (unless (typep state 'savepoint-state)
       (error "Please, use release-savepoint inside of with-savepoint block."))
     (unless (equal (get-identifier state)
                    identifier)
       ;; TODO: probably optional `identifier' parameter
       ;;       is excessive and should be removed?
       (error "Identifier mismatch"))

     (multiple-value-prog1
         (progn ,@body)
       (setf (get-state state)
             ,new-state))))

;; macroexpand:
(let ((state (get-transaction-state conn))) (unless (typep state (quote savepoint-state)) (error "Please, use release-savepoint inside of with-savepoint block.")) (unless (equal (get-identifier state) identifier) (error "Identifier mismatch")) (multiple-value-prog1 (progn (call-next-method conn identifier)) (setf (get-state state) :rolled-back)))


[User]
Write a Common Lisp macro to handle this code pattern:
(builder (when t `(:sample :out ,(lambda (out) (format t "Got: ~a" out)))) *app*)

Problem: Macro call that should be transformed by builder

(builder (when t `(:sample :out ,(lambda (out) (format t "Got: ~a" out)))) *app*)

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

;; macroexpand:
(reduce (function funcall) (remove-if (function null) (list (let ((#:res183 (when t (sb-int:quasiquote (:sample :out #S(sb-impl::comma :expr (lambda (out) (format t "Got: ~a" out)) :kind 0)))))) (typecase #:res183 (keyword (find-middleware #:res183)) (cons (if (keywordp (car #:res183)) (let ((#:res-mw182 (find-middleware (car #:res183)))) (lambda (#:app181) (apply #:res-mw182 #:app181 (cdr #:res183)))) #:res183)) (standard-object (lambda (#:app181) (funcall (intern (string :wrap) :clack.middleware) #:res183 #:app181))) (otherwise #:res183))))) :initial-value (to-app *app*) :from-end t)


[User]
Define a macro that eliminates this repetitive pattern:
(define-error unknown-variable-type () (name) "Could not establish the type of the variable: ~s" name)

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

(define-error unknown-variable-type () (name) "Could not establish the type of the variable: ~s" name)

[Assistant]
(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))

;; macroexpand:
(defcondition unknown-variable-type (:error-type varjo-error :prefix "Varjo") (name) "Could not establish the type of the variable: ~s" name)


[User]
Write a Common Lisp macro to handle this code pattern:
(aggregate-scope-progv *array-scope-variables* (aggregate-scope-progv *aggregate-scope-variables* (funcall *beginning-of-array-handler*) (multiple-value-bind (type token) (peek-json-token stream) (if (and (eql type :punct) (char= token #\])) (progn (read-json-token stream) (return-from decode-json-array (funcall *end-of-array-handler*))) (funcall *array-member-handler* (funcall *internal-decoder* stream)))) (loop (multiple-value-bind (type token) (read-json-token stream) (if (eql type :punct) (case token (#\] (return-from decode-json-array (funcall *end-of-array-handler*))) (#\, (setq token nil)))) (if token (json-syntax-error stream "Token out of place in Array on JSON input: `~A'" token))) (funcall *array-member-handler* (funcall *internal-decoder* stream)))))

Problem: Macro call that should be transformed by aggregate-scope-progv

(aggregate-scope-progv *array-scope-variables* (aggregate-scope-progv *aggregate-scope-variables* (funcall *beginning-of-array-handler*) (multiple-value-bind (type token) (peek-json-token stream) (if (and (eql type :punct) (char= token #\])) (progn (read-json-token stream) (return-from decode-json-array (funcall *end-of-array-handler*))) (funcall *array-member-handler* (funcall *internal-decoder* stream)))) (loop (multiple-value-bind (type token) (read-json-token stream) (if (eql type :punct) (case token (#\] (return-from decode-json-array (funcall *end-of-array-handler*))) (#\, (setq token nil)))) (if token (json-syntax-error stream "Token out of place in Array on JSON input: `~A'" token))) (funcall *array-member-handler* (funcall *internal-decoder* stream)))))

[Assistant]
(defmacro aggregate-scope-progv (variables &body body)
  "Establish a dynamic environment where all VARIABLES are freshly
bound (to their current values), and execute BODY in it, returning the
result."
  `(progv ,variables (mapcar #'symbol-value ,variables)
     ,@body))

;; macroexpand:
(progv *array-scope-variables* (mapcar (function symbol-value) *array-scope-variables*) (aggregate-scope-progv *aggregate-scope-variables* (funcall *beginning-of-array-handler*) (multiple-value-bind (type token) (peek-json-token stream) (if (and (eql type :punct) (char= token #\RIGHT_SQUARE_BRACKET)) (progn (read-json-token stream) (return-from decode-json-array (funcall *end-of-array-handler*))) (funcall *array-member-handler* (funcall *internal-decoder* stream)))) (loop (multiple-value-bind (type token) (read-json-token stream) (if (eql type :punct) (case token (#\RIGHT_SQUARE_BRACKET (return-from decode-json-array (funcall *end-of-array-handler*))) (#\COMMA (setq token nil)))) (if token (json-syntax-error stream "Token out of place in Array on JSON input: `~A'" token))) (funcall *array-member-handler* (funcall *internal-decoder* stream)))))


[User]
Define a macro that eliminates this repetitive pattern:
(builder (when t :sample) *app*)

Issue: Macro call that should be transformed by builder

(builder (when t :sample) *app*)

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

;; macroexpand:
(reduce (function funcall) (remove-if (function null) (list (let ((#:res180 (when t :sample))) (typecase #:res180 (keyword (find-middleware #:res180)) (cons (if (keywordp (car #:res180)) (let ((#:res-mw179 (find-middleware (car #:res180)))) (lambda (#:app178) (apply #:res-mw179 #:app178 (cdr #:res180)))) #:res180)) (standard-object (lambda (#:app178) (funcall (intern (string :wrap) :clack.middleware) #:res180 #:app178))) (otherwise #:res180))))) :initial-value (to-app *app*) :from-end t)


[User]
Define a macro that eliminates this repetitive pattern:
(send nil nil)

Issue: Macro call that should be transformed by SEND

(send nil nil)

[Assistant]
(defmacro SEND ...)

;; macroexpand:
(send (slot-value nil 'nil))


[User]
Generate a defmacro form that transforms code like this:
(defrule nil
  nil)

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

(defrule nil
  nil)

[Assistant]
(defmacro DEFRULE ...)

;; macroexpand:
(setf (gethash #A((3) base-char . "NIL") cl-rules.core::*rules*)
        '#S(cl-rules.core::rule
            :name #A((3) base-char . "NIL")
            :conditions (#S(cl-rules.core::condn
                            :name #A((3) base-char . "NIL")
                            :args nil))
            :actions nil))


[User]
Write a Common Lisp macro to handle this code pattern:
(define TMP_MAX 1024)

Problem: Macro call that should be transformed by define

(define TMP_MAX 1024)

[Assistant]
(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)))

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


[User]
You are a Common Lisp macro expert. Given this code pattern:
(is (= result 0))

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

(is (= result 0))

[Assistant]
(defmacro is (test &rest reason-args)
  "The DWIM checking operator.

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

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

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

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

;; macroexpand:
(let ((#:e173 result) (#:a174 0)) (if (progn (= #:e173 #:a174)) (add-result (quote test-passed) :test-expr (quote (= result 0))) (process-failure (quote (= result 0)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote 0) #:a174 (quote =) #:e173)))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-definition-resolver transform (designator package) (let ((fun-info (when (symbolp designator) (sb-int:info :function :info designator)))) (when fun-info (loop for transform in (sb-c::fun-info-transforms fun-info) collect (make-instance 'transform :designator designator :package package :transform transform)))))

Problem: Macro call that should be transformed by define-definition-resolver

(define-definition-resolver transform (designator package) (let ((fun-info (when (symbolp designator) (sb-int:info :function :info designator)))) (when fun-info (loop for transform in (sb-c::fun-info-transforms fun-info) collect (make-instance 'transform :designator designator :package package :transform transform)))))

[Assistant]
(defmacro define-definition-resolver (name args &body body)
  `(progn (setf (definition-resolver ',name)
                (lambda ,args ,@body))
          ',name))

;; macroexpand:
(progn (setf (definition-resolver (quote transform)) (lambda (designator package) (let ((fun-info (when (symbolp designator) (sb-int:info :function :info designator)))) (when fun-info (loop for transform in (sb-c::fun-info-transforms fun-info) collect (make-instance (quote transform) :designator designator :package package :transform transform)))))) (quote transform))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(collect nil nil)

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

(collect nil nil)

[Assistant]
(defmacro COLLECT ...)

;; macroexpand:
(common-lisp:let* ((#:generator-591 (generator nil))
                   #:items-584
                   #:seq-585
                   (#:limit-586
                    (common-lisp:multiple-value-bind (x y)
                        (decode-seq-type (list 'quote nil))
                      (declare (ignore x))
                      y))
                   (#:lst-587 nil))
  (declare (type generator #:generator-591)
           (type (null-or nonnegative-integer) #:limit-586)
           (type list #:lst-587))
  (tagbody
   #:ll-592
    (setq #:items-584 (next-in #:generator-591 (go end)))
    (setq #:lst-587 (cons #:items-584 #:lst-587))
    (go #:ll-592)
   end)
  (common-lisp:let ((num (length #:lst-587)))
    (declare (type nonnegative-integer num))
    (setq #:seq-585 (make-sequence nil (or #:limit-586 num)))
    (do ((i (1- num) (1- i)))
        ((minusp i))
      (setf (elt #:seq-585 i) (pop #:lst-587))))
  #:seq-585)


[User]
Generate a defmacro form that transforms code like this:
(with-mapping-collector 'some-name)

Pattern to recognize: Macro call that should be transformed by WITH-MAPPING-COLLECTOR

(with-mapping-collector 'some-name)

[Assistant]
(defmacro WITH-MAPPING-COLLECTOR ...)

;; macroexpand:
(let ((#:col125 (make-collector)))
  (map-aggregation (#:col125 (lambda some-name))
    (flet ((quote (&rest #:flet-args126) (apply #:col125 #:flet-args126))))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(none-of 'some-name)

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

(none-of 'some-name)

[Assistant]
(defmacro NONE-OF ...)

;; macroexpand:
(lc ('some-name) never)


[User]
Define a macro that eliminates this repetitive pattern:
(with-reducer 'some-name)

Issue: Macro call that should be transformed by WITH-REDUCER

(with-reducer 'some-name)

[Assistant]
(defmacro WITH-REDUCER ...)

;; macroexpand:
(let ((#:reducer128
       (make-reducer some-name :initial-value (or nil nil) :place-setter nil)))
  (flet ((quote (&rest items) (apply #:reducer128 items)))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(integer-writer 2)

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

(integer-writer 2)

[Assistant]
(defmacro integer-writer (bytes)
  "Create a function to write integers to a binary stream."
  (let ((bits (* 8 bytes)))
    `(progn
       (declaim (inline ,(integer-writer-name bytes t)
                        ,(integer-writer-name bytes nil)))
       (defun ,(integer-writer-name bytes nil) (socket value)
         (declare (type stream socket)
                  (type (unsigned-byte ,bits) value)
                  #.*optimize*)
         ,@(if (= bytes 1)
               `((write-byte value socket))
               (loop :for byte :from (1- bytes) :downto 0
                     :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
                                           socket)))
         (values))
       (defun ,(integer-writer-name bytes t) (socket value)
         (declare (type stream socket)
                  (type (signed-byte ,bits) value)
                  #.*optimize*)
         ,@(if (= bytes 1)
               `((write-byte (ldb (byte 8 0) value) socket))
               (loop :for byte :from (1- bytes) :downto 0
                     :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value)
                                           socket)))
         (values)))))

;; macroexpand:
(progn (declaim (inline write-int2 write-uint2)) (defun write-uint2 (socket value) (declare (type stream socket) (type (unsigned-byte 16) value) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (write-byte (ldb (byte 8 8) value) socket) (write-byte (ldb (byte 8 0) value) socket) (values)) (defun write-int2 (socket value) (declare (type stream socket) (type (signed-byte 16) value) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (write-byte (ldb (byte 8 8) value) socket) (write-byte (ldb (byte 8 0) value) socket) (values)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-reader-case nil
  (progn))

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

(with-reader-case nil
  (progn))

[Assistant]
(defmacro WITH-READER-CASE ...)

;; macroexpand:
(let ()
  (let ((#:previous-case180 (readtable-case *readtable*)))
    (setf (readtable-case *readtable*) nil)
    (unwind-protect (progn (progn))
      (setf (readtable-case *readtable*) #:previous-case180))))


[User]
Define a macro that eliminates this repetitive pattern:
(def-neo4j-fun create-index ((type :node) name config) :post (:uri-spec (format nil "index/~A" (string-downcase (symbol-name type)))) (:encode (cons (cons :name name) config) :string) (:status-handlers (201 (decode-neo4j-json-output body))))

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

(def-neo4j-fun create-index ((type :node) name config) :post (:uri-spec (format nil "index/~A" (string-downcase (symbol-name type)))) (:encode (cons (cons :name name) config) :string) (:status-handlers (201 (decode-neo4j-json-output body))))

[Assistant]
(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)))))))))

;; macroexpand:
(progn (defun create-index (&key (type :node) name config) (let ((uri (format nil "index/~A" (string-downcase (symbol-name type)))) (json (encode-neo4j-json-payload (cons (cons :name name) config) :string))) (make-neo4j-request :post uri json (list (list 201 (lambda (body uri json) (decode-neo4j-json-output body))))))))


[User]
Generate a defmacro form that transforms code like this:
(defstruct-compile-time function-record function-name (lambda-list nil) (body nil) (callees nil) (deterministic? t) (old-deterministic? nil) (screamer? *screamer?*))

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

(defstruct-compile-time function-record function-name (lambda-list nil) (body nil) (callees nil) (deterministic? t) (old-deterministic? nil) (screamer? *screamer?*))

[Assistant]
(defmacro defstruct-compile-time (options &body items)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (defstruct ,options ,@items)))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defstruct function-record function-name (lambda-list nil) (body nil) (callees nil) (deterministic? t) (old-deterministic? nil) (screamer? *screamer?*)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-alias-binding update updating)

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

(define-alias-binding update updating)

[Assistant]
(defmacro define-alias-binding (name referenced-binding-name)
  `(progn (setf (binding ',name) ',referenced-binding-name)
          ',name))

;; macroexpand:
(progn (setf (binding (quote update)) (quote updating)) (quote update))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(declare-deprecated-operators nil (progn))

What needs to change: Macro call that should be transformed by DECLARE-DEPRECATED-OPERATORS

(declare-deprecated-operators nil (progn))

[Assistant]
(defmacro DECLARE-DEPRECATED-OPERATORS ...)

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


[User]
Write a Common Lisp macro to handle this code pattern:
(loop-on-custom (key var value) customizations collect (list var value))

Problem: Macro call that should be transformed by loop-on-custom

(loop-on-custom (key var value) customizations collect (list var value))

[Assistant]
(defmacro loop-on-custom ((key var &optional value) &rest clauses)
  (if value
      (destructuring-bind (key-args . clauses) clauses
        `(loop for (,key ,value) on ,key-args by #'cddr
            for ,var = (custom-key-to-variable ,key)
            if ,var ,@clauses))
      `(loop for (,var . ,key) in *custom-vars*
            ,@clauses)))

;; macroexpand:
(loop for (key value) on customizations by (function cddr) for var = (custom-key-to-variable key) if var collect (list var value))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-error not-core-type-error () (type-name) "Type ~a is not a core type and thus cannot end up in glsl src code It must end up being used or converted to something that resolves to a glsl type." type-name)

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

(define-error not-core-type-error () (type-name) "Type ~a is not a core type and thus cannot end up in glsl src code It must end up being used or converted to something that resolves to a glsl type." type-name)

[Assistant]
(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))

;; macroexpand:
(defcondition not-core-type-error (:error-type varjo-error :prefix "Varjo") (type-name) "Type ~a is not a core type and thus cannot end up in glsl src code It must end up being used or converted to something that resolves to a glsl type." type-name)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(send 'some-name)

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

(send 'some-name)

[Assistant]
(defmacro SEND ...)

;; macroexpand:
'some-name


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defclause hash-entries-of (hash-table) "Iterates over the entries of a hash table. The iteration variables must be specified as (key value), for example: (for (lemma definitions) (hash-entries-of the-english-vocabulary))." (unless (and (listp *iteration-variable*) (= 2 (length *iteration-variable*))) (error "Invalid variable specification for hash-entry, expected (key value) but got ~S" *iteration-variable*)) (let ((iterator (gensym "HASH-TABLE-ITERATOR")) (test (gensym "TEST")) (key (car *iteration-variable*)) (value (cadr *iteration-variable*))) `(,(make-wrapper :function (lambda (body) `(with-hash-table-iterator (,iterator ,hash-table) ,body))) ,(make-iteration :bindings (list test key value) :initializations `((setf (values ,test ,key ,value) (,iterator))) :steps `((setf (values ,test ,key ,value) (,iterator))) :postconditions `((not (null ,test)))))))

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

(defclause hash-entries-of (hash-table) "Iterates over the entries of a hash table. The iteration variables must be specified as (key value), for example: (for (lemma definitions) (hash-entries-of the-english-vocabulary))." (unless (and (listp *iteration-variable*) (= 2 (length *iteration-variable*))) (error "Invalid variable specification for hash-entry, expected (key value) but got ~S" *iteration-variable*)) (let ((iterator (gensym "HASH-TABLE-ITERATOR")) (test (gensym "TEST")) (key (car *iteration-variable*)) (value (cadr *iteration-variable*))) `(,(make-wrapper :function (lambda (body) `(with-hash-table-iterator (,iterator ,hash-table) ,body))) ,(make-iteration :bindings (list test key value) :initializations `((setf (values ,test ,key ,value) (,iterator))) :steps `((setf (values ,test ,key ,value) (,iterator))) :postconditions `((not (null ,test)))))))

[Assistant]
(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*)))

;; macroexpand:
(progn (defmacro hash-entries-of (hash-table) "Iterates over the entries of a hash table. The iteration variables must be specified as (key value), for example: (for (lemma definitions) (hash-entries-of the-english-vocabulary))." (unless (and (listp *iteration-variable*) (= 2 (length *iteration-variable*))) (error "Invalid variable specification for hash-entry, expected (key value) but got ~S" *iteration-variable*)) (let ((iterator (gensym "HASH-TABLE-ITERATOR")) (test (gensym "TEST")) (key (car *iteration-variable*)) (value (cadr *iteration-variable*))) (sb-int:quasiquote (#S(sb-impl::comma :expr (make-wrapper :function (lambda (body) (sb-int:quasiquote (with-hash-table-iterator (#S(sb-impl::comma :expr iterator :kind 0) #S(sb-impl::comma :expr hash-table :kind 0)) #S(sb-impl::comma :expr body :kind 0))))) :kind 0) #S(sb-impl::comma :expr (make-iteration :bindings (list test key value) :initializations (sb-int:quasiquote ((setf (values #S(sb-impl::comma :expr test :kind 0) #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr value :kind 0)) (#S(sb-impl::comma :expr iterator :kind 0))))) :steps (sb-int:quasiquote ((setf (values #S(sb-impl::comma :expr test :kind 0) #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr value :kind 0)) (#S(sb-impl::comma :expr iterator :kind 0))))) :postconditions (sb-int:quasiquote ((not (null #S(sb-impl::comma :expr test :kind 0)))))) :kind 0))))) (pushnew (quote hash-entries-of) *clauses*))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(is (= 3 c))

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

(is (= 3 c))

[Assistant]
(defmacro is (test &rest reason-args)
  "The DWIM checking operator.

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

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

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

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

;; macroexpand:
(let ((#:e274 3) (#:a275 c)) (if (progn (= #:e274 #:a275)) (add-result (quote test-passed) :test-expr (quote (= 3 c))) (process-failure (quote (= 3 c)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote c) #:a275 (quote =) #:e274)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-ps-gensyms nil
  (progn))

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

(with-ps-gensyms nil
  (progn))

[Assistant]
(defmacro WITH-PS-GENSYMS ...)

;; macroexpand:
(let* ()
  (progn))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-test fixture :fix (*read-default-float-format*) (is = 0.0f0 (read-from-string "0.0")) (setf *read-default-float-format* 'double-float) (is = 0.0d0 (read-from-string "0.0")))

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

(define-test fixture :fix (*read-default-float-format*) (is = 0.0f0 (read-from-string "0.0")) (setf *read-default-float-format* 'double-float) (is = 0.0d0 (read-from-string "0.0")))

[Assistant]
(defmacro define-test (name &body arguments-and-body)
  (destructuring-bind (nparent name) (if (listp name) name (list NIL name))
    (form-fiddle:with-body-options (body options parent home (test-class 'test) (compile-at :compile-time) defun) arguments-and-body
      (let ((body (remove 'define-test body :key (lambda (a) (when (listp a) (car a))) :test #'eql))
            (defs (remove 'define-test body :key (lambda (a) (when (listp a) (car a))) :test-not #'eql))
            (home-form (or home `(find-package ,(package-name *package*)))))
        (when (and parent nparent)
          (error "Cannot specify parent through name and through a keyword argument at the same time!"))
        `(let ((*package* (find-package ,(package-name *package*)))) ; Make sure package stays consistent throughout initialisation.
           (setf (find-test ',name ,home-form)
                 (ensure-test ',test-class
                              :name ',name
                              :home ,home-form
                              :tests (list ,@(loop for form in body
                                                   collect (ecase compile-at
                                                             (:compile-time `(lambda () ,form))
                                                             (:execute `(lambda () (call-compile ',form))))))
                              :parent ',(or parent nparent)
                              ,@(loop for option in options
                                      collect `',option)))
           ,@(loop for (def subname . body) in defs
                   collect `(,def (,name ,subname)
                              :home ,home
                              ,@body))
           ,@(when defun
               `((defun ,(if (stringp name) (read-symbol name) name) (&rest test-args)
                   (apply #'test (find-test ',name ,home-form) test-args))))
           ',name)))))

;; macroexpand:
(let ((*package* (find-package #A((9) base-char . "PARACHUTE")))) (setf (find-test (quote fixture) (find-package #A((9) base-char . "PARACHUTE"))) (ensure-test (quote test) :name (quote fixture) :home (find-package #A((9) base-char . "PARACHUTE")) :tests (list (lambda nil (is = 0.0 (read-from-string "0.0"))) (lambda nil (setf *read-default-float-format* (quote double-float))) (lambda nil (is = 0.0d0 (read-from-string "0.0")))) :parent (quote nil) (quote :fix) (quote (*read-default-float-format*)))) (quote fixture))


[User]
Generate a defmacro form that transforms code like this:
(f0
  nil)

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

(f0
  nil)

[Assistant]
(defmacro F0 ...)

;; macroexpand:
(lambda () nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(augment init-code init)

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

(augment init-code init)

[Assistant]
(defmacro augment (var stuff)
  `(setf ,var (nconc ,var ,stuff)))

;; macroexpand:
(setf init-code (nconc init-code init))


[User]
Write a Common Lisp macro to handle this code pattern:
(finish (error "NOPE"))

Problem: Macro call that should be transformed by finish

(finish (error "NOPE"))

[Assistant]
(defmacro finish (form &optional description &rest format-args)
  `(eval-in-context
    *context*
    (make-instance 'finishing-result
                   :expression '(finish ,form)
                   :body (lambda () ,form)
                   ,@(when description
                       `(:description (format NIL ,description ,@format-args))))))

;; macroexpand:
(eval-in-context *context* (make-instance (quote finishing-result) :expression (quote (finish (error "NOPE"))) :body (lambda nil (error "NOPE"))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(enable-quasi-quoted-list-syntax)

What needs to change: Macro call that should be transformed by ENABLE-QUASI-QUOTED-LIST-SYNTAX

(enable-quasi-quoted-list-syntax)

[Assistant]
(defmacro ENABLE-QUASI-QUOTED-LIST-SYNTAX ...)

;; macroexpand:
(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-quasi-quoted-list-syntax-in-readtable :start-character #\GRAVE_ACCENT
                                             :end-character nil
                                             :unquote-character #\COMMA
                                             :splice-character #\COMMERCIAL_AT
                                             :destructive-splice-character
                                             #\FULL_STOP
                                             :transformation-pipeline nil
                                             :dispatched-quasi-quote-name nil)
  (values))


[User]
Write a Common Lisp macro to handle this code pattern:
(alet 43 (slet it it))

Problem: Macro call that should be transformed by alet

(alet 43 (slet it it))

[Assistant]
(defmacro alet (form &body body)
  "Binds the FORM to IT (via LET) in the scope of the BODY."
  `(anaphoric ignore-first ,form (progn ,@body)))

;; macroexpand:
(anaphoric ignore-first 43 (progn (slet it it)))


[User]
Generate a defmacro form that transforms code like this:
(*> +opt-fws+ #'ccontent)

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

(*> +opt-fws+ #'ccontent)

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

;; macroexpand:
(lambda (#:*>-offset143) (multiple-value-bind (#:*>-res144 #:*>-next145) (funcall +opt-fws+ #:*>-offset143) (if (ok? #:*>-res144) (funcall (function ccontent) #:*>-next145) (fail #:*>-next145))))


[User]
Write a Common Lisp macro to handle this code pattern:
(enable-version-syntax)

Problem: Macro call that should be transformed by enable-version-syntax

(enable-version-syntax)

[Assistant]
(defmacro enable-version-syntax ()
  "Enable version reader syntax."
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (%enable-version-syntax)))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (%enable-version-syntax))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(when body `(make-block ,body))

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

(when body `(make-block ,body))

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

;; macroexpand:
(if body (sb-int:quasiquote (make-block #S(sb-impl::comma :expr body :kind 0))))


[User]
Generate a defmacro form that transforms code like this:
(skip "Not ready yet" (false T) (is = 5 6))

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

(skip "Not ready yet" (false T) (is = 5 6))

[Assistant]
(defmacro skip (desc &body tests)
  `(with-forced-status (:skipped ,@(if (listp desc) desc (list desc)))
     ,@tests))

;; macroexpand:
(with-forced-status (:skipped "Not ready yet") (false t) (is = 5 6))


[User]
Define a macro that eliminates this repetitive pattern:
;; Manual gensym creation is boilerplate-heavy
(defmacro with-temp (var &body body)
  (let ((g (gensym)))
    `(let ((,g ,var))
       ,@body)))
;; Every macro needs this pattern - repetitive and error-prone

Issue: Repeated gensym boilerplate in macro definitions — want automatic gensym creation from naming convention

;; Manual gensym creation is boilerplate-heavy
(defmacro with-temp (var &body body)
  (let ((g (gensym)))
    `(let ((,g ,var))
       ,@body)))
;; Every macro needs this pattern - repetitive and error-prone

[Assistant]
(defun g!-symbol-p (s)
  (and (symbolp s)
       (> (length (symbol-name s)) 2)
       (string= (symbol-name s)
                "G!"
                :start1 0
                :end1 2)))

(defmacro defmacro/g! (name args &rest body)
  (let ((syms (remove-duplicates
               (remove-if-not #'g!-symbol-p
                              (flatten body)))))
    (multiple-value-bind (body declarations docstring)
        (parse-body body :documentation t)
      `(defmacro ,name ,args
         ,@(when docstring
             (list docstring))
         ,@declarations
         (let ,(mapcar
                (lambda (s)
                  `(,s (gensym ,(subseq
                                 (symbol-name s)
                                 2))))
                syms)
           ,@body)))))

;; macroexpand:
;; Usage:
;; (defmacro/g! with-temp (g!var &body body)
;;   `(let ((,g!var ,g!var))
;;      ,@body))
;;
;; g!var is automatically gensym'd to #:VAR1234 at expansion time
;; No capture risk - gensym is uninterned


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defcategory :warning (or :warning :error))

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

(defcategory :warning (or :warning :error))

[Assistant]
(defmacro defcategory (category &optional expands-as set)
  `(defcategory-fn ',category ',expands-as ,set))

;; macroexpand:
(defcategory-fn (quote :warning) (quote (or :warning :error)) nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(matrix-ctypecase nil)

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

(matrix-ctypecase nil)

[Assistant]
(defmacro MATRIX-CTYPECASE ...)

;; macroexpand:
nil


[User]
You are a Common Lisp macro expert. Given this code pattern:
(do-generator-value-list (vars (apply #'multi-gen generators)) (apply #'yield (mapcar #'car vars)))

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

(do-generator-value-list (vars (apply #'multi-gen generators)) (apply #'yield (mapcar #'car vars)))

[Assistant]
(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))))))

;; macroexpand:
(let ((#:g157 (apply (function multi-gen) generators))) (loop do (if-generator (vars #:g157) (progn (apply (function yield) (mapcar (function car) vars))) (return))))


[User]
Define a macro that eliminates this repetitive pattern:
(with-yield-binds (format nil "~A~:[~; IF NOT EXISTS~] ~A (~%~{ ~A~^,~%~}~%)" (sql-statement-name statement) (create-table-statement-if-not-exists statement) (yield (create-table-statement-table statement)) (mapcar #'yield (sql-composed-statement-children statement))))

Issue: Macro call that should be transformed by with-yield-binds

(with-yield-binds (format nil "~A~:[~; IF NOT EXISTS~] ~A (~%~{ ~A~^,~%~}~%)" (sql-statement-name statement) (create-table-statement-if-not-exists statement) (yield (create-table-statement-table statement)) (mapcar #'yield (sql-composed-statement-children statement))))

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

;; macroexpand:
(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "~A~:[~; IF NOT EXISTS~] ~A (~%~{ ~A~^,~%~}~%)" (sql-statement-name statement) (create-table-statement-if-not-exists statement) (yield (create-table-statement-table statement)) (mapcar (function yield) (sql-composed-statement-children statement)))) (loop for bind in (reverse *bind-values*) append bind)))


[User]
Write a Common Lisp macro to handle this code pattern:
(lambda* 'some-name)

Problem: Macro call that should be transformed by LAMBDA*

(lambda* 'some-name)

[Assistant]
(defmacro LAMBDA* ...)

;; macroexpand:
(lambda (quote some-name) (with-yield))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(-> :tag-1 () ", concurrent")

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

(-> :tag-1 () ", concurrent")

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

;; macroexpand:
(atomically :tag-1 nil ", concurrent")


[User]
Write a Common Lisp macro to handle this code pattern:
(single-line-mode-p flags)

Problem: Macro call that should be transformed by single-line-mode-p

(single-line-mode-p flags)

[Assistant]
(defmacro single-line-mode-p (flags)
  "Accessor macro to extract the third flag out of a three-element flag list."
  `(third ,flags))

;; macroexpand:
(third flags)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(resolving
  nil
  nil)

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

(resolving
  nil
  nil)

[Assistant]
(defmacro RESOLVING ...)

;; macroexpand:
(resolve
  nil
  nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(deferror "23503" foreign-key-violation integrity-violation)

Problem: Macro call that should be transformed by deferror

(deferror "23503" foreign-key-violation integrity-violation)

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

;; macroexpand:
(progn (define-condition foreign-key-violation (integrity-violation) nil) (setf (gethash "23503" *error-table*) (quote foreign-key-violation)))


[User]
Define a macro that eliminates this repetitive pattern:
(do-iterator 'some-name)

Issue: Macro call that should be transformed by DO-ITERATOR

(do-iterator 'some-name)

[Assistant]
(defmacro DO-ITERATOR ...)

;; macroexpand:
(iterate-for-effects some-name (lambda (quote)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-mocks () (answer foo 3 (call-previous)) (is (eql 3 (foo))) (is (eq 'foo (foo))))

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

(with-mocks () (answer foo 3 (call-previous)) (is (eql 3 (foo))) (is (eq 'foo (foo))))

[Assistant]
(defmacro with-mocks ((&key (recordp T)) &body body)
  "Execute BODY in a new mocking context.  Invocations will be recorded
if RECORDP is set (default true)."
  `(call-with-mocks
    (lambda () ,@body)
    :recordp ,recordp))

;; macroexpand:
(call-with-mocks (lambda nil (answer foo 3 (call-previous)) (is (eql 3 (foo))) (is (eq (quote foo) (foo)))) :recordp t)


[User]
Generate a defmacro form that transforms code like this:
(lret* ((y 1) (y 2)) (declare (ignorable y)) 3)

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

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

[Assistant]
(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))

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


[User]
Define a macro that eliminates this repetitive pattern:
(alist-bind (type size) form `((:array ,@(parse-type type (aval :tag type)) ,size)))

Issue: Macro call that should be transformed by alist-bind

(alist-bind (type size) form `((:array ,@(parse-type type (aval :tag type)) ,size)))

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

;; macroexpand:
(let ((#:alist236 form)) (let ((type (aval :type #:alist236)) (size (aval :size #:alist236))) (sb-int:quasiquote ((:array #S(sb-impl::comma :expr (parse-type type (aval :tag type)) :kind 2) #S(sb-impl::comma :expr size :kind 0))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(defgenerator icount (n &optional (step 1)) "Make a generator that returns evenly spaced values starting with n. Step can be fractional. Eg: (counter 10) -> 10 11 12 13 14 ... (counter 2.5 0.5) -> 2.5 3.0 3.5 ..." (unless (numberp n) (error "n must be a number")) (unless (numberp step) (error "step must be a number")) (loop for i from n by step do (yield i)))

Problem: Macro call that should be transformed by defgenerator

(defgenerator icount (n &optional (step 1)) "Make a generator that returns evenly spaced values starting with n. Step can be fractional. Eg: (counter 10) -> 10 11 12 13 14 ... (counter 2.5 0.5) -> 2.5 3.0 3.5 ..." (unless (numberp n) (error "n must be a number")) (unless (numberp step) (error "step must be a number")) (loop for i from n by step do (yield i)))

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

;; macroexpand:
(defun icount (n &optional (step 1)) "Make a generator that returns evenly spaced values starting with n. Step can be fractional. Eg: (counter 10) -> 10 11 12 13 14 ... (counter 2.5 0.5) -> 2.5 3.0 3.5 ..." (with-yield (unless (numberp n) (error "n must be a number")) (unless (numberp step) (error "step must be a number")) (loop for i from n by step do (yield i))))


[User]
Write a Common Lisp macro to handle this code pattern:
(who-ps-html nil nil)

Problem: Macro call that should be transformed by WHO-PS-HTML

(who-ps-html nil nil)

[Assistant]
(defmacro WHO-PS-HTML ...)

;; macroexpand:
(stringify nil nil)


[User]
Generate a defmacro form that transforms code like this:
(do-generator (g generator) (let ((currkey (funcall key g))) (if (funcall comp last currkey) (push g res) (progn (when res (yield last (nreverse res))) (setf last currkey) (setf res (cons g nil))))))

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

(do-generator (g generator) (let ((currkey (funcall key g))) (if (funcall comp last currkey) (push g res) (progn (when res (yield last (nreverse res))) (setf last currkey) (setf res (cons g nil))))))

[Assistant]
(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))))))

;; macroexpand:
(let ((#:g162 generator)) (loop do (if-generator ((g) #:g162) (progn (let ((currkey (funcall key g))) (if (funcall comp last currkey) (push g res) (progn (when res (yield last (nreverse res))) (setf last currkey) (setf res (cons g nil)))))) (return))))


[User]
Generate a defmacro form that transforms code like this:
(draw scene (:path :d (path (move-to 100 400) (line-to-r 50 -25) (arc-to-r 25 25 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 50 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 75 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 100 -30 0 1 50 -25) (line-to-r 50 -25) (vertical-to-r 50))) :fill "none" :stroke "blue" :stroke-width 5)

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

(draw scene (:path :d (path (move-to 100 400) (line-to-r 50 -25) (arc-to-r 25 25 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 50 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 75 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 100 -30 0 1 50 -25) (line-to-r 50 -25) (vertical-to-r 50))) :fill "none" :stroke "blue" :stroke-width 5)

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

;; macroexpand:
(let ((#:g161 (funcall (function make-svg-element) :path (append (list :d (path (move-to 100 400) (line-to-r 50 -25) (arc-to-r 25 25 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 50 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 75 -30 0 1 50 -25) (line-to-r 50 -25) (arc-to-r 25 100 -30 0 1 50 -25) (line-to-r 50 -25) (vertical-to-r 50))) (list :fill "none" :stroke "blue" :stroke-width 5))))) (add-element scene #:g161) #:g161)


[User]
Define a macro that eliminates this repetitive pattern:
(fgatherlet nil
  nil)

Issue: Macro call that should be transformed by FGATHERLET

(fgatherlet nil
  nil)

[Assistant]
(defmacro FGATHERLET ...)

;; macroexpand:
(flet ()
  nil)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(secase (car x) (:y (setf it :no)) (:x (setf it :yes)))

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

(secase (car x) (:y (setf it :no)) (:x (setf it :yes)))

[Assistant]
(defmacro secase (keyform &body cases)
  "Like ECASE, except binds the keyform to IT (via SYMBOL-MACROLET) for the
scope of the cases. IT can be set with SETF."
  `(symbolic ecase ,keyform ,@cases))

;; macroexpand:
(symbolic ecase (car x) (:y (setf it :no)) (:x (setf it :yes)))


[User]
Generate a defmacro form that transforms code like this:
(c? (klin self))

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

(c? (klin self))

[Assistant]
(defmacro c? (&body body)
  `(make-c-dependent
    :code ',body
    :value-state :unevaluated
    :rule (c-lambda ,@body)))

;; macroexpand:
(make-c-dependent :code (quote ((klin self))) :value-state :unevaluated :rule (c-lambda (klin self)))


[User]
Generate a defmacro form that transforms code like this:
(declare-deprecated-operators nil :key nil)

Pattern to recognize: Macro call that should be transformed by DECLARE-DEPRECATED-OPERATORS

(declare-deprecated-operators nil :key nil)

[Assistant]
(defmacro DECLARE-DEPRECATED-OPERATORS ...)

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defaction nil
    :key
  nil)

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

(defaction nil
    :key
  nil)

[Assistant]
(defmacro DEFACTION ...)

;; macroexpand:
(setf (gethash #A((3) base-char . "NIL") cl-rules.core::*actions*)
        (lambda :key nil))


[User]
You are a Common Lisp macro expert. Given this code pattern:
;; Regex matching with captures requires manual multiple-value-bind
(multiple-value-bind (matchp captures)
    (cl-ppcre:scan-to-strings "_(\\w+)@(\\w+)\\.com_" email)
  (if matchp
      (let ((user (aref captures 0))
            (domain (aref captures 1)))
        (format t "~a at ~a~%" user domain))
      :invalid))

;; Verbose: bind result, extract captures by index, branch - repetitive

Write a macro that addresses: Regex matching with named captures requires verbose destructuring — want $1, $2, ... anaphors bound to capture groups

;; Regex matching with captures requires manual multiple-value-bind
(multiple-value-bind (matchp captures)
    (cl-ppcre:scan-to-strings "_(\\w+)@(\\w+)\\.com_" email)
  (if matchp
      (let ((user (aref captures 0))
            (domain (aref captures 1)))
        (format t "~a at ~a~%" user domain))
      :invalid))

;; Verbose: bind result, extract captures by index, branch - repetitive

[Assistant]
#+cl-ppcre
(defun dollar-symbol-p (s)
  (and (symbolp s)
       (> (length (symbol-name s)) 1)
       (string= (symbol-name s)
                "$"
                :start1 0
                :end1 1)
       (ignore-errors (parse-integer (subseq (symbol-name s) 1)))))

(defmacro! if-match ((match-regex str) then &optional else)
  (let* ((dollars (remove-duplicates
                   (remove-if-not #'dollar-symbol-p
                                  (flatten then))))
         (top (or (car (sort (mapcar #'dollar-symbol-p dollars) #'>))
                  0)))
    `(multiple-value-bind (,g!matches ,g!captures) (,match-regex ,str)
       (declare (ignorable ,g!matches ,g!captures))
       (let ((,g!captures-len (length ,g!captures)))
         (declare (ignorable ,g!captures-len))
         (symbol-macrolet ,(mapcar #`(,(symb "$" a1)
                                       (if (< ,g!captures-len ,a1)
                                           (error "Too few matchs: ~a unbound." ,(mkstr "$" a1))
                                           (aref ,g!captures ,(1- a1))))
                                   (loop for i from 1 to top collect i))
           (if ,g!matches
               ,then
               ,else))))))

;; macroexpand:
;; (if-match (#~m_(\\w+)@(\\w+)\\.com_ email)
;;   (format t "~a at ~a~%" $1 $2)
;;   :invalid)
;;
;; $1, $2 bound to capture groups via symbol-macrolet
;; Out-of-bounds $N signals a clear error at runtime
;; Nested if-match works - each has its own capture bindings


[User]
Generate a defmacro form that transforms code like this:
(deferror "08P01" protocol-violation)

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

(deferror "08P01" protocol-violation)

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

;; macroexpand:
(progn (define-condition protocol-violation (database-error) nil) (setf (gethash "08P01" *error-table*) (quote protocol-violation)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(collect-last 'some-name)

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

(collect-last 'some-name)

[Assistant]
(defmacro COLLECT-LAST ...)

;; macroexpand:
(common-lisp:let* ((#:generator-533 (generator 'some-name))
                   #:items-527
                   (#:item-529 nil))
  (declare (type generator #:generator-533)
           (type (null-or t) #:item-529))
  (tagbody
   #:ll-534
    (setq #:items-527 (next-in #:generator-533 (go end)))
    (setq #:item-529 #:items-527)
    (go #:ll-534)
   end)
  #:item-529)


[User]
Generate a defmacro form that transforms code like this:
(define-generic generic (a b &key c) (declare (ignorable a b c)))

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

(define-generic generic (a b &key c) (declare (ignorable a b c)))

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

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

Example:

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

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

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

;; macroexpand:
(prog1 (defgeneric generic (a b &key c) (:method (a b &key c) (declare (ignorable a b c)))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(lexpr-$send nil (progn))

Write a macro that addresses: Macro call that should be transformed by LEXPR-$SEND

(lexpr-$send nil (progn))

[Assistant]
(defmacro LEXPR-$SEND ...)

;; macroexpand:
(apply #'send-message nil (progn))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(cond-<>>
  nil
  (progn))

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

(cond-<>>
  nil
  (progn))

[Assistant]
(defmacro COND-<>> ...)

;; macroexpand:
(let* ((#:var157 nil)
       (#:var158
        (if progn
            (-<>>
              #:var157)
            #:var157)))
  #:var158)


[User]
Generate a defmacro form that transforms code like this:
(set-bop nil :key nil)

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

(set-bop nil :key nil)

[Assistant]
(defmacro SET-BOP ...)

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


[User]
Generate a defmacro form that transforms code like this:
(define-modf-rewrite caar (expr) `(car (car ,(second expr))))

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

(define-modf-rewrite caar (expr) `(car (car ,(second expr))))

[Assistant]
(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))))

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


[User]
Write a Common Lisp macro to handle this code pattern:
(c?-with-stored (v :bar store 'nothing) (bwhen (val (value v)) (1- val)))

Problem: Macro call that should be transformed by c?-with-stored

(c?-with-stored (v :bar store 'nothing) (bwhen (val (value v)) (1- val)))

[Assistant]
(defmacro c?-with-stored ((var key store &optional default) &body body)
  `(c? (bwhen-c-stored (,var ,key ,store ,default)
	 ,@body)))

;; macroexpand:
(c? (bwhen-c-stored (v :bar store (quote nothing)) (bwhen (val (value v)) (1- val))))


[User]
Define a macro that eliminates this repetitive pattern:
(with-hamt set (:test test :hash hash :table table) (flet ((%remove (table x) (%hamt-remove table x (funcall hash x) 0 test))) (make-instance 'hash-set :test test :hash hash :table (reduce #'%remove xs :initial-value table))))

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

(with-hamt set (:test test :hash hash :table table) (flet ((%remove (table x) (%hamt-remove table x (funcall hash x) 0 test))) (make-instance 'hash-set :test test :hash hash :table (reduce #'%remove xs :initial-value table))))

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

;; macroexpand:
(with-accessors ((test hamt-test) (hash hamt-hash) (table hamt-table)) set (flet ((%remove (table x) (%hamt-remove table x (funcall hash x) 0 test))) (make-instance (quote hash-set) :test test :hash hash :table (reduce (function %remove) xs :initial-value table))))


[User]
Generate a defmacro form that transforms code like this:
(define-generic generic ((a a) (b b) &key (c nil)) (+ a b))

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

(define-generic generic ((a a) (b b) &key (c nil)) (+ a b))

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

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

Example:

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

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

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

;; macroexpand:
(prog1 (defgeneric generic (a b &key c) (:method ((a a) (b b) &key (c nil)) (+ a b))))


[User]
Write a Common Lisp macro to handle this code pattern:
(fmap #'1+ (ok (in "") 1))

Problem: Macro call that should be transformed by fmap

(fmap #'1+ (ok (in "") 1))

[Assistant]
(defmacro fmap (f thing)
  "Apply a pure function to the inner contents of some parsing operation, if the
parsing itself was successful."
  `(multiple-value-bind (res next) ,thing
     (if (failure? res)
         (fail next)
         (values (funcall ,f res) next))))

;; macroexpand:
(multiple-value-bind (res next) (ok (in "") 1) (if (failure? res) (fail next) (values (funcall (function 1+) res) next)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(dict-of nil :key nil)

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

(dict-of nil :key nil)

[Assistant]
(defmacro DICT-OF ...)

;; macroexpand:
(let ((#:dict131 (make-hash-table :test 'equal)))
  (do-for (:key nil)
    (multiple-value-call
        (lambda (#:k132 #:v133) (setf (gethash #:k132 #:dict131) #:v133))
      nil))
  #:dict131)


[User]
Write a Common Lisp macro to handle this code pattern:
(define-op (:not-in infix-list-op))

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

(define-op (:not-in infix-list-op))

[Assistant]
(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)))

;; macroexpand:
(defstruct (not-in-op (:include infix-list-op (name "NOT IN")) (:constructor make-not-in-op (left right))))