[User]
Define a macro that eliminates this repetitive pattern:
(with-shadowed-custom-vars (let ((*json-identifier-name-to-lisp* #'simplified-camel-case-to-lisp)) (dotimes (x count) (let ((discard-soon (with-fp-overflow-handler (invoke-restart 'placeholder :infty) (with-no-char-handler (invoke-restart 'substitute-char #\?) (decode-json-from-string json-string))))) (funcall #'identity discard-soon)))))

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

(with-shadowed-custom-vars (let ((*json-identifier-name-to-lisp* #'simplified-camel-case-to-lisp)) (dotimes (x count) (let ((discard-soon (with-fp-overflow-handler (invoke-restart 'placeholder :infty) (with-no-char-handler (invoke-restart 'substitute-char #\?) (decode-json-from-string json-string))))) (funcall #'identity discard-soon)))))

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

;; macroexpand:
(let ((*aggregate-scope-variables* (if (boundp (quote *aggregate-scope-variables*)) *aggregate-scope-variables*)) (*string-scope-variables* (if (boundp (quote *string-scope-variables*)) *string-scope-variables*)) (*array-scope-variables* (if (boundp (quote *array-scope-variables*)) *array-scope-variables*)) (*object-scope-variables* (if (boundp (quote *object-scope-variables*)) *object-scope-variables*)) (*internal-decoder* (if (boundp (quote *internal-decoder*)) *internal-decoder*)) (*end-of-object-handler* (if (boundp (quote *end-of-object-handler*)) *end-of-object-handler*)) (*object-value-handler* (if (boundp (quote *object-value-handler*)) *object-value-handler*)) (*object-key-handler* (if (boundp (quote *object-key-handler*)) *object-key-handler*)) (*beginning-of-object-handler* (if (boundp (quote *beginning-of-object-handler*)) *beginning-of-object-handler*)) (*json-array-type* (if (boundp (quote *json-array-type*)) *json-array-type*)) (*end-of-array-handler* (if (boundp (quote *end-of-array-handler*)) *end-of-array-handler*)) (*array-member-handler* (if (boundp (quote *array-member-handler*)) *array-member-handler*)) (*beginning-of-array-handler* (if (boundp (quote *beginning-of-array-handler*)) *beginning-of-array-handler*)) (*end-of-string-handler* (if (boundp (quote *end-of-string-handler*)) *end-of-string-handler*)) (*string-char-handler* (if (boundp (quote *string-char-handler*)) *string-char-handler*)) (*beginning-of-string-handler* (if (boundp (quote *beginning-of-string-handler*)) *beginning-of-string-handler*)) (*boolean-handler* (if (boundp (quote *boolean-handler*)) *boolean-handler*)) (*real-handler* (if (boundp (quote *real-handler*)) *real-handler*)) (*integer-handler* (if (boundp (quote *integer-handler*)) *integer-handler*))) (let ((*json-identifier-name-to-lisp* (function simplified-camel-case-to-lisp))) (dotimes (x count) (let ((discard-soon (with-fp-overflow-handler (invoke-restart (quote placeholder) :infty) (with-no-char-handler (invoke-restart (quote substitute-char) #\QUESTION_MARK) (decode-json-from-string json-string))))) (funcall (function identity) discard-soon)))))


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

What needs to change: Macro call that should be transformed by WHO-PS-HTML

(who-ps-html 'some-name)

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

;; macroexpand:
(stringify "someName")


[User]
Define a macro that eliminates this repetitive pattern:
(deferror "42P03" duplicate-cursor syntax-error-or-access-violation)

Issue: Macro call that should be transformed by deferror

(deferror "42P03" duplicate-cursor syntax-error-or-access-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 duplicate-cursor (syntax-error-or-access-violation) nil) (setf (gethash "42P03" *error-table*) (quote duplicate-cursor)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(mvlet* ((simple decls (partn simple decls)) (complex decls (partn complex decls)) (lambda decls (partn lambda decls))) (values simple complex lambda decls))

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

(mvlet* ((simple decls (partn simple decls)) (complex decls (partn complex decls)) (lambda decls (partn lambda decls))) (values simple complex lambda decls))

[Assistant]
(defmacro mvlet* ((&rest bindings) &body body &environment env)
  "Expand a series of nested `multiple-value-bind' forms.

`mvlet*' is similar in intent to Scheme’s `let-values', but with a
different and less parenthesis-intensive syntax. Each binding is a
list of

    (var var*... expr)

A simple example should suffice to show both the implementation and
the motivation:

    (defun uptime (seconds)
      (mvlet* ((minutes seconds (truncate seconds 60))
               (hours minutes (truncate minutes 60))
               (days hours (truncate hours 24)))
        (declare ((integer 0 *) days hours minutes seconds))
        (fmt \"~d day~:p, ~d hour~:p, ~d minute~:p, ~d second~:p\"
             days hours minutes seconds)))

Note that declarations work just like `let*'."
  (cond ((null bindings)
         `(locally ,@body))
        ((every #'simple-binding-p bindings)
         `(let* ,bindings ,@body))
        (t (multiple-value-bind (body decls)
               (parse-body body)
             (let* ((bindings (canonicalize-bindings bindings))
                    (mvbinds (member-if-not #'simple-binding-p bindings))
                    (simple-binds (ldiff bindings mvbinds)))
               (if simple-binds
                   (multiple-value-bind (local other)
                       (partition-declarations (mapcar #'car simple-binds) decls env)
                     `(let* ,simple-binds
                        ,@local
                        (mvlet* ,mvbinds
                          ,@other
                          ,@body)))
                   (let* ((vars (butlast (car bindings)))
                          (expr (lastcar (car bindings))))
                     (multiple-value-bind (local other)
                         (partition-declarations vars decls env)
                       `(multiple-value-bind ,vars
                            ,expr
                          ,@local
                          (mvlet* ,(cdr bindings)
                            ,@other
                            ,@body))))))))))

;; macroexpand:
(multiple-value-bind (simple decls) (partn simple decls) (mvlet* ((complex decls (partn complex decls)) (lambda decls (partn lambda decls))) (values simple complex lambda decls)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-yield-binds (format nil "ON CONFLICT ~:[~;ON CONSTRAINT ~]~A DO UPDATE ~A~@[ ~A~]" (eq (type-of (on-conflict-do-update-clause-conflict-target clause)) 'sql-symbol) (yield (on-conflict-do-update-clause-conflict-target clause)) (yield (on-conflict-do-update-clause-update-set clause)) (and (on-conflict-do-update-clause-where-condition clause) (yield (on-conflict-do-update-clause-where-condition clause)))))

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

(with-yield-binds (format nil "ON CONFLICT ~:[~;ON CONSTRAINT ~]~A DO UPDATE ~A~@[ ~A~]" (eq (type-of (on-conflict-do-update-clause-conflict-target clause)) 'sql-symbol) (yield (on-conflict-do-update-clause-conflict-target clause)) (yield (on-conflict-do-update-clause-update-set clause)) (and (on-conflict-do-update-clause-where-condition clause) (yield (on-conflict-do-update-clause-where-condition clause)))))

[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 "ON CONFLICT ~:[~;ON CONSTRAINT ~]~A DO UPDATE ~A~@[ ~A~]" (eq (type-of (on-conflict-do-update-clause-conflict-target clause)) (quote sql-symbol)) (yield (on-conflict-do-update-clause-conflict-target clause)) (yield (on-conflict-do-update-clause-update-set clause)) (and (on-conflict-do-update-clause-where-condition clause) (yield (on-conflict-do-update-clause-where-condition clause))))) (loop for bind in (reverse *bind-values*) append bind)))


[User]
Define a macro that eliminates this repetitive pattern:
(->*)

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

(->*)

[Assistant]
(defmacro ->* ...)

;; macroexpand:
nil


[User]
Write a Common Lisp macro to handle this code pattern:
(dynenv-macrolet nil
  nil)

Problem: Macro call that should be transformed by DYNENV-MACROLET

(dynenv-macrolet nil
  nil)

[Assistant]
(defmacro DYNENV-MACROLET ...)

;; macroexpand:
(macrolet ()
  nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(jbind string "hello" string)

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

(jbind string "hello" string)

[Assistant]
(defmacro jbind (destructuring-pattern form &body body)
  "Match the FORM against DESTRUCTURING-PATTERN.
The pattern might be:
- A symbol, in which case the current chosen form is bound to it. If
  the symbol is _, simply skip the form.
- A literal form:
  - String or number: compare with `equal'.
  - Keywords :TRUE, :FALSE, and :NULL, matching T, NIL, and :NULL
    respectively.
- If the pattern is a property list of string+pattern pairs, match the
  string+pattern pairs inside it to the provided JSON object and
  resolve them recursively.
- If the pattern is a list of symbols (VAR &optional VAR-P), these are
  bound to the respective values of `jget'. It is a good way to make
  `jbind' to be more lenient to missing keys, because the default
  behavior is to error on missing data.
- If the pattern is an inline vector, match it against a JSON array
  with at least as many elements as provided in the vector. Match
  every form in the vector against the element with the same index.

If the DESTRUCTURING-PATTERN doesn't match the object, throw
`value-mismatch'.

Underlying `jget' can throw errors for the exceptionally malformed
inputs. See `jget' documentation for the types of errors it throws.

Example:
\(\"hello\" hello \"a\" _ \"b\" b
 \"array\" #(first second third _))

matches a JSON object
{\"hello\": 3, \"a\": 8, \"b\": 3, \"c\": null, \"array\": [1, 2, 3, 4]}

and binds
- HELLO to 3
- B to 3
- FIRST to 1
- SECOND to 2
- THIRD to 3

It also checks that \"a\" key is present in the object and there's a
fourth element in the nested array.

See more examples in njson tests."
  (let ((form-sym (gensym "BIND-FORM"))
        (bindings (list)))
    (labels ((parse-pattern (pattern &optional (current-path (list)))
               (etypecase pattern
                 ((or (member :true :false :null) string real)
                  (push (cons pattern (copy-list current-path))
                        bindings))
                 ((cons symbol *)
                  (push (cons pattern (copy-list current-path))
                        bindings))
                 (list
                  (loop for (key subpattern) on pattern by #'cddr
                        do (parse-pattern subpattern (append current-path (list key))))
                  (push (cons nil (copy-list current-path))
                        bindings))
                 ((and symbol (not keyword))
                  (push (cons (if (equal "_" (symbol-name pattern))
                                  (gensym "_PATTERN")
                                  pattern)
                              (copy-list current-path))
                        bindings))
                 (array
		  (loop for elem across pattern
                        for index from 0
                        do (parse-pattern elem (append current-path (list index))))
		  (push (cons #() (copy-list current-path))
			bindings)))))
      (check-type destructuring-pattern (or list (and array (not string))
                                            (and symbol (not keyword)))
                  "proper jbind destructuring pattern: list, array, or symbol")
      (parse-pattern destructuring-pattern)
      (let ((let-forms (loop for (binding . key) in bindings
                             do (check-type binding (or array real symbol
                                                        ;; For (VAR VAR-P) forms
                                                        (cons symbol (or (cons symbol null)
                                                                         null))))
                             if (typep binding '(or array real null
                                                 (member :true :false :null)))
                               collect `(,(gensym) (check-value ,binding (vector ,@key) ,form-sym))
                             else if (and (symbolp binding)
                                          (uiop:emptyp key))
                                    collect `(,binding ,form-sym)
                             else if (listp binding)
                                    append (destructuring-bind (var &optional (var-p nil var-p-provided))
                                               binding
                                             (append
                                              `((,var (jget (vector ,@key) ,form-sym)))
                                              (when var-p-provided
                                                `((,var-p (nth-value 1 (jget (vector ,@key) ,form-sym)))))))
                             else
                               collect `(,binding (check-value t (vector ,@key) ,form-sym)))))
        `(let* ((,form-sym ,form)
                ,@let-forms)
           (declare (ignorable ,form-sym ,@(mapcar #'first let-forms)))
           ,@body))))

;; macroexpand:
(let* ((#:bind-form127 "hello") (string #:bind-form127)) (declare (ignorable #:bind-form127 string)) string)


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

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

(jbind false nil nil)

[Assistant]
(defmacro jbind (destructuring-pattern form &body body)
  "Match the FORM against DESTRUCTURING-PATTERN.
The pattern might be:
- A symbol, in which case the current chosen form is bound to it. If
  the symbol is _, simply skip the form.
- A literal form:
  - String or number: compare with `equal'.
  - Keywords :TRUE, :FALSE, and :NULL, matching T, NIL, and :NULL
    respectively.
- If the pattern is a property list of string+pattern pairs, match the
  string+pattern pairs inside it to the provided JSON object and
  resolve them recursively.
- If the pattern is a list of symbols (VAR &optional VAR-P), these are
  bound to the respective values of `jget'. It is a good way to make
  `jbind' to be more lenient to missing keys, because the default
  behavior is to error on missing data.
- If the pattern is an inline vector, match it against a JSON array
  with at least as many elements as provided in the vector. Match
  every form in the vector against the element with the same index.

If the DESTRUCTURING-PATTERN doesn't match the object, throw
`value-mismatch'.

Underlying `jget' can throw errors for the exceptionally malformed
inputs. See `jget' documentation for the types of errors it throws.

Example:
\(\"hello\" hello \"a\" _ \"b\" b
 \"array\" #(first second third _))

matches a JSON object
{\"hello\": 3, \"a\": 8, \"b\": 3, \"c\": null, \"array\": [1, 2, 3, 4]}

and binds
- HELLO to 3
- B to 3
- FIRST to 1
- SECOND to 2
- THIRD to 3

It also checks that \"a\" key is present in the object and there's a
fourth element in the nested array.

See more examples in njson tests."
  (let ((form-sym (gensym "BIND-FORM"))
        (bindings (list)))
    (labels ((parse-pattern (pattern &optional (current-path (list)))
               (etypecase pattern
                 ((or (member :true :false :null) string real)
                  (push (cons pattern (copy-list current-path))
                        bindings))
                 ((cons symbol *)
                  (push (cons pattern (copy-list current-path))
                        bindings))
                 (list
                  (loop for (key subpattern) on pattern by #'cddr
                        do (parse-pattern subpattern (append current-path (list key))))
                  (push (cons nil (copy-list current-path))
                        bindings))
                 ((and symbol (not keyword))
                  (push (cons (if (equal "_" (symbol-name pattern))
                                  (gensym "_PATTERN")
                                  pattern)
                              (copy-list current-path))
                        bindings))
                 (array
		  (loop for elem across pattern
                        for index from 0
                        do (parse-pattern elem (append current-path (list index))))
		  (push (cons #() (copy-list current-path))
			bindings)))))
      (check-type destructuring-pattern (or list (and array (not string))
                                            (and symbol (not keyword)))
                  "proper jbind destructuring pattern: list, array, or symbol")
      (parse-pattern destructuring-pattern)
      (let ((let-forms (loop for (binding . key) in bindings
                             do (check-type binding (or array real symbol
                                                        ;; For (VAR VAR-P) forms
                                                        (cons symbol (or (cons symbol null)
                                                                         null))))
                             if (typep binding '(or array real null
                                                 (member :true :false :null)))
                               collect `(,(gensym) (check-value ,binding (vector ,@key) ,form-sym))
                             else if (and (symbolp binding)
                                          (uiop:emptyp key))
                                    collect `(,binding ,form-sym)
                             else if (listp binding)
                                    append (destructuring-bind (var &optional (var-p nil var-p-provided))
                                               binding
                                             (append
                                              `((,var (jget (vector ,@key) ,form-sym)))
                                              (when var-p-provided
                                                `((,var-p (nth-value 1 (jget (vector ,@key) ,form-sym)))))))
                             else
                               collect `(,binding (check-value t (vector ,@key) ,form-sym)))))
        `(let* ((,form-sym ,form)
                ,@let-forms)
           (declare (ignorable ,form-sym ,@(mapcar #'first let-forms)))
           ,@body))))

;; macroexpand:
(let* ((#:bind-form126 nil) (false #:bind-form126)) (declare (ignorable #:bind-form126 false)) nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-error out-var-name-taken () (out-var-name) "The variable name '~a' is already taken and so cannot be used~%for an out variable" out-var-name)

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

(define-error out-var-name-taken () (out-var-name) "The variable name '~a' is already taken and so cannot be used~%for an out variable" out-var-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 out-var-name-taken (:error-type varjo-error :prefix "Varjo") (out-var-name) "The variable name '~a' is already taken and so cannot be used~%for an out variable" out-var-name)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-print-object/std foo2)

What needs to change: Macro call that should be transformed by define-print-object/std

(define-print-object/std foo2)

[Assistant]
(defmacro define-print-object/std (class)
  "Define a print-object method for objects of class CLASS.

  Print all slots with their values. Prints \"UNBOUND\", as a string, when slots are unbound.

  Usage:

  (defclass/std test () ((a b)))

  (print-object/std test)

  The macro expands to:

  (DEFMETHOD PRINT-OBJECT ((OBJ TEST) STREAM)
    (PRINT-UNREADABLE-OBJECT (OBJ STREAM :TYPE T :IDENTITY T)
        (FORMAT STREAM \"~{~a~^ ~}\" (COLLECT-OBJECT-SLOTS OBJ))))
"
  `(defmethod print-object ((obj ,class) stream)
     (print-unreadable-object (obj stream :type t :identity t)
       (format stream "~{~a~^ ~}"
               (collect-object-slots obj)))))

;; macroexpand:
(defmethod print-object ((obj foo2) stream) (print-unreadable-object (obj stream :type t :identity t) (format stream "~{~a~^ ~}" (collect-object-slots obj))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-value-symbol-macro-binding updating ((var (current iterator)) iterable &rest iterator-args &aux (iterator (apply #'make-iterator iterable iterator-args))) `(if (has-more ,iterator) (next ,iterator) (end-for)))

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

(define-value-symbol-macro-binding updating ((var (current iterator)) iterable &rest iterator-args &aux (iterator (apply #'make-iterator iterable iterator-args))) `(if (has-more ,iterator) (next ,iterator) (end-for)))

[Assistant]
(defmacro define-value-symbol-macro-binding (name (var &rest args) &body body)
  (let ((vars (lambda-fiddle:extract-lambda-vars (lambda-fiddle:remove-aux-part args))))
    (emit-binding-definition name var args body :extra-vars vars :symbol-macro-p T)))

;; macroexpand:
(define-direct-binding updating (var iterable &rest iterator-args) (let ((#:iterator182 (gensym #A((8) base-char . "ITERATOR"))) (#:iterable180 (gensym #A((8) base-char . "ITERABLE"))) (#:iterator-args181 (gensym #A((13) base-char . "ITERATOR-ARGS")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:iterable180 iterable) (list #:iterator-args181 (list* (quote list) iterator-args)) (list #:iterator182 (list (quote apply) (list (quote function) (quote make-iterator)) #:iterable180 #:iterator-args181)) nil) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:iterator182 :kind 0) #S(sb-impl::comma :expr #:iterable180 :kind 0) #S(sb-impl::comma :expr #:iterator-args181 :kind 0)))) #S(sb-impl::comma :expr (sb-int:quasiquote (symbol-macrolet #S(sb-impl::comma :expr (loop for #:var179 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var179 (list (quote current) #:iterator182))) :kind 0))) :kind 0))) (let ((iterator #:iterator182) (iterable #:iterable180) (iterator-args #:iterator-args181)) (declare (ignorable iterator iterable iterator-args)) (sb-int:quasiquote (if (has-more #S(sb-impl::comma :expr iterator :kind 0)) (next #S(sb-impl::comma :expr iterator :kind 0)) (end-for)))))))


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

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

(with-collectors nil
  (progn))

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

;; macroexpand:
(progn (progn))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-flow-let-macro (flow-list flow) (flow-lambda-macro (flow-context) `(flet ((,test-fu () ,live-test-form)) (dispatch-repeatedly ,flow-context #',test-fu ,flow-list))))

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

(with-flow-let-macro (flow-list flow) (flow-lambda-macro (flow-context) `(flet ((,test-fu () ,live-test-form)) (dispatch-repeatedly ,flow-context #',test-fu ,flow-list))))

[Assistant]
(defmacro with-flow-let-macro ((var flow) &body body)
  `(with-gensyms (,var)
     `(let ((,,var (list ,@,flow)))
        ,,@body)))

;; macroexpand:
(with-gensyms (flow-list) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr flow-list :kind 0) (list #S(sb-impl::comma :expr flow :kind 2)))) #S(sb-impl::comma :expr (flow-lambda-macro (flow-context) (sb-int:quasiquote (flet ((#S(sb-impl::comma :expr test-fu :kind 0) nil #S(sb-impl::comma :expr live-test-form :kind 0))) (dispatch-repeatedly #S(sb-impl::comma :expr flow-context :kind 0) (function #S(sb-impl::comma :expr test-fu :kind 0)) #S(sb-impl::comma :expr flow-list :kind 0))))) :kind 0))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(accase (car x) (:x (setf it :foo)))

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

(accase (car x) (:x (setf it :foo)))

[Assistant]
(defmacro accase (keyform &body cases)
  "Like CCASE, except binds the result of the keyform to IT (via LET) for the
scope of the cases. Unlike CCASE, the keyform/place doesn't receive new values
possibly stored with STORE-VALUE restart; the new value is received by IT."
  `(anaphoric ccase ,keyform ,@cases))

;; macroexpand:
(anaphoric ccase (car x) (:x (setf it :foo)))


[User]
Generate a defmacro form that transforms code like this:
(with-color (:red :stream stream) (with-additional-indent (reporter stream "× ") (when (slot-value report 'description) (format/indent reporter stream "~A~%" (slot-value report 'description))) (format/indent reporter stream "Raised an error ~A (expected: ~S)" (slot-value report 'got) (slot-value report 'expected))))

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

(with-color (:red :stream stream) (with-additional-indent (reporter stream "× ") (when (slot-value report 'description) (format/indent reporter stream "~A~%" (slot-value report 'description))) (format/indent reporter stream "Raised an error ~A (expected: ~S)" (slot-value report 'got) (slot-value report 'expected))))

[Assistant]
(defmacro with-color ((color &rest args) &body body)
  (cond
    ((or (eq color :gray)
         (eq color :grey))
     `(if *enable-colors*
          (with-gray ,(or (getf args :stream) t) ,@body)
          (progn ,@body)))
    (T `(if *enable-colors*
            (if (or (eq ,color :gray)
                    (eq ,color :grey)
                    (eq ,color cl-colors:+gray+)
                    (eq ,color cl-colors:+grey+))
                (with-gray ,(or (getf args :stream) t) ,@body)
                (cl-ansi-text:with-color (,color ,@args) ,@body))
            (progn ,@body)))))

;; macroexpand:
(if *enable-colors* (if (or (eq :red :gray) (eq :red :grey) (eq :red +gray+) (eq :red +grey+)) (with-gray stream (with-additional-indent (reporter stream "× ") (when (slot-value report (quote description)) (format/indent reporter stream "~A~%" (slot-value report (quote description)))) (format/indent reporter stream "Raised an error ~A (expected: ~S)" (slot-value report (quote got)) (slot-value report (quote expected))))) (cl-ansi-text:with-color (:red :stream stream) (with-additional-indent (reporter stream "× ") (when (slot-value report (quote description)) (format/indent reporter stream "~A~%" (slot-value report (quote description)))) (format/indent reporter stream "Raised an error ~A (expected: ~S)" (slot-value report (quote got)) (slot-value report (quote expected)))))) (progn (with-additional-indent (reporter stream "× ") (when (slot-value report (quote description)) (format/indent reporter stream "~A~%" (slot-value report (quote description)))) (format/indent reporter stream "Raised an error ~A (expected: ~S)" (slot-value report (quote got)) (slot-value report (quote expected))))))


[User]
Define a macro that eliminates this repetitive pattern:
(all-of nil
  nil)

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

(all-of nil
  nil)

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

;; macroexpand:
(lc (nil nil) always)


[User]
Generate a defmacro form that transforms code like this:
(*> #'any #'any #'eof)

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

(*> #'any #'any #'eof)

[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 (#:*>-offset164) (multiple-value-bind (#:*>-res167 #:*>-next168) (multiple-value-bind (#:*>-res165 #:*>-next166) (funcall (function any) #:*>-offset164) (if (ok? #:*>-res165) (funcall (function any) #:*>-next166) (fail #:*>-next166))) (if (ok? #:*>-res167) (funcall (function eof) #:*>-next168) (fail #:*>-next168))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(unwind-protect-case () (return-from foof 42) (:normal (push :normal result3)) (:abort (push :abort result3)) (:always (push :always result3)))

Write a macro that addresses: Macro call that should be transformed by unwind-protect-case

(unwind-protect-case () (return-from foof 42) (:normal (push :normal result3)) (:abort (push :abort result3)) (:always (push :always result3)))

[Assistant]
(defmacro unwind-protect-case ((&optional abort-flag) protected-form &body clauses)
  "Like CL:UNWIND-PROTECT, but you can specify the circumstances that
the cleanup CLAUSES are run.

  clauses ::= (:NORMAL form*)* | (:ABORT form*)* | (:ALWAYS form*)*

Clauses can be given in any order, and more than one clause can be
given for each circumstance. The clauses whose denoted circumstance
occured, are executed in the order the clauses appear.

ABORT-FLAG is the name of a variable that will be bound to T in
CLAUSES if the PROTECTED-FORM aborted preemptively, and to NIL
otherwise.

Examples:

  (unwind-protect-case ()
       (protected-form)
     (:normal (format t \"This is only evaluated if PROTECTED-FORM executed normally.~%\"))
     (:abort  (format t \"This is only evaluated if PROTECTED-FORM aborted preemptively.~%\"))
     (:always (format t \"This is evaluated in either case.~%\")))

  (unwind-protect-case (aborted-p)
       (protected-form)
     (:always (perform-cleanup-if aborted-p)))
"
  (check-type abort-flag (or null symbol))
  (let ((gflag (gensym "FLAG+")))
    `(let ((,gflag t))
       (unwind-protect (multiple-value-prog1 ,protected-form (setf ,gflag nil))
	 (let ,(and abort-flag `((,abort-flag ,gflag)))
	   ,@(loop for (cleanup-kind . forms) in clauses
		   collect (ecase cleanup-kind
			     (:normal `(when (not ,gflag) ,@forms))
			     (:abort  `(when ,gflag ,@forms))
			     (:always `(progn ,@forms)))))))))

;; macroexpand:
(let ((#:flag+126 t)) (unwind-protect (multiple-value-prog1 (return-from foof 42) (setf #:flag+126 nil)) (let nil (when (not #:flag+126) (push :normal result3)) (when #:flag+126 (push :abort result3)) (progn (push :always result3)))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(check-cursor-attached cluffer:cursor-position (cursor))

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

(check-cursor-attached cluffer:cursor-position (cursor))

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

;; macroexpand:
(defmethod cluffer:cursor-position :before ((cursor cluffer:cursor)) (declare (ignore)) (unless (cluffer:cursor-attached-p cursor) (error (quote cluffer:cursor-detached))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(builder (:mount "/mount1" (lambda (env) (is-path-info env "/" "string=.") response)) (:mount "/mount2" (lambda (env) (is-path-info env "/test" "subseq.") response)) (lambda (env) (is-path-info env "/test" "t.") response))

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

(builder (:mount "/mount1" (lambda (env) (is-path-info env "/" "string=.") response)) (:mount "/mount2" (lambda (env) (is-path-info env "/test" "subseq.") response)) (lambda (env) (is-path-info env "/test" "t.") response))

[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 (lambda (#:app212) (funcall (find-middleware :mount) #:app212 "/mount1" (lambda (env) (is-path-info env "/" "string=.") response))) (lambda (#:app214) (funcall (find-middleware :mount) #:app214 "/mount2" (lambda (env) (is-path-info env "/test" "subseq.") response))))) :initial-value (to-app (lambda (env) (is-path-info env "/test" "t.") response)) :from-end t)


[User]
Write a Common Lisp macro to handle this code pattern:
(setdocs (type unknown-arguments "Used to represent an unknown list of arguments. Instances of this class are printed as #<Unknown Arguments>") (type unavailable-argument "Used to represent an argument that isn't available in the environment. Instances of this class are printed as #<Unavailable>"))

Problem: Macro call that should be transformed by setdocs

(setdocs (type unknown-arguments "Used to represent an unknown list of arguments. Instances of this class are printed as #<Unknown Arguments>") (type unavailable-argument "Used to represent an argument that isn't available in the environment. Instances of this class are printed as #<Unavailable>"))

[Assistant]
(defmacro setdocs (&body pairs)
  `(progn
     ,@(loop for (type var doc) in pairs
             collect `(setf (documentation ',var ',type) ,doc))))

;; macroexpand:
(progn (setf (documentation (quote unknown-arguments) (quote type)) "Used to represent an unknown list of arguments. Instances of this class are printed as #<Unknown Arguments>") (setf (documentation (quote unavailable-argument) (quote type)) "Used to represent an argument that isn't available in the environment. Instances of this class are printed as #<Unavailable>"))


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

Issue: Macro call that should be transformed by DEFVAR

(defvar nil)

[Assistant]
(defmacro DEFVAR ...)

;; macroexpand:
(progn
 (eval-when (:compile-toplevel) (sb-impl::%compiler-defvar 'nil))
 (sb-impl::%defvar 'nil (sb-c:source-location)))


[User]
Write a Common Lisp macro to handle this code pattern:
(as-> nil nil)

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

(as-> nil nil)

[Assistant]
(defmacro AS-> ...)

;; macroexpand:
(let* ((nil nil))
  nil)


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

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

(integer-writer 8)

[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-int8 write-uint8)) (defun write-uint8 (socket value) (declare (type stream socket) (type (unsigned-byte 64) value) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (write-byte (ldb (byte 8 56) value) socket) (write-byte (ldb (byte 8 48) value) socket) (write-byte (ldb (byte 8 40) value) socket) (write-byte (ldb (byte 8 32) value) socket) (write-byte (ldb (byte 8 24) value) socket) (write-byte (ldb (byte 8 16) value) socket) (write-byte (ldb (byte 8 8) value) socket) (write-byte (ldb (byte 8 0) value) socket) (values)) (defun write-int8 (socket value) (declare (type stream socket) (type (signed-byte 64) value) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (write-byte (ldb (byte 8 56) value) socket) (write-byte (ldb (byte 8 48) value) socket) (write-byte (ldb (byte 8 40) value) socket) (write-byte (ldb (byte 8 32) value) socket) (write-byte (ldb (byte 8 24) value) socket) (write-byte (ldb (byte 8 16) value) socket) (write-byte (ldb (byte 8 8) value) socket) (write-byte (ldb (byte 8 0) value) socket) (values)))


[User]
Define a macro that eliminates this repetitive pattern:
(-> :g (b) (+ b 7))

Issue: Macro call that should be transformed by ->

(-> :g (b) (+ b 7))

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

;; macroexpand:
(atomically :g (b) (+ b 7))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(draw canvas (:ellipse :cx x :cy y :rx rx :ry ry) :stroke-opacity (* 0.8 (/ n length)))

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

(draw canvas (:ellipse :cx x :cy y :rx rx :ry ry) :stroke-opacity (* 0.8 (/ n length)))

[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 ((#:g163 (funcall (function make-svg-element) :ellipse (append (list :cx x :cy y :rx rx :ry ry) (list :stroke-opacity (* 0.8 (/ n length))))))) (add-element canvas #:g163) #:g163)


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

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

(loop-on-custom (key var value) customizations append (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 append (list var value))


[User]
Generate a defmacro form that transforms code like this:
(enable-quasi-quoted-binary-to-binary-emitting-form-syntax 'some-name)

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

(enable-quasi-quoted-binary-to-binary-emitting-form-syntax 'some-name)

[Assistant]
(defmacro ENABLE-QUASI-QUOTED-BINARY-TO-BINARY-EMITTING-FORM-SYNTAX ...)

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


[User]
Define a macro that eliminates this repetitive pattern:
(define-compile-struct sql-clause)

Issue: Macro call that should be transformed by define-compile-struct

(define-compile-struct sql-clause)

[Assistant]
(defmacro define-compile-struct (structure-name &rest defstruct-options)
  (flet ((symbolcat (&rest symbols)
           (intern (format nil "~{~A~^-~}" symbols) #.*package*)))
    (let ((compiled-name (symbolcat structure-name :compiled)))
      `(progn
         (defstruct (,compiled-name (:include ,structure-name ,@defstruct-options))
           (sql nil :type string)
           (bind nil :type list))

         (defmethod find-compile-function ((object ,structure-name))
           (function ,(symbolcat :make compiled-name)))

         (defmethod print-object ((object ,compiled-name) stream)
           (format stream "#<SXQL-COMPILED: ~A [~{~A~^, ~}]>"
                   (,(symbolcat compiled-name :sql) object)
                   (,(symbolcat compiled-name :bind) object)))

         (defmethod yield ((object ,compiled-name))
           (values
            (,(symbolcat compiled-name :sql) object)
            (,(symbolcat compiled-name :bind) object)))))))

;; macroexpand:
(progn (defstruct (sql-clause-compiled (:include sql-clause)) (sql nil :type string) (bind nil :type list)) (defmethod find-compile-function ((object sql-clause)) (function make-sql-clause-compiled)) (defmethod print-object ((object sql-clause-compiled) stream) (format stream "#<SXQL-COMPILED: ~A [~{~A~^, ~}]>" (sql-clause-compiled-sql object) (sql-clause-compiled-bind object))) (defmethod yield ((object sql-clause-compiled)) (values (sql-clause-compiled-sql object) (sql-clause-compiled-bind object))))


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

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

(augment *step* step)

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

;; macroexpand:
(setf *step* (nconc *step* step))


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

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

(@ nil :key nil)

[Assistant]
(defmacro @ ...)

;; macroexpand:
(@ (message-oo.mangle::key nil) nil)


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

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

(gatherlet nil
  nil)

[Assistant]
(defmacro GATHERLET ...)

;; macroexpand:
(common-lisp:let ()
  nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(action (:after node-application node) (when (eq name (node-rator-name node)) (incf count)) (values))

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

(action (:after node-application node) (when (eq name (node-rator-name node)) (incf count)) (values))

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

;; macroexpand:
(make-action (quote :after) (quote node-application) (lambda (node) (declare (type node-application node)) (when (eq name (node-rator-name node)) (incf count)) (values)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defguarantee make-instance ((class contracted-class) &key &allow-other-keys) (passes-invariants-p (results)))

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

(defguarantee make-instance ((class contracted-class) &key &allow-other-keys) (passes-invariants-p (results)))

[Assistant]
(defmacro defguarantee (name (&rest lambda-list) &body body)
  "Adds a postcondition to the NAMEd function. It can be either a generic or
   non-generic function. If it's the former, then use a specialized lambda list,
   otherwise use an ordinary lambda list. The docstring, if any, will be used in
   failure reports."
  #+qpq-postcondition-checks-disabled
  (declare (ignore name lambda-list body))
  #+qpq-postcondition-checks-disabled
  (values)
  #-qpq-postcondition-checks-disabled
  (multiple-value-bind (remaining-forms declarations doc-string)
      (parse-body body :documentation t)
    (declare (ignore declarations))
    (let* ((stripped-ll (strip-lambda-list lambda-list))
           (lambda-vars (remove-if (rcurry #'member
                                           '(&optional &rest
                                             &key &allow-other-keys &aux))
                                   stripped-ll))
           (method `(progn
                      (ensure-contracted-function ',name ',stripped-ll)
                      (defmethod ,name
                          :guarantee
                          ,(or doc-string
                            (format nil "~A"
                             (description<-remaining-forms
                              remaining-forms)))
                        ,lambda-list
                        (declare (ignorable ,@lambda-vars))
                        ,@body))))
      (if (every #'symbolp lambda-list)
          `(if (and (fboundp ',name)
                    (not (typep (fdefinition ',name) 'generic-function)))
               (defcontract ,name :guarantee ,lambda-list
                 (declare (ignorable ,@lambda-vars))
                 ,@body)
               ,method)
          method))))

;; macroexpand:
(progn (ensure-contracted-function (quote make-instance) (quote (class &key &allow-other-keys))) (defmethod make-instance :guarantee #A((31) base-char . "(PASSES-INVARIANTS-P (RESULTS))") ((class contracted-class) &key &allow-other-keys) (declare (ignorable class)) (passes-invariants-p (results))))


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

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

(as->* nil
  :key
  nil)

[Assistant]
(defmacro AS->* ...)

;; macroexpand:
(let* ((nil nil) (nil :key))
  nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(defmacro+ps nil
    :key
  nil)

Problem: Macro call that should be transformed by DEFMACRO+PS

(defmacro+ps nil
    :key
  nil)

[Assistant]
(defmacro DEFMACRO+PS ...)

;; macroexpand:
(progn
 (defmacro nil :key nil)
 (defpsmacro nil
     :key
   nil))


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

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

(undefreply 'some-name)

[Assistant]
(defmacro UNDEFREPLY ...)

;; macroexpand:
(undefine-reply ''some-name :qualifiers 'nil :participants `nil)


[User]
Define a macro that eliminates this repetitive pattern:
(is (= 0 (add-2 0)))

Issue: Macro call that should be transformed by is

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


[User]
Define a macro that eliminates this repetitive pattern:
(c?-with-stored (v :foo store 'nothing) (bwhen (val (value v)) val))

Issue: Macro call that should be transformed by c?

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

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

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


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

Pattern to recognize: Macro call that should be transformed by WITH-DESTRUCTURED-LAMBDA-FORM

(with-destructured-lambda-form nil
    (progn))

[Assistant]
(defmacro WITH-DESTRUCTURED-LAMBDA-FORM ...)

;; macroexpand:
(destructuring-bind
    (#:function128 #:name129 #:qualifiers130 #:lambda-list131 #:docstring132
     #:declarations133 #:forms134)
    (split-lambda-form (progn))
  (declare
   (ignore #:function128 #:name129 #:qualifiers130 #:lambda-list131
    #:docstring132 #:declarations133 #:forms134)))


[User]
Define a macro that eliminates this repetitive pattern:
(aif (+ 1 1) (+ 1 it) :never)

Issue: Macro call that should be transformed by aif

(aif (+ 1 1) (+ 1 it) :never)

[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 1) (+ 1 it) :never)


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

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

(cond-<>
  'some-name)

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

;; macroexpand:
'some-name


[User]
Define a macro that eliminates this repetitive pattern:
(setdocs (type restart "Class container for restart information. See NAME See REPORT See RESTART See OBJECT See INTERACTIVE See TEST See INVOKE") (function name "Returns the restart's symbol. Use this for INVOKE-RESTART. See RESTART") (function report "Returns the report string describing the restart's effects. See RESTART") (function restart "Returns a symbol to the restart-function or a direct function-object. See RESTART") (function object "Returns the platform-internal restart object. See RESTART") (function interactive "Returns the interactive restart function. See RESTART") (function test "Returns the restart test function. See RESTART") (function invoke "Invoke the restart that the restart object references. See RESTART"))

Issue: Macro call that should be transformed by setdocs

(setdocs (type restart "Class container for restart information. See NAME See REPORT See RESTART See OBJECT See INTERACTIVE See TEST See INVOKE") (function name "Returns the restart's symbol. Use this for INVOKE-RESTART. See RESTART") (function report "Returns the report string describing the restart's effects. See RESTART") (function restart "Returns a symbol to the restart-function or a direct function-object. See RESTART") (function object "Returns the platform-internal restart object. See RESTART") (function interactive "Returns the interactive restart function. See RESTART") (function test "Returns the restart test function. See RESTART") (function invoke "Invoke the restart that the restart object references. See RESTART"))

[Assistant]
(defmacro setdocs (&body pairs)
  `(progn
     ,@(loop for (type var doc) in pairs
             collect `(setf (documentation ',var ',type) ,doc))))

;; macroexpand:
(progn (setf (documentation (quote restart) (quote type)) "Class container for restart information. See NAME See REPORT See RESTART See OBJECT See INTERACTIVE See TEST See INVOKE") (setf (documentation (quote name) (quote function)) "Returns the restart's symbol. Use this for INVOKE-RESTART. See RESTART") (setf (documentation (quote report) (quote function)) "Returns the report string describing the restart's effects. See RESTART") (setf (documentation (quote restart) (quote function)) "Returns a symbol to the restart-function or a direct function-object. See RESTART") (setf (documentation (quote object) (quote function)) "Returns the platform-internal restart object. See RESTART") (setf (documentation (quote interactive) (quote function)) "Returns the interactive restart function. See RESTART") (setf (documentation (quote test) (quote function)) "Returns the restart test function. See RESTART") (setf (documentation (quote invoke) (quote function)) "Invoke the restart that the restart object references. See RESTART"))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(ps-doc)

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

(ps-doc)

[Assistant]
(defmacro PS-DOC ...)

;; macroexpand:
""


[User]
You are a Common Lisp macro expert. Given this code pattern:
(*> +doctype+ +skip-space+)

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

(*> +doctype+ +skip-space+)

[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 (#:*>-offset265) (multiple-value-bind (#:*>-res266 #:*>-next267) (funcall +doctype+ #:*>-offset265) (if (ok? #:*>-res266) (funcall +skip-space+ #:*>-next267) (fail #:*>-next267))))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-error multi-func-stemcells () (func-name) "Multiple functions found named ~a that match arguments.~%However varjo cannot decide which function to use because n of the arguments passed in are of stemcell type" func-name)

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

(define-error multi-func-stemcells () (func-name) "Multiple functions found named ~a that match arguments.~%However varjo cannot decide which function to use because n of the arguments passed in are of stemcell type" func-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 multi-func-stemcells (:error-type varjo-error :prefix "Varjo") (func-name) "Multiple functions found named ~a that match arguments.~%However varjo cannot decide which function to use because n of the arguments passed in are of stemcell type" func-name)


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

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

(ps)

[Assistant]
(defmacro PS ...)

;; macroexpand:
""


[User]
Define a macro that eliminates this repetitive pattern:
(define-modf-expander cdr 1 (expr val new-val) (declare (ignore expr)) `(cons (car ,val) ,new-val))

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

(define-modf-expander cdr 1 (expr val new-val) (declare (ignore expr)) `(cons (car ,val) ,new-val))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote cdr) *modf-nth-arg*) 1 (gethash (quote cdr) *modf-expansions*) (lambda (expr val new-val) (declare (ignore expr)) (sb-int:quasiquote (cons (car #S(sb-impl::comma :expr val :kind 0)) #S(sb-impl::comma :expr new-val :kind 0))))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-compile-struct sxql/composer:select-query-state)

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

(define-compile-struct sxql/composer:select-query-state)

[Assistant]
(defmacro define-compile-struct (structure-name &rest defstruct-options)
  (flet ((symbolcat (&rest symbols)
           (intern (format nil "~{~A~^-~}" symbols) #.*package*)))
    (let ((compiled-name (symbolcat structure-name :compiled)))
      `(progn
         (defstruct (,compiled-name (:include ,structure-name ,@defstruct-options))
           (sql nil :type string)
           (bind nil :type list))

         (defmethod find-compile-function ((object ,structure-name))
           (function ,(symbolcat :make compiled-name)))

         (defmethod print-object ((object ,compiled-name) stream)
           (format stream "#<SXQL-COMPILED: ~A [~{~A~^, ~}]>"
                   (,(symbolcat compiled-name :sql) object)
                   (,(symbolcat compiled-name :bind) object)))

         (defmethod yield ((object ,compiled-name))
           (values
            (,(symbolcat compiled-name :sql) object)
            (,(symbolcat compiled-name :bind) object)))))))

;; macroexpand:
(progn (defstruct (select-query-state-compiled (:include select-query-state)) (sql nil :type string) (bind nil :type list)) (defmethod find-compile-function ((object select-query-state)) (function make-select-query-state-compiled)) (defmethod print-object ((object select-query-state-compiled) stream) (format stream "#<SXQL-COMPILED: ~A [~{~A~^, ~}]>" (select-query-state-compiled-sql object) (select-query-state-compiled-bind object))) (defmethod yield ((object select-query-state-compiled)) (values (select-query-state-compiled-sql object) (select-query-state-compiled-bind object))))


[User]
Generate a defmacro form that transforms code like this:
(bind (((:accessors-read-only a c e) (make-instance 'metabang-bind-class-2 :a 1 :b 2 :c 3 :d 4 :e 5))) (list e c a))

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

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

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

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

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

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

;; macroexpand:
(let* ((#:|values-173| (make-instance (quote metabang-bind-class-2) :a 1 :b 2 :c 3 :d 4 :e 5)) (a (a #:|values-173|)) (c (c #:|values-173|)) (e (e #:|values-173|))) (declare (ignorable #:|values-173|)) (progn (list e c a)))


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

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

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

[Assistant]
(defmacro WITH-STANDARD-DEFINER-OPTIONS ...)

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


[User]
Define a macro that eliminates this repetitive pattern:
(in-readtable pax:macro)

Issue: Macro call that should be transformed by in-readtable

(in-readtable pax:macro)

[Assistant]
(defmacro in-readtable (name)
  "Set *READTABLE* to the readtable referred to by the symbol NAME and
  return the readtable. This may signal READTABLE-DOES-NOT-EXIST.

  - Everything IN-READTABLE does is also performed at [compile time][
    pax:clhs] if the call appears as a [top level form][ pax:clhs].

  - The effects of IN-READTABLE are file-local since both COMPILE-FILE
    and LOAD rebind *READTABLE*."
  (check-type name symbol)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     ;; NB. The :LOAD-TOPLEVEL is needed for cases like (DEFVAR *FOO*
     ;; (GET-MACRO-CHARACTER #\"))
     (setf *readtable* (ensure-readtable ',name))
     (when (or (find-package :swank) (find-package :slynk))
       (%frob-swank-readtable-alist *package* *readtable*))
     *readtable*))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (setf *readtable* (ensure-readtable (quote mgl-pax:macro))) (when (or (find-package :swank) (find-package :slynk)) (%frob-swank-readtable-alist *package* *readtable*)) *readtable*)


[User]
Generate a defmacro form that transforms code like this:
(make-name-transformer "FOO-" name "-BAR")

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

(make-name-transformer "FOO-" name "-BAR")

[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]
You are a Common Lisp macro expert. Given this code pattern:
(defstore example (&rest args &key (a 0) (b (the integer (init-b args))) (c 0)))

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

(defstore example (&rest args &key (a 0) (b (the integer (init-b args))) (c 0)))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (progn (defun a-init-function152 (args a #:a?166) (declare (ignorable args a #:a?166)) (the integer (init-b args))) (ensure-store (quote example) (quote (&rest args &key (a 0 #:a?166) (b (the integer (a-init-function152 args a #:a?166)) #:b?167) (c 0 #:c?168))))))


[User]
Define a macro that eliminates this repetitive pattern:
(with-table-name table-name-b (yield-only-contents clause-b))

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

(with-table-name table-name-b (yield-only-contents clause-b))

[Assistant]
(defmacro with-table-name (table-name &body body)
  `(let ((*table-name-scope* ,table-name))
     ,@body))

;; macroexpand:
(let ((*table-name-scope* table-name-b)) (yield-only-contents clause-b))


[User]
Write a Common Lisp macro to handle this code pattern:
(defjs reduce8(k vals) (let ((arr (make-array)) (index 0)) (dolist (c vals) (setf (aref arr index) c) (incf index 1)) (return (ps:create :retval (aref arr 5)))))

Problem: Macro call that should be transformed by defjs

(defjs reduce8(k vals) (let ((arr (make-array)) (index 0)) (dolist (c vals) (setf (aref arr index) c) (incf index 1)) (return (ps:create :retval (aref arr 5)))))

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

;; macroexpand:
(let* ((js-body (parenscript:ps (lambda (k vals) (let ((arr (make-array)) (index 0)) (dolist (c vals) (setf (aref arr index) c) (incf index 1)) (return (parenscript:create :retval (aref arr 5)))))))) (setf (gethash (quote reduce8) *js-definitions*) js-body) (defun reduce8 (k vals) (get-element "retval" (car (docs (db.eval js-body k vals))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-hamt set (:test test :hash hash :table table) (%hamt-lookup table x (funcall hash x) 0 test))

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

(with-hamt set (:test test :hash hash :table table) (%hamt-lookup table x (funcall hash x) 0 test))

[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 (%hamt-lookup table x (funcall hash x) 0 test))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(<*> (string "hi") (string "bye"))

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

(<*> (string "hi") (string "bye"))

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

;; macroexpand:
(lambda (#:<*>-offset268) (multiple-value-bind (#:<*>-res269 #:<*>-next270) (funcall (string "hi") #:<*>-offset268) (if (failure? #:<*>-res269) (fail #:<*>-next270) (fmap (lambda (xs) (cons #:<*>-res269 xs)) (multiple-value-bind (#:<*>-res271 #:<*>-next272) (funcall (string "bye") #:<*>-next270) (if (failure? #:<*>-res271) (fail #:<*>-next272) (fmap (lambda (xs) (cons #:<*>-res271 xs)) (ok #:<*>-next272 nil))))))))


[User]
Generate a defmacro form that transforms code like this:
(with-yield (loop for line = (read-line file nil 'eof) until (eq line 'eof) do (yield line)) (close file))

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

(with-yield (loop for line = (read-line file nil 'eof) until (eq line 'eof) do (yield line)) (close file))

[Assistant]
(defmacro with-yield (&body body)
  (let ((point (gensym))
        (current (gensym)))
    `(let (,point ,current)
       (with-call/cc
	 (labels ((yield (&rest values)
		    (setf ,current values)
		    (let/cc k
		      (setf ,point k))))
	   ,@body
	   (setf ,point nil)))
       (gen-lambda ()
	 (cond ((null ,point)
		'generator-stop)
	       (t
		(let ((current ,current))
		  (funcall ,point nil)
		  ;values-handler: see gen-lambda
		  (apply #'values (funcall values-handler current)))))))))

;; macroexpand:
(let (#:g137 #:g138) (with-call/cc (labels ((yield (&rest values) (setf #:g138 values) (let/cc k (setf #:g137 k)))) (loop for line = (read-line file nil (quote eof)) until (eq line (quote eof)) do (yield line)) (close file) (setf #:g137 nil))) (gen-lambda nil (cond ((null #:g137) (quote generator-stop)) (t (let ((current #:g138)) (funcall #:g137 nil) (apply (function values) (funcall values-handler current)))))))


[User]
Generate a defmacro form that transforms code like this:
(defclause (nconcing expr &optional into var at (place 'end)) "Nconc into a list" (return-collection-code :variable var :expression expr :start-operation 'nconc :place place :one-element nil))

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

(defclause (nconcing expr &optional into var at (place 'end)) "Nconc into a list" (return-collection-code :variable var :expression expr :start-operation 'nconc :place place :one-element nil))

[Assistant]
(defmacro defclause (clause-template &body body)
  (define-clause 'defun clause-template body nil))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-nconcing-19 (&key ((:nconcing expr)) ((:into var)) ((:at place) (quote end))) "Nconc into a list" (return-collection-code :variable var :expression expr :start-operation (quote nconc) :place place :one-element nil)) (install-clause-info (quote (nconcing)) (quote (nconcing &optional :into :at)) (quote clause-nconcing-19) "Nconc into a list" nil) (quote (nconcing expr &optional into var at (place (quote end)))))


[User]
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time check-lambda-list-internal (lambda-list &optional mode) (cond ((null lambda-list)) ((member (first lambda-list) *ordered-lambda-list-keywords* :test #'eq) (check-lambda-list-internal (rest lambda-list) (first lambda-list))) (t (let ((parameter (first lambda-list))) (ecase mode ((nil) (unless (symbolp parameter) (error "Invalid parameter: ~S" parameter))) (&optional (unless (or (symbolp parameter) (and (consp parameter) (null (rest (last parameter))) (or (= (length parameter) 1) (= (length parameter) 2) (and (= (length parameter) 3) (symbolp (third parameter)))) (symbolp (first parameter)))) (error "Invalid &OPTIONAL parameter: ~S" parameter))) (&rest (unless (symbolp parameter) (error "Invalid &REST parameter: ~S" parameter))) (&key (unless (or (symbolp parameter) (and (consp parameter) (null (rest (last parameter))) (or (= (length parameter) 1) (= (length parameter) 2) (and (= (length parameter) 3) (symbolp (third parameter)))) (or (symbolp (first parameter)) (and (consp (first parameter)) (null (rest (last (first parameter)))) (= (length (first parameter)) 2) (symbolp (first (first parameter))) (symbolp (second (first parameter))))))) (error "Invalid &KEY parameter: ~S" parameter))) (&aux (unless (or (symbolp parameter) (and (consp parameter) (null (rest (last parameter))) (or (= (length parameter) 1) (= (length parameter) 2)) (symbolp (first parameter)))) (error "Invalid &AUX parameter: ~S" parameter))))) (check-lambda-list-internal (rest lambda-list) mode))))

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

(defun-compile-time check-lambda-list-internal (lambda-list &optional mode) (cond ((null lambda-list)) ((member (first lambda-list) *ordered-lambda-list-keywords* :test #'eq) (check-lambda-list-internal (rest lambda-list) (first lambda-list))) (t (let ((parameter (first lambda-list))) (ecase mode ((nil) (unless (symbolp parameter) (error "Invalid parameter: ~S" parameter))) (&optional (unless (or (symbolp parameter) (and (consp parameter) (null (rest (last parameter))) (or (= (length parameter) 1) (= (length parameter) 2) (and (= (length parameter) 3) (symbolp (third parameter)))) (symbolp (first parameter)))) (error "Invalid &OPTIONAL parameter: ~S" parameter))) (&rest (unless (symbolp parameter) (error "Invalid &REST parameter: ~S" parameter))) (&key (unless (or (symbolp parameter) (and (consp parameter) (null (rest (last parameter))) (or (= (length parameter) 1) (= (length parameter) 2) (and (= (length parameter) 3) (symbolp (third parameter)))) (or (symbolp (first parameter)) (and (consp (first parameter)) (null (rest (last (first parameter)))) (= (length (first parameter)) 2) (symbolp (first (first parameter))) (symbolp (second (first parameter))))))) (error "Invalid &KEY parameter: ~S" parameter))) (&aux (unless (or (symbolp parameter) (and (consp parameter) (null (rest (last parameter))) (or (= (length parameter) 1) (= (length parameter) 2)) (symbolp (first parameter)))) (error "Invalid &AUX parameter: ~S" parameter))))) (check-lambda-list-internal (rest lambda-list) mode))))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun check-lambda-list-internal (lambda-list &optional mode) (cond ((null lambda-list)) ((member (first lambda-list) *ordered-lambda-list-keywords* :test (function eq)) (check-lambda-list-internal (rest lambda-list) (first lambda-list))) (t (let ((parameter (first lambda-list))) (ecase mode ((nil) (unless (symbolp parameter) (error "Invalid parameter: ~S" parameter))) (&optional (unless (or (symbolp parameter) (and (consp parameter) (null (rest (last parameter))) (or (= (length parameter) 1) (= (length parameter) 2) (and (= (length parameter) 3) (symbolp (third parameter)))) (symbolp (first parameter)))) (error "Invalid &OPTIONAL parameter: ~S" parameter))) (&rest (unless (symbolp parameter) (error "Invalid &REST parameter: ~S" parameter))) (&key (unless (or (symbolp parameter) (and (consp parameter) (null (rest (last parameter))) (or (= (length parameter) 1) (= (length parameter) 2) (and (= (length parameter) 3) (symbolp (third parameter)))) (or (symbolp (first parameter)) (and (consp (first parameter)) (null (rest (last (first parameter)))) (= (length (first parameter)) 2) (symbolp (first (first parameter))) (symbolp (second (first parameter))))))) (error "Invalid &KEY parameter: ~S" parameter))) (&aux (unless (or (symbolp parameter) (and (consp parameter) (null (rest (last parameter))) (or (= (length parameter) 1) (= (length parameter) 2)) (symbolp (first parameter)))) (error "Invalid &AUX parameter: ~S" parameter))))) (check-lambda-list-internal (rest lambda-list) mode)))) (eval-when (:compile-toplevel) (compile (quote check-lambda-list-internal))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-element-maker :mask "mask" '(:id))

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

(define-element-maker :mask "mask" '(:id))

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(signal-syntax-error "Unknown token ~A in parse tree." parse-tree)

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

(signal-syntax-error "Unknown token ~A in parse tree." parse-tree)

[Assistant]
(defmacro signal-syntax-error (format-control &rest format-arguments)
  `(signal-syntax-error* nil ,format-control ,@format-arguments))

;; macroexpand:
(signal-syntax-error* nil "Unknown token ~A in parse tree." parse-tree)


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

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

(cond-> nil)

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

;; macroexpand:
(let* ((#:|cond130| nil))
  #:|cond130|)


[User]
Generate a defmacro form that transforms code like this:
(defgenerator takewhile (predicate generator) "Emits items from generator until predicate fails. Eg: (takewhile (lambda (x) (< x 5)) (list->generator '(1 4 6 4 1))) -> 1 4" (do-generator (item generator) (unless (funcall predicate item) (return)) (yield item)))

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

(defgenerator takewhile (predicate generator) "Emits items from generator until predicate fails. Eg: (takewhile (lambda (x) (< x 5)) (list->generator '(1 4 6 4 1))) -> 1 4" (do-generator (item generator) (unless (funcall predicate item) (return)) (yield item)))

[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 takewhile (predicate generator) "Emits items from generator until predicate fails. Eg: (takewhile (lambda (x) (< x 5)) (list->generator '(1 4 6 4 1))) -> 1 4" (with-yield (do-generator (item generator) (unless (funcall predicate item) (return)) (yield item))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-unique-names (value repeat) `((,name (,value) (tagbody ,repeat (cond ((consp ,value) (rplacd ,tail (setq ,tail (cons (car ,value) nil))) (setq ,value (cdr ,value)) (go ,repeat)) (t (rplacd ,tail ,value)))))))

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

(with-unique-names (value repeat) `((,name (,value) (tagbody ,repeat (cond ((consp ,value) (rplacd ,tail (setq ,tail (cons (car ,value) nil))) (setq ,value (cdr ,value)) (go ,repeat)) (t (rplacd ,tail ,value)))))))

[Assistant]
(defmacro with-unique-names (names &body body)
  `(let ,(mapcar (lambda (sym)
                   `(,sym (gensym ,(symbol-name sym))))
                  names)
     ,@body))

;; macroexpand:
(let ((value (gensym #A((5) base-char . "VALUE"))) (repeat (gensym #A((6) base-char . "REPEAT")))) (quasiquote ((#S(sb-impl::comma :expr name :kind 0) (#S(sb-impl::comma :expr value :kind 0)) (tagbody #S(sb-impl::comma :expr repeat :kind 0) (cond ((consp #S(sb-impl::comma :expr value :kind 0)) (rplacd #S(sb-impl::comma :expr tail :kind 0) (setq #S(sb-impl::comma :expr tail :kind 0) (cons (car #S(sb-impl::comma :expr value :kind 0)) nil))) (setq #S(sb-impl::comma :expr value :kind 0) (cdr #S(sb-impl::comma :expr value :kind 0))) (go #S(sb-impl::comma :expr repeat :kind 0))) (t (rplacd #S(sb-impl::comma :expr tail :kind 0) #S(sb-impl::comma :expr value :kind 0)))))))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-hook (:build clear-asdf most-negative-fixnum) () (asdf:clear-configuration) (setf (fdefinition 'asdf:upgrade-asdf) (lambda ())) #+quicklisp (setf ql:*local-project-directories* ()) (dolist (system (asdf:already-loaded-systems)) (asdf:register-immutable-system system) (asdf:clear-system system)))

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

(define-hook (:build clear-asdf most-negative-fixnum) () (asdf:clear-configuration) (setf (fdefinition 'asdf:upgrade-asdf) (lambda ())) #+quicklisp (setf ql:*local-project-directories* ()) (dolist (system (asdf:already-loaded-systems)) (asdf:register-immutable-system system) (asdf:clear-system system)))

[Assistant]
(defmacro define-hook ((type name &optional (priority 0)) args &body body)
  (ecase type (:pre-load) (:load) (:build) (:deploy) (:boot) (:quit))
  (check-type name symbol)
  `(let ((,name (or (hook ,type ',name)
                    (make-instance 'hook :name ',name :type ,type))))
     (setf (hook-priority ,name) ,priority)
     (setf (hook-function ,name) (flet ((,name (&key ,@args &allow-other-keys)
                                          ,@body))
                                   #',name))
     (setf (hook ,type ',name) ,name)
     (setf (docstring ,name) ,(if (stringp (car body)) (car body)))
     ',name))

;; macroexpand:
(let ((clear-asdf (or (hook :build (quote clear-asdf)) (make-instance (quote hook) :name (quote clear-asdf) :type :build)))) (setf (hook-priority clear-asdf) most-negative-fixnum) (setf (hook-function clear-asdf) (flet ((clear-asdf (&key &allow-other-keys) (uiop/configuration:clear-configuration) (setf (fdefinition (quote asdf/upgrade:upgrade-asdf)) (lambda nil)) (setf quicklisp-client:*local-project-directories* nil) (dolist (system (asdf/operate:already-loaded-systems)) (asdf/system-registry:register-immutable-system system) (asdf/system-registry:clear-system system)))) (function clear-asdf))) (setf (hook :build (quote clear-asdf)) clear-asdf) (setf (docstring clear-asdf) nil) (quote clear-asdf))


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

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

(lambda-coro
  nil
  nil)

[Assistant]
(defmacro LAMBDA-CORO ...)

;; macroexpand:
(progn
 (defcoroutine #:name127
     (#:arg128)
   (macrolet ((yield (form)
                (let ((g!-it (gensym "IT")))
                  `(progn
                    (let ((,g!-it ,form))
                      (cl-coroutine:yield ,g!-it))
                    ,'#:arg128)))
              (last-yield-value ()
                '#:arg128))
     nil
     nil
     (coexit!)))
 (make-coroutine '#:name127))


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

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

(collect-file nil :key nil)

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

;; macroexpand:
(common-lisp:let* ((#:generator-560 (generator :key)) #:items-554 (#:out-556 t))
  (declare (type generator #:generator-560)
           (type boolean #:out-556))
  (with-open-file (#:outfile-553 nil :direction :output)
    (tagbody
     #:ll-561
      (setq #:items-554 (next-in #:generator-560 (go end)))
      (common-lisp:funcall nil #:items-554 #:outfile-553)
      (go #:ll-561)
     end))
  #:out-556)


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

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

(advisable-lambda nil)

[Assistant]
(defmacro ADVISABLE-LAMBDA ...)

;; macroexpand:
(make-instance 'advisable-function :main #'(lambda ()) :arguments 'nil
               :dispatcher-generator
               #'(lambda (#:fobj122)
                   #'(lambda ()
                       #A((29) base-char . "Advisable function dispatcher")
                       (let ((#:fixed123 (append)))
                         (apply-before #:fobj122 #:fixed123)
                         (multiple-value-prog1
                             (apply-around #:fobj122 #:fixed123)
                           (apply-after #:fobj122 #:fixed123))))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-mocks () (answer (foo 1) 2) (answer (foo 2) 3) (answer foo 42) (is (eql 2 (foo 1))) (is (eql 2 (foo 1))) (is (eql 3 (foo 2))) (is (eql 3 (foo 2))) (is (eql 42 (foo))) (is (eql 42 (foo 'foo))))

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

(with-mocks () (answer (foo 1) 2) (answer (foo 2) 3) (answer foo 42) (is (eql 2 (foo 1))) (is (eql 2 (foo 1))) (is (eql 3 (foo 2))) (is (eql 3 (foo 2))) (is (eql 42 (foo))) (is (eql 42 (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 1) 2) (answer (foo 2) 3) (answer foo 42) (is (eql 2 (foo 1))) (is (eql 2 (foo 1))) (is (eql 3 (foo 2))) (is (eql 3 (foo 2))) (is (eql 42 (foo))) (is (eql 42 (foo (quote foo))))) :recordp t)


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

Issue: Macro call that should be transformed by ->

(->
  nil
  nil)

[Assistant]
(defmacro -> ...)

;; macroexpand:
(let* ((#:var148 nil) (#:var149 (nil #:var148)))
  #:var149)


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

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

(iter
  nil
  nil)

[Assistant]
(defmacro ITER ...)

;; macroexpand:
(let* ()
  (block nil
    (block nil
      (tagbody
        (progn)
       loop-top-nil
        (progn nil)
        (progn)
        (go loop-top-nil)
        (progn))
      nil)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(*> +many-comments+ +opt-fws+)

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

(*> +many-comments+ +opt-fws+)

[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 (#:*>-offset140) (multiple-value-bind (#:*>-res141 #:*>-next142) (funcall +many-comments+ #:*>-offset140) (if (ok? #:*>-res141) (funcall +opt-fws+ #:*>-next142) (fail #:*>-next142))))


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

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

(defvariant nil
  (progn))

[Assistant]
(defmacro DEFVARIANT ...)

;; macroexpand:
(progn
 (defstruct (nil (:constructor nil)))
 (defstruct (nil-progn (:include nil)))
 (defmacro match-nil (expr &body match-cases)
   #A((34) base-char . "Match values of variant type: NIL.")
   (let ((expr-var (gensym "-val")))
     `(let ((,expr-var ,expr))
        ,(build-dispatch `,'nil `,'((progn)) match-cases expr-var)))))


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

Problem: Macro call that should be transformed by DISABLE-DOT-SYNTAX

(disable-dot-syntax)

[Assistant]
(defmacro disable-dot-syntax ()
  "Restore readtable which was active before last call to If there was no such call, the standard
readtable is used."
  `(eval-when (:compile-toplevel :load-toplevel :execute)
    (%disable-dot-syntax)))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (%disable-dot-syntax))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(aif (list 1 2 3) (sif (car it) (setf it 'a) :foo))

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

(aif (list 1 2 3) (sif (car it) (setf it 'a) :foo))

[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 (list 1 2 3) (sif (car it) (setf it (quote a)) :foo) nil)


[User]
Define a macro that eliminates this repetitive pattern:
(defrequirement add (&rest addends) "all args < 10" (every (lambda (n) (< n 10)) addends))

Issue: Macro call that should be transformed by defrequirement

(defrequirement add (&rest addends) "all args < 10" (every (lambda (n) (< n 10)) addends))

[Assistant]
(defmacro defrequirement (name (&rest lambda-list) &body body)
  "Adds a precondition to the NAMEd function. It can be either a generic or
   non-generic function. If it's the former, then use a specialized lambda list,
   otherwise use an ordinary lambda list. The docstring, if any, will be used in
   failure reports."
  #+qpq-precondition-checks-disabled
  (declare (ignore name lambda-list body))
  #+qpq-precondition-checks-disabled
  (values)
  #-qpq-precondition-checks-disabled
  (multiple-value-bind (remaining-forms declarations doc-string)
      (parse-body body :documentation t)
    (declare (ignore declarations))
    (let* ((stripped-ll (strip-lambda-list lambda-list))
           (lambda-vars (remove-if (rcurry #'member
                                           '(&optional &rest
                                             &key &allow-other-keys &aux))
                                   stripped-ll))
           (method `(progn
                      (ensure-contracted-function ',name',stripped-ll)
                      (defmethod ,name
                          :require
                          ,(format nil "~A"
                            (or doc-string
                             (description<-remaining-forms
                              remaining-forms)))
                        ,lambda-list
                        (declare (ignorable ,@lambda-vars))
                        ,@body))))
      (if (every #'symbolp lambda-list)
          `(if (and (fboundp ',name)
                    (not (typep (fdefinition ',name) 'generic-function)))
               (defcontract ,name :require ,lambda-list
                 (declare (ignorable ,@lambda-vars))
                 ,@body)
               ,method)
          method))))

;; macroexpand:
(if (and (fboundp (quote add)) (not (typep (fdefinition (quote add)) (quote generic-function)))) (defcontract add :require (&rest addends) (declare (ignorable addends)) "all args < 10" (every (lambda (n) (< n 10)) addends)) (progn (ensure-contracted-function (quote add) (quote (&rest addends))) (defmethod add :require #A((13) base-char . "all args < 10") (&rest addends) (declare (ignorable addends)) "all args < 10" (every (lambda (n) (< n 10)) addends))))


[User]
Define a macro that eliminates this repetitive pattern:
(make-$instance nil nil)

Issue: Macro call that should be transformed by MAKE-$INSTANCE

(make-$instance nil nil)

[Assistant]
(defmacro MAKE-$INSTANCE ...)

;; macroexpand:
(let ((class (symbol-value nil)))
  (funcall (mcs-slot-value class (index-of-basicnew-fn)) class nil))


[User]
Define a macro that eliminates this repetitive pattern:
(define-method-combination% nconc :operator nconc :identity-with-one-argument t)

Issue: Macro call that should be transformed by define-method-combination%

(define-method-combination% nconc :operator nconc :identity-with-one-argument t)

[Assistant]
(defmacro define-method-combination% (name &rest args)
  "Define a method-combination for the static-dispatch system only.

   Arguments are of the same form as to CL:DEFINE-METHOD-COMBINATION."

  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (setf
      (combination-function ',name)
      ,(match args
         ((or nil
              (list* (and (type symbol) (not nil)) _))

          (destructuring-bind (&key (operator name) (identity-with-one-argument nil))
              args

            `(method-combination-function-short ,name ,operator ,identity-with-one-argument)))

         (_
          `(method-combination-function ,name ,@args))))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (setf (combination-function (quote nconc)) (method-combination-function-short nconc nconc t)))