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

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

(defpsmacro nil
    (progn))

[Assistant]
(defmacro DEFPSMACRO ...)

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


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

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

(define-error duplicate-name () (name) "This name appears more than once in this form list ~a" 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 duplicate-name (:error-type varjo-error :prefix "Varjo") (name) "This name appears more than once in this form list ~a" name)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defgenerator compress (data selectors) "Moves through the data and selectors generators in parallel, only yielding elements of data that are paired with a value from selectors that evaluates to true. Eg: (compress (list->generator '(a b c d e f)) (list->generator '(t nil t nil t t))) -> a c e f" (do-generator (d s (izip data selectors)) (when s (yield d))))

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

(defgenerator compress (data selectors) "Moves through the data and selectors generators in parallel, only yielding elements of data that are paired with a value from selectors that evaluates to true. Eg: (compress (list->generator '(a b c d e f)) (list->generator '(t nil t nil t t))) -> a c e f" (do-generator (d s (izip data selectors)) (when s (yield d))))

[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 compress (data selectors) "Moves through the data and selectors generators in parallel, only yielding elements of data that are paired with a value from selectors that evaluates to true. Eg: (compress (list->generator '(a b c d e f)) (list->generator '(t nil t nil t t))) -> a c e f" (with-yield (do-generator (d s (izip data selectors)) (when s (yield d)))))


[User]
Write a Common Lisp macro to handle this code pattern:
(defcategory :error (or :error :critical))

Problem: Macro call that should be transformed by defcategory

(defcategory :error (or :error :critical))

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(match list ((list x) (if (evenp x) (fail) x)))

Problem: Macro call that should be transformed by match

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

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

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

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

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

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

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

will be translated to

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

Examples:

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

;; macroexpand:
(%or (%if (consp list) (let ((#:g146 (car list)) (#:g147 (cdr list))) (declare (ignorable #:g146 #:g147)) (%if (%equals #:g147 nil) (%or (let ((x #:g146)) (if (evenp x) (fail) x)) (fail)) (fail))) (fail)) nil)


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

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

(destructuring-bind* nil
    nil)

[Assistant]
(defmacro DESTRUCTURING-BIND* ...)

;; macroexpand:
(let (#:in-body126)
  (flet ((#:handle127 (#:condition128)
           (unless #:in-body126
             (error
              (make-condition 'destructuring-error :lambda-list 'nil
                              :expression 'nil :reason #:condition128)))))
    (declare (ignorable (function #:handle127)))
    (let ((#:value129 nil))
      (handler-bind ((error #'#:handle127))
        (destructuring-bind () #:value129 (setf #:in-body126 t) (locally))))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(do-matches-as-strings (match regex target-string (nreverse result-list) :start start :end end :sharedp sharedp) (push match result-list))

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

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

[Assistant]
(defmacro do-matches-as-strings ((match-var regex
                                            target-string
                                            &optional result-form
                                            &key start end sharedp)
                                 &body body)
  "Iterates over TARGET-STRING and tries to match REGEX as often as
possible evaluating BODY with MATCH-VAR bound to the substring of
TARGET-STRING corresponding to each match in turn.  After the last
match, returns RESULT-FORM if provided or NIL otherwise.  An implicit
block named NIL surrounds DO-MATCHES-AS-STRINGS; RETURN may be used to
terminate the loop immediately.  If REGEX matches an empty string the
scan is continued one position behind this match.  If SHAREDP is true,
the substrings may share structure with TARGET-STRING.  BODY may start
with declarations."
  (with-rebinding (target-string)
    (with-unique-names (match-start match-end substr-fn)
      `(let ((,substr-fn (if ,sharedp #'nsubseq #'subseq)))
        ;; simple use DO-MATCHES to extract the substrings
        (do-matches (,match-start ,match-end ,regex ,target-string
                     ,result-form :start ,start :end ,end)
          (let ((,match-var
                  (funcall ,substr-fn
                           ,target-string ,match-start ,match-end)))
            ,@body))))))

;; macroexpand:
(let ((#:target-string145 target-string)) (let ((#:substr-fn148 (if sharedp (function nsubseq) (function subseq)))) (do-matches (#:match-start146 #:match-end147 regex #:target-string145 (nreverse result-list) :start start :end end) (let ((match (funcall #:substr-fn148 #:target-string145 #:match-start146 #:match-end147))) (push match result-list)))))


[User]
Generate a defmacro form that transforms code like this:
(lret ((out (serapeum::make-sequence-like array len))) (replace* out array))

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

(lret ((out (serapeum::make-sequence-like array len))) (replace* out array))

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

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

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

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

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

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

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

;; macroexpand:
(lret-aux let ((out (serapeum::make-sequence-like array len))) (replace* out array))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-took-usec took-usec (query (funcall (query-prepared query) params) :database (connection-handle conn) :store nil))

Problem: Macro call that should be transformed by with-took-usec

(with-took-usec took-usec (query (funcall (query-prepared query) params) :database (connection-handle conn) :store nil))

[Assistant]
(defmacro with-took-usec (var &body body)
  (let ((before (gensym "BEFORE")))
    `(let ((,before (get-internal-real-time)))
       (multiple-value-prog1 (progn ,@body)
         (setf ,var (ceiling
                      (* (- (get-internal-real-time) ,before)
                         #.(/ 1000000 internal-time-units-per-second))))))))

;; macroexpand:
(multiple-value-bind (#:before-unixtime163 #:before-usec164) (sb-ext:get-time-of-day) (multiple-value-prog1 (progn (query (funcall (query-prepared query) params) :database (connection-handle conn) :store nil)) (multiple-value-bind (#:after-unixtime165 #:after-usec166) (sb-ext:get-time-of-day) (setf took-usec (+ (* (- #:after-unixtime165 #:before-unixtime163) 1000000) (- #:after-usec166 #:before-usec164))))))


[User]
Define a macro that eliminates this repetitive pattern:
(defun-compile-time walk-lambda-list (map-function reduce-function screamer? partial? nested? lambda-list environment) (check-lambda-list lambda-list) (if reduce-function (funcall reduce-function (funcall map-function lambda-list 'lambda-list) (walk-lambda-list-reducing map-function reduce-function screamer? partial? nested? lambda-list environment)) (funcall map-function lambda-list 'lambda-list)))

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

(defun-compile-time walk-lambda-list (map-function reduce-function screamer? partial? nested? lambda-list environment) (check-lambda-list lambda-list) (if reduce-function (funcall reduce-function (funcall map-function lambda-list 'lambda-list) (walk-lambda-list-reducing map-function reduce-function screamer? partial? nested? lambda-list environment)) (funcall map-function lambda-list 'lambda-list)))

[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 walk-lambda-list (map-function reduce-function screamer? partial? nested? lambda-list environment) (check-lambda-list lambda-list) (if reduce-function (funcall reduce-function (funcall map-function lambda-list (quote lambda-list)) (walk-lambda-list-reducing map-function reduce-function screamer? partial? nested? lambda-list environment)) (funcall map-function lambda-list (quote lambda-list)))) (eval-when (:compile-toplevel) (compile (quote walk-lambda-list))))


[User]
Define a macro that eliminates this repetitive pattern:
(lret ((x 1) (y 2)) x)

Issue: Macro call that should be transformed by lret

(lret ((x 1) (y 2)) x)

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

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

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

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

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

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

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

;; macroexpand:
(lret-aux let ((x 1) (y 2)) x)


[User]
Generate a defmacro form that transforms code like this:
(defconstant +spaces+ (make-string 2000 :initial-element #\Space :element-type 'base-char) "Used for indentation.")

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

(defconstant +spaces+ (make-string 2000 :initial-element #\Space :element-type 'base-char) "Used for indentation.")

[Assistant]
(defmacro defconstant (name value &optional doc)
  "Make sure VALUE is evaluated only once \(to appease SBCL & clasp)."
  `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
     ,@(when doc (list doc))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (sb-impl::%defconstant (quote +spaces+) (make-string 2000 :initial-element #\Space :element-type (quote base-char)) (sb-c:source-location) (quote "Used for indentation.")))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(bind (((:labels doit (x)) "whatever" (declare (type fixnum x)) (setf x (* 2 x)) (setf x (+ x 3)) x)) (ensure-same (doit 1) 5) (ensure-same (doit 2) 7))

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

(bind (((:labels doit (x)) "whatever" (declare (type fixnum x)) (setf x (* 2 x)) (setf x (+ x 3)) x)) (ensure-same (doit 1) 5) (ensure-same (doit 2) 7))

[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:
(labels ((doit (x) "whatever" (declare (type fixnum x)) (progn (setf x (* 2 x)) (setf x (+ x 3)) x))) (progn (ensure-same (doit 1) 5) (ensure-same (doit 2) 7)))


[User]
Write a Common Lisp macro to handle this code pattern:
(defsynonym step :step)

Problem: Macro call that should be transformed by defsynonym

(defsynonym step :step)

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

;; macroexpand:
(eval-always (setf (get (quote step) (quote synonym)) (quote :step)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defun/1 toupper (c) (char-upcase (code-char c)))

Write a macro that addresses: Macro call that should be transformed by defun/1

(defun/1 toupper (c) (char-upcase (code-char c)))

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

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

;; macroexpand:
(progn (defun toupper (c) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (char-upcase (code-char c))) (defparameter toupper (vacietis.c:mkptr& (symbol-function (quote toupper)))))


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

Problem: Macro call that should be transformed by LAMBDA+

(lambda+ nil
  (progn))

[Assistant]
(defmacro LAMBDA+ ...)

;; macroexpand:
(lambda ()
  (let+ nil
    (progn)))


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

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

(fgatherlet nil
  (progn))

[Assistant]
(defmacro FGATHERLET ...)

;; macroexpand:
(flet ()
  (progn))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-custom-var (:beginning-of-object *beginning-of-object-handler*))

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

(define-custom-var (:beginning-of-object *beginning-of-object-handler*))

[Assistant]
(defmacro define-custom-var ((key name) &rest other-args)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (progn (pushnew '(,name . ,key) *custom-vars* :test #'equal)
            (defvar ,name ,@other-args))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (progn (pushnew (quote (*beginning-of-object-handler* . :beginning-of-object)) *custom-vars* :test (function equal)) (defvar *beginning-of-object-handler*)))


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

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

(var nil :key nil)

[Assistant]
(defmacro VAR ...)

;; macroexpand:
(defparameter nil :key)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-error clone-global-env-error () () "Cannot clone the global environment")

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

(define-error clone-global-env-error () () "Cannot clone the global environment")

[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 clone-global-env-error (:error-type varjo-error :prefix "Varjo") nil "Cannot clone the global environment")


[User]
You are a Common Lisp macro expert. Given this code pattern:
(enable-quasi-quoted-list-to-list-emitting-form-syntax)

Write a macro that addresses: Macro call that should be transformed by ENABLE-QUASI-QUOTED-LIST-TO-LIST-EMITTING-FORM-SYNTAX

(enable-quasi-quoted-list-to-list-emitting-form-syntax)

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

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


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

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

(define-layered-class 'some-name)

[Assistant]
(defmacro DEFINE-LAYERED-CLASS ...)

;; macroexpand:
(defclass 'some-name nil nil (:metaclass layered-class) (:in-layer . t))


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

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

(enable-quasi-quote-syntax nil (progn))

[Assistant]
(defmacro ENABLE-QUASI-QUOTE-SYNTAX ...)

;; macroexpand:
(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-quasi-quote-syntax-in-readtable nil (progn) :nested-quasi-quote-wrapper
                                       quasi-quote-wrapper :start-character nil
                                       :dispatch-character nil :end-character
                                       nil :unquote-character #\COMMA
                                       :splice-character #\COMMERCIAL_AT
                                       :destructive-splice-character
                                       #\FULL_STOP :dispatched-quasi-quote-name
                                       nil :toplevel-reader-wrapper #'identity
                                       :unquote-readtable-case nil :body-reader
                                       nil :readtable-case nil)
  (values))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defclause finding (var condition) "Same as FOR, but perhaps nicer to read when used in conjunction with macros like MAXIMIZING." `(for ,var ,condition))

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

(defclause finding (var condition) "Same as FOR, but perhaps nicer to read when used in conjunction with macros like MAXIMIZING." `(for ,var ,condition))

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

;; macroexpand:
(progn (defmacro finding (var condition) "Same as FOR, but perhaps nicer to read when used in conjunction with macros like MAXIMIZING." (sb-int:quasiquote (for #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr condition :kind 0)))) (pushnew (quote finding) *clauses*))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(ematch0 clause ((list* patterns body) (let ((patterns (ensure-list patterns))) (list* (if (zerop max) nil (append patterns (make-list (- max (length patterns)) :initial-element '_))) body))))

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

(ematch0 clause ((list* patterns body) (let ((patterns (ensure-list patterns))) (list* (if (zerop max) nil (append patterns (make-list (- max (length patterns)) :initial-element '_))) body))))

[Assistant]
(defmacro ematch0 (what &body clauses)
  `(match0 ,what
     ,@clauses
     (_ (error "level0 match error!"))))

;; macroexpand:
(match0 clause ((list* patterns body) (let ((patterns (ensure-list patterns))) (list* (if (zerop max) nil (append patterns (make-list (- max (length patterns)) :initial-element (quote _)))) body))) (_ (error "level0 match error!")))


[User]
Generate a defmacro form that transforms code like this:
(defsynonym minimizing :min)

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

(defsynonym minimizing :min)

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

;; macroexpand:
(eval-always (setf (get (quote minimizing) (quote synonym)) (quote :min)))


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

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

(some-<>
  nil
  :key
  nil)

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

;; macroexpand:
(let* ((#:var180 nil)
       (#:var181
        (if #:var180
            (:key #:var180)
            nil))
       (#:var182
        (if #:var181
            (nil #:var181)
            nil)))
  #:var182)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(setdocs (type environment "Container class for a current \"environment\". An instance of this class is intended to represent most of the runtime environment present at a particular point. It is useful for stashing away debug information for inspection at a later date. See CAPTURE-ENVIRONMENT See ENVIRONMENT-CONDITION See ENVIRONMENT-STACK See ENVIRONMENT-RESTARTS See ENVIRONMENT-THREAD") (function environment-condition "Returns the condition stored in the environment (if any). See CL:CONDITION See ENVIRONMENT") (function environment-stack "Returns a list of calls stored in the environment (if any). See CALL See ENVIRONMENT") (function environment-restarts "Returns a list of restarts stored in the environment (if any). See CL:RESTART See ENVIRONMENT") (function environment-thread "Returns the thread stored in the environment (if any). See SB-THREAD:THREAD See THREADS:THREAD See MP:PROCESS See MT:THREAD See CCL:PROCESS See PROCESS:PROCESS See THREAD:THREAD See ENVIRONMENT") (function capture-environment "Capture the current environment into an environment object. See ENVIRONMENT"))

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

(setdocs (type environment "Container class for a current \"environment\". An instance of this class is intended to represent most of the runtime environment present at a particular point. It is useful for stashing away debug information for inspection at a later date. See CAPTURE-ENVIRONMENT See ENVIRONMENT-CONDITION See ENVIRONMENT-STACK See ENVIRONMENT-RESTARTS See ENVIRONMENT-THREAD") (function environment-condition "Returns the condition stored in the environment (if any). See CL:CONDITION See ENVIRONMENT") (function environment-stack "Returns a list of calls stored in the environment (if any). See CALL See ENVIRONMENT") (function environment-restarts "Returns a list of restarts stored in the environment (if any). See CL:RESTART See ENVIRONMENT") (function environment-thread "Returns the thread stored in the environment (if any). See SB-THREAD:THREAD See THREADS:THREAD See MP:PROCESS See MT:THREAD See CCL:PROCESS See PROCESS:PROCESS See THREAD:THREAD See ENVIRONMENT") (function capture-environment "Capture the current environment into an environment object. See ENVIRONMENT"))

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

;; macroexpand:
(progn (setf (documentation (quote environment) (quote type)) "Container class for a current \"environment\". An instance of this class is intended to represent most of the runtime environment present at a particular point. It is useful for stashing away debug information for inspection at a later date. See CAPTURE-ENVIRONMENT See ENVIRONMENT-CONDITION See ENVIRONMENT-STACK See ENVIRONMENT-RESTARTS See ENVIRONMENT-THREAD") (setf (documentation (quote environment-condition) (quote function)) "Returns the condition stored in the environment (if any). See CL:CONDITION See ENVIRONMENT") (setf (documentation (quote environment-stack) (quote function)) "Returns a list of calls stored in the environment (if any). See CALL See ENVIRONMENT") (setf (documentation (quote environment-restarts) (quote function)) "Returns a list of restarts stored in the environment (if any). See CL:RESTART See ENVIRONMENT") (setf (documentation (quote environment-thread) (quote function)) "Returns the thread stored in the environment (if any). See SB-THREAD:THREAD See THREADS:THREAD See MP:PROCESS See MT:THREAD See CCL:PROCESS See PROCESS:PROCESS See THREAD:THREAD See ENVIRONMENT") (setf (documentation (quote capture-environment) (quote function)) "Capture the current environment into an environment object. See ENVIRONMENT"))


[User]
Write a Common Lisp macro to handle this code pattern:
(select-dao class (where-and fields-and-values class))

Problem: Macro call that should be transformed by select-dao

(select-dao class (where-and fields-and-values class))

[Assistant]
(defmacro select-dao (class &body clauses)
  "Build custom queries with SxQL.

Example:

  (select-dao 'tweet
    (where (:like :status \"%Japan%\")))

You can use \"includes\" to eagerly load another table and prevent the \"N+1 query\" performance problem:

  (select-dao 'tweet
    (includes 'user)
    (where (:like :status \"%Japan%\")))

You can use \"joins\" to add JOIN clauses for filtering by related table columns.
Note: \"joins\" does NOT automatically load foreign objects. Use \"includes\" if you need the ghost slots populated:

  ;; Filter by related table - ghost slot NOT populated
  (select-dao 'blog
    (joins 'user)
    (where (:= :user.status \"active\")))

  ;; Filter AND load foreign objects
  (select-dao 'blog
    (joins 'user)
    (includes 'user)
    (where (:= :user.status \"active\")))

See the SxQL documentation for the available clauses and operators."
  (with-gensyms (sql clause results include-classes foreign-class)
    (once-only (class)
      `(#+sb-package-locks locally #+sb-package-locks (declare (sb-ext:disable-package-locks sxql:where))
        #-sb-package-locks cl-package-locks:with-packages-unlocked #-sb-package-locks (sxql)
        (progn
          (setf ,class (ensure-class ,class))
          (let* ((sxql:*sql-symbol-conversion* #'unlispify)
                 (,sql
                   (sxql:select :*
                                (sxql:from (sxql:make-sql-symbol (table-name ,class)))))
                 (,include-classes '()))
            (macrolet ((where (expression)
                         `(sxql:make-clause :where ,(expand-op expression ',class))))
              ;; ignore compiler-note when includes is not used
              #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
              (flet ((includes (&rest classes)
                       (appendf ,include-classes (mapcar #'ensure-class classes))
                       nil)
                     (joins (foreign-class &key (type :inner))
                       (let ((foreign-class (ensure-class foreign-class)))
                         (add-child ,sql
                                   (ecase type
                                     (:inner (sxql:inner-join
                                               (sxql:make-sql-symbol (table-name foreign-class))
                                               :on (make-join-condition ,class foreign-class)))
                                     (:left (sxql:left-join
                                              (sxql:make-sql-symbol (table-name foreign-class))
                                              :on (make-join-condition ,class foreign-class)))))
                         nil)))
                (dolist (,clause (list ,@clauses))
                  (when ,clause
                    (add-child ,sql ,clause)))
                (let ((,results (select-by-sql ,class ,sql)))
                  (unless *want-cursor*
                    (dolist (,foreign-class (remove-duplicates ,include-classes))
                      (include-foreign-objects ,foreign-class ,results)))
                  (values ,results ,sql))))))))))

;; macroexpand:
(let ((#:class259 class)) (locally (declare (sb-ext:disable-package-locks where)) (progn (setf #:class259 (ensure-class #:class259)) (let* ((*sql-symbol-conversion* (function unlispify)) (#:sql254 (select :* (from (make-sql-symbol (table-name #:class259))))) (#:include-classes257 (quote nil))) (macrolet ((where (expression) (sb-int:quasiquote (make-clause :where #S(sb-impl::comma :expr (expand-op expression (quote #:class259)) :kind 0))))) (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note)) (flet ((includes (&rest classes) (appendf #:include-classes257 (mapcar (function ensure-class) classes)) nil) (joins (foreign-class &key (type :inner)) (let ((foreign-class (ensure-class foreign-class))) (add-child #:sql254 (ecase type (:inner (inner-join (make-sql-symbol (table-name foreign-class)) :on (make-join-condition #:class259 foreign-class))) (:left (left-join (make-sql-symbol (table-name foreign-class)) :on (make-join-condition #:class259 foreign-class))))) nil))) (dolist (#:clause255 (list (where-and fields-and-values class))) (when #:clause255 (add-child #:sql254 #:clause255))) (let ((#:results256 (select-by-sql #:class259 #:sql254))) (unless *want-cursor* (dolist (#:foreign-class258 (remove-duplicates #:include-classes257)) (include-foreign-objects #:foreign-class258 #:results256))) (values #:results256 #:sql254))))))))


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

Write a macro that addresses: Macro call that should be transformed by WITH-DESTRUCTURED-LAMBDA-FORM

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

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

;; macroexpand:
(destructuring-bind
    (#:function135 #:name136 #:qualifiers137 #:lambda-list138 #:docstring139
     #:declarations140 #:forms141)
    (split-lambda-form :key)
  (declare
   (ignore #:function135 #:name136 #:qualifiers137 #:lambda-list138
    #:docstring139 #:declarations140 #:forms141))
  nil)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(lambda-ignoring-_ (_ exp) `(,op ,exp))

Write a macro that addresses: Macro call that should be transformed by lambda-ignoring-_

(lambda-ignoring-_ (_ exp) `(,op ,exp))

[Assistant]
(defmacro lambda-ignoring-_ (lambda-list &body body)
  "Works like `cl:lambda' macro except automatically `declare's
 `ignore' for parameters beginning with '_' character."
  (let ((ignored-parameters
          (collect-_-symbol-in-lambda-list lambda-list)))
    (unless ignored-parameters
      (warn "No ignored parameters in: ~A" lambda-list))
    (multiple-value-bind (body decls doc)
        (parse-body body :documentation t)
      `(lambda ,lambda-list
         ,@ (if doc `(,doc))
         (declare (ignore ,@ignored-parameters))
         ,@decls
         ,@body))))

;; macroexpand:
(lambda (_ exp) (declare (ignore _)) (sb-int:quasiquote (#S(sb-impl::comma :expr op :kind 0) #S(sb-impl::comma :expr exp :kind 0))))


[User]
Generate a defmacro form that transforms code like this:
(def-neo4j-fun create-node (properties) :post (:uri-spec (format nil "node")) (:encode properties :string) (:status-handlers (201 (decode-neo4j-json-output body)) (400 (error 'invalid-data-sent-error :uri uri :json json))))

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

(def-neo4j-fun create-node (properties) :post (:uri-spec (format nil "node")) (:encode properties :string) (:status-handlers (201 (decode-neo4j-json-output body)) (400 (error 'invalid-data-sent-error :uri uri :json json))))

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

;; macroexpand:
(progn (defun create-node (&key properties) (let ((uri (format nil "node")) (json (encode-neo4j-json-payload properties :string))) (make-neo4j-request :post uri json (list (list 201 (lambda (body uri json) (decode-neo4j-json-output body))) (list 400 (lambda (body uri json) (error (quote invalid-data-sent-error) :uri uri :json json))))))))


[User]
Generate a defmacro form that transforms code like this:
(match0 (find v1 seq2 :key #'car) ((list* _ o2) (cons (list v1 :type `(or ,(getf o1 :type) ,(getf o2 :type)) :place (or (getf o1 :place) (getf o2 :place)) :ignorable (or (getf o1 :ignorable) (getf o2 :ignorable))) (merge-variables rest seq2))))

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

(match0 (find v1 seq2 :key #'car) ((list* _ o2) (cons (list v1 :type `(or ,(getf o1 :type) ,(getf o2 :type)) :place (or (getf o1 :place) (getf o2 :place)) :ignorable (or (getf o1 :ignorable) (getf o2 :ignorable))) (merge-variables rest seq2))))

[Assistant]
(defmacro match0 (*what* &body clauses &environment *env*)
  (once-only (*what*)
    (parse-patterns clauses)))

;; macroexpand:
(let ((#:*what*146 (find v1 seq2 :key (function car)))) (declare (ignorable #:*what*146)) (if (and (consp #:*what*146) (let ((#:*what*147 (car #:*what*146))) (declare (ignorable #:*what*147)) t) (let ((#:*what*148 (cdr #:*what*146))) (declare (ignorable #:*what*148)) t)) (let* ((#:*what*147 (car #:*what*146)) (#:*what*148 (cdr #:*what*146)) (o2 #:*what*148)) (declare (ignorable o2 #:*what*148 #:*what*147)) (cons (list v1 :type (sb-int:quasiquote (or #S(sb-impl::comma :expr (getf o1 :type) :kind 0) #S(sb-impl::comma :expr (getf o2 :type) :kind 0))) :place (or (getf o1 :place) (getf o2 :place)) :ignorable (or (getf o1 :ignorable) (getf o2 :ignorable))) (merge-variables rest seq2))) nil))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(lret ((start 0) (result (make-array len :element-type 'character))) (declare (array-index start) ((simple-array character (*)) result)) (do-strings (s more?) (nlet rec (s) (etypecase s (string (with-string-dispatch () s (replace result s :start1 start) (incf start (length s)))) (character (setf (schar result start) s) (incf start)) (symbol (rec (symbol-name s))))) (boolean-when separator? (when more? (replace result separator :start1 start) (incf start sep-len)))) (boolean-when separator? (when end (replace result separator :start1 start))))

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

(lret ((start 0) (result (make-array len :element-type 'character))) (declare (array-index start) ((simple-array character (*)) result)) (do-strings (s more?) (nlet rec (s) (etypecase s (string (with-string-dispatch () s (replace result s :start1 start) (incf start (length s)))) (character (setf (schar result start) s) (incf start)) (symbol (rec (symbol-name s))))) (boolean-when separator? (when more? (replace result separator :start1 start) (incf start sep-len)))) (boolean-when separator? (when end (replace result separator :start1 start))))

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

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

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

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

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

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

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

;; macroexpand:
(lret-aux let ((start 0) (result (make-array len :element-type (quote character)))) (declare (array-index start) ((simple-array character (*)) result)) (do-strings (s more?) (nlet rec (s) (etypecase s (string (with-string-dispatch nil s (replace result s :start1 start) (incf start (length s)))) (character (setf (schar result start) s) (incf start)) (symbol (rec (symbol-name s))))) (boolean-when separator? (when more? (replace result separator :start1 start) (incf start sep-len)))) (boolean-when separator? (when end (replace result separator :start1 start))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(do-generators ((a (repeat 2)) (:list b '(4 5 6)) (c (list->generator '(8 9)) :fill-value 30)) (print (* a (+ b c))))

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

(do-generators ((a (repeat 2)) (:list b '(4 5 6)) (c (list->generator '(8 9)) :fill-value 30)) (print (* a (+ b c))))

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

;; macroexpand:
(let ((#:g153 (multi-gen (repeat 2) (list->generator (quote (4 5 6))) (list (list->generator (quote (8 9))) :fill-value 30)))) (loop do (destructuring-bind (#:g155 . #:g154) (multiple-value-list (next-generator-value #:g153)) (unless #:g155 (return)) (let ((a (elt (elt #:g154 0) 0)) (b (elt (elt #:g154 1) 0)) (c (elt (elt #:g154 2) 0))) (print (* a (+ b c)))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(yield-all (flatten (cdr list)))

Problem: Macro call that should be transformed by yield-all

(yield-all (flatten (cdr list)))

[Assistant]
(defmacro yield-all (generator)
  "Walks through generator, re-yielding all of the items in it. Only meant for use inside of a defgenerator or with-yield block."
  (let ((x (gensym)))
    `(do-generator (,x ,generator)
       (yield ,x))))

;; macroexpand:
(do-generator (#:g185 (flatten (cdr list))) (yield #:g185))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-component-testers (a b #'pathname-name) (components-are-member '(nil :wild :unspecific)) (components-are-string=))

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

(with-component-testers (a b #'pathname-name) (components-are-member '(nil :wild :unspecific)) (components-are-string=))

[Assistant]
(defmacro with-component-testers ((a b key) &body body)
  (let ((k (gensym)))
    `(let* ((,k ,key)
            (,a (funcall ,k ,a))
            (,b (funcall ,k ,b)))
       (labels ((components-are (test)
                  (and (funcall test ,a) (funcall test ,b)))
                (components-are-member (values)
                  (and (member ,a values :test #'eql)
                       (member ,b values :test #'eql)
                       (eql ,a ,b)))
                (components-are-string= ()
                  (and (stringp ,a) (stringp ,b) (string= ,a ,b)))
                (components-are-every (test)
                  (and (consp ,a)
                       (consp ,b)
                       (every test ,a ,b))))
         (declare (ignorable #'components-are #'components-are-member
                             #'components-are-string= #'components-are-every))
         (if (or ,@body)
             (values t ,a ,b)
             nil)))))

;; macroexpand:
(let* ((#:g146 (function pathname-name)) (a (funcall #:g146 a)) (b (funcall #:g146 b))) (labels ((components-are (test) (and (funcall test a) (funcall test b))) (components-are-member (values) (and (member a values :test (function eql)) (member b values :test (function eql)) (eql a b))) (components-are-string= nil (and (stringp a) (stringp b) (string= a b))) (components-are-every (test) (and (consp a) (consp b) (every test a b)))) (declare (ignorable (function components-are) (function components-are-member) (function components-are-string=) (function components-are-every))) (if (or (components-are-member (quote (nil :wild :unspecific))) (components-are-string=)) (values t a b) nil)))


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

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

(and nil)

[Assistant]
(defmacro AND ...)

;; macroexpand:
(the t nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(with-xml-group-element (s (element-name e) (element-attributes e)) (loop for sub-element across (element-contents e) do (stream-out s sub-element)))

Problem: Macro call that should be transformed by with-xml-group-element

(with-xml-group-element (s (element-name e) (element-attributes e)) (loop for sub-element across (element-contents e) do (stream-out s sub-element)))

[Assistant]
(defmacro with-xml-group-element ((stream element properties) &body body)
  (let ((s (gensym "stream"))
        (e (gensym "element")))
    `(let ((,s ,stream)
           (,e ,element))
       (begin-group->xml ,s ,e ,properties)
       (with-indentation
         ,@body)
       (end-group->xml ,s ,e))))

;; macroexpand:
(let ((#:|stream132| s) (#:|element133| (element-name e))) (begin-group->xml #:|stream132| #:|element133| (element-attributes e)) (with-indentation (loop for sub-element across (element-contents e) do (stream-out s sub-element))) (end-group->xml #:|stream132| #:|element133|))


[User]
Generate a defmacro form that transforms code like this:
(when val (cond ((stringp val) (format stream "\"~a\"" val)) ((characterp val) (cond ((eql val #\tab) (format stream "'\\t'")) ((or (eql val #\nul) (eql val #\null)) (format stream "'\\0'")) ((eql val #\return) (format stream "'\\r'")) ((eql val #\newline) (format stream "'\\n'")) ((eql val #\') (format stream "'\\''")) (t (format stream "'~a'" val)))) ((floatp val) (format stream "~a" (substitute #\e #\d (format nil "~,8e" val)))) (t (format stream "~a" val))) )

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

(when val (cond ((stringp val) (format stream "\"~a\"" val)) ((characterp val) (cond ((eql val #\tab) (format stream "'\\t'")) ((or (eql val #\nul) (eql val #\null)) (format stream "'\\0'")) ((eql val #\return) (format stream "'\\r'")) ((eql val #\newline) (format stream "'\\n'")) ((eql val #\') (format stream "'\\''")) (t (format stream "'~a'" val)))) ((floatp val) (format stream "~a" (substitute #\e #\d (format nil "~,8e" val)))) (t (format stream "~a" val))) )

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

;; macroexpand:
(if val (cond ((stringp val) (format stream "\"~a\"" val)) ((characterp val) (cond ((eql val #\Tab) (format stream "'\\t'")) ((or (eql val #\Nul) (eql val #\Nul)) (format stream "'\\0'")) ((eql val #\Return) (format stream "'\\r'")) ((eql val #\Newline) (format stream "'\\n'")) ((eql val #\APOSTROPHE) (format stream "'\\''")) (t (format stream "'~a'" val)))) ((floatp val) (format stream "~a" (substitute #\LATIN_SMALL_LETTER_E #\LATIN_SMALL_LETTER_D (format nil "~,8e" val)))) (t (format stream "~a" val))))


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

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

(drelet* nil
  :key
  nil)

[Assistant]
(defmacro DRELET* ...)

;; macroexpand:
(dynamic-relet* nil
  :key
  nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(defhandler go (go tag) `(list ',go ',tag))

Problem: Macro call that should be transformed by defhandler

(defhandler go (go tag) `(list ',go ',tag))

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

;; macroexpand:
(progn (defun hander-go (go tag) (sb-int:quasiquote (list (quote #S(sb-impl::comma :expr go :kind 0)) (quote #S(sb-impl::comma :expr tag :kind 0))))) (setf (gethash (quote go) *form-handler*) (quote hander-go)))


[User]
Generate a defmacro form that transforms code like this:
(defun-compile-time indirect-callers (function-name) (indirect-callers-internal (callers function-name) '()))

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

(defun-compile-time indirect-callers (function-name) (indirect-callers-internal (callers function-name) '()))

[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 indirect-callers (function-name) (indirect-callers-internal (callers function-name) (quote nil))) (eval-when (:compile-toplevel) (compile (quote indirect-callers))))


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

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

(is 1 1)

[Assistant]
(defmacro is (got expected &rest args)
  (with-gensyms (duration result new-args desc)
    (once-only (expected)
      `(let* ((,new-args (list ,@args))
              (,desc (parse-description-and-test ,new-args)))
         (with-catching-errors (:description ,desc :expected ,expected)
           (with-duration ((,duration ,result) ,got)
             (test ,result ,expected ,new-args
                   :duration ,duration)))))))

;; macroexpand:
(let ((#:expected156 1)) (let* ((#:new-args154 (list)) (#:desc155 (parse-description-and-test #:new-args154))) (with-catching-errors (:description #:desc155 :expected #:expected156) (with-duration ((#:duration152 #:result153) 1) (test #:result153 #:expected156 #:new-args154 :duration #:duration152)))))


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

Write a macro that addresses: Macro call that should be transformed by DO-INSTANCE-COMBINATIONS

(do-instance-combinations 'some-name)

[Assistant]
(defmacro DO-INSTANCE-COMBINATIONS ...)

;; macroexpand:
(do-combinations 'some-name)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-mocks () (if-called 'foo (constantly 42)) (is (eql 42 (foo))))

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

(with-mocks () (if-called 'foo (constantly 42)) (is (eql 42 (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 (if-called (quote foo) (constantly 42)) (is (eql 42 (foo)))) :recordp t)


[User]
Write a Common Lisp macro to handle this code pattern:
(with-c-compilation-unit (:return-last-statement (eql (first body) '{)) (parse-with-lexer (list-lexer body) *c-parser*))

Problem: Macro call that should be transformed by with-c-compilation-unit

(with-c-compilation-unit (:return-last-statement (eql (first body) '{)) (parse-with-lexer (list-lexer body) *c-parser*))

[Assistant]
(defmacro with-c-compilation-unit ((&key return-last-statement)
				   &body body)
  "Establishes variable bindings for a new compilation."
  `(let ((*struct-specs* (copy-hash-table *struct-specs*))
         (*typedef-names* (copy-hash-table *typedef-names*))
	 (*return-last-statement* ,return-last-statement)
         (*function-pointer-ids* nil))
     ,@body))

;; macroexpand:
(let ((*struct-specs* (copy-hash-table *struct-specs*)) (*typedef-names* (copy-hash-table *typedef-names*)) (*return-last-statement* (eql (first body) (quote {))) (*function-pointer-ids* nil)) (parse-with-lexer (list-lexer body) *c-parser*))


[User]
Generate a defmacro form that transforms code like this:
(multiple-value-match (values 1 2) ((2) 1) ((1 y) y))

Pattern to recognize: Macro call that should be transformed by multiple-value-match

(multiple-value-match (values 1 2) ((2) 1) ((1 y) y))

[Assistant]
(defmacro multiple-value-match (values-form &body clauses)
  "Matches the multiple values of VALUES-FORM with CLAUSES. Unlike
MATCH, CLAUSES have to have the form of (PATTERNS . BODY), where
PATTERNS is a list of patterns. The number of values that will be used
to match is determined by the maximum arity of PATTERNS among CLAUSES.

Examples:

    (multiple-value-match (values 1 2)
     ((2) 1)
     ((1 y) y))
    => 2"
  (compile-multiple-value-match values-form clauses nil))

;; macroexpand:
(multiple-value-bind (#:var156 #:var157) (values 1 2) (declare (ignorable #:var156 #:var157)) (%or (%if (%equals #:var156 2) (%or 1 (fail)) (fail)) (%or (%if (%equals #:var156 1) (%or (let ((y #:var157)) y) (fail)) (fail)) nil)))


[User]
Generate a defmacro form that transforms code like this:
(action (:after node-direct-application) #'direct-application-better-infer-types)

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

(action (:after node-direct-application) #'direct-application-better-infer-types)

[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-direct-application) (function direct-application-better-infer-types))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(*> +colon+ #'2-digits)

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

(*> +colon+ #'2-digits)

[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 (#:*>-offset125) (multiple-value-bind (#:*>-res126 #:*>-next127) (funcall +colon+ #:*>-offset125) (if (ok? #:*>-res126) (funcall (function 2-digits) #:*>-next127) (fail #:*>-next127))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-store-entry (key store :quiet quiet) (setf (item key store) nil))

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

(with-store-entry (key store :quiet quiet) (setf (item key store) nil))

[Assistant]
(defmacro with-store-entry ((key store &key quiet) &body body)
  `(prog1
       (progn
	 ,@body)
     (unless ,quiet
       (kick-c-link ,key ,store))))

;; macroexpand:
(prog1 (progn (setf (item key store) nil)) (unless quiet (kick-c-link key store)))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-table-name nil (yield (when-op-right op)))

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

(with-table-name nil (yield (when-op-right op)))

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

;; macroexpand:
(let ((*table-name-scope* nil)) (yield (when-op-right op)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-package (package) (loop for (option . args) in definition-options do (ecase option (:nicknames (loop for nick in args do (add-package-nickname package nick))) (:documentation (setf (documentation package T) (format NIL "~a -- ~a" (documentation package T) (car args)))) (:use (use-package args package)) (:shadow (shadow args package)) (:shadowing-import-from (shadowing-import (collect-symbols-from (car args) (cdr args)) package)) (:import-from (import (collect-symbols-from (car args) (cdr args)) package)) (:export (export args package)) (:intern (loop for symbol in args do (intern (symbol-name symbol) package))) (:local-nicknames (loop for (nickname name) in args do (trivial-package-local-nicknames:add-package-local-nickname nickname name package))) (:size (error "SIZE option not applicable to EXTEND-PACKAGE.")))))

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

(with-package (package) (loop for (option . args) in definition-options do (ecase option (:nicknames (loop for nick in args do (add-package-nickname package nick))) (:documentation (setf (documentation package T) (format NIL "~a -- ~a" (documentation package T) (car args)))) (:use (use-package args package)) (:shadow (shadow args package)) (:shadowing-import-from (shadowing-import (collect-symbols-from (car args) (cdr args)) package)) (:import-from (import (collect-symbols-from (car args) (cdr args)) package)) (:export (export args package)) (:intern (loop for symbol in args do (intern (symbol-name symbol) package))) (:local-nicknames (loop for (nickname name) in args do (trivial-package-local-nicknames:add-package-local-nickname nickname name package))) (:size (error "SIZE option not applicable to EXTEND-PACKAGE.")))))

[Assistant]
(defmacro with-package ((var &optional (package var)) &body body)
  `(let ((,var (ensure-package ,package)))
     ,@body))

;; macroexpand:
(let ((package (ensure-package package))) (loop for (option . args) in definition-options do (ecase option (:nicknames (loop for nick in args do (add-package-nickname package nick))) (:documentation (setf (documentation package t) (format nil "~a -- ~a" (documentation package t) (car args)))) (:use (use-package args package)) (:shadow (shadow args package)) (:shadowing-import-from (shadowing-import (collect-symbols-from (car args) (cdr args)) package)) (:import-from (import (collect-symbols-from (car args) (cdr args)) package)) (:export (export args package)) (:intern (loop for symbol in args do (intern (symbol-name symbol) package))) (:local-nicknames (loop for (nickname name) in args do (sb-ext:add-package-local-nickname nickname name package))) (:size (error "SIZE option not applicable to EXTEND-PACKAGE.")))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(match 1 (x (if (eql x 1) (fail) x)) (_ 'ok))

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

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

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

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

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

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

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

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

will be translated to

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

Examples:

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

;; macroexpand:
(let ((#:var139 1)) (declare (ignorable #:var139)) (%or (%or (let ((x #:var139)) (if (eql x 1) (fail) x)) (quote ok) (fail)) nil))


[User]
Define a macro that eliminates this repetitive pattern:
(defsynonym :maximize :max)

Issue: Macro call that should be transformed by defsynonym

(defsynonym :maximize :max)

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

;; macroexpand:
(eval-always (setf (get (quote :maximize) (quote synonym)) (quote :max)))


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

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

(-> nil nil)

[Assistant]
(defmacro -> ...)

;; macroexpand:
(nil nil)


[User]
Generate a defmacro form that transforms code like this:
(with-color (:red :stream stream) (format/indent reporter stream "× ~D of ~D test~:*~P failed" failed-count count))

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

(with-color (:red :stream stream) (format/indent reporter stream "× ~D of ~D test~:*~P failed" failed-count count))

[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 (format/indent reporter stream "× ~D of ~D test~:*~P failed" failed-count count)) (cl-ansi-text:with-color (:red :stream stream) (format/indent reporter stream "× ~D of ~D test~:*~P failed" failed-count count))) (progn (format/indent reporter stream "× ~D of ~D test~:*~P failed" failed-count count)))


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

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

(collect-max nil nil)

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

;; macroexpand:
(common-lisp:let* ((#:generator-353 (generator nil))
                   #:items-343
                   (#:generator-351 (generator nil))
                   #:numbers-342
                   (#:number-345 nil)
                   #:result-346)
  (declare (type generator #:generator-353)
           (type generator #:generator-351)
           (type (null-or t) #:result-346))
  (tagbody
   #:ll-354
    (setq #:items-343 (next-in #:generator-353 (go end)))
    (setq #:numbers-342 (next-in #:generator-351 (go end)))
    (if (or (null #:number-345) (< #:number-345 #:numbers-342))
        (setq #:number-345 #:numbers-342
              #:result-346 #:items-343))
    (go #:ll-354)
   end)
  (if (null #:number-345)
      (setq #:result-346 nil))
  #:result-346)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defun-speedy make-random-string (&optional (length 12)) (declare (type fixnum length)) (let ((result (make-string length))) (declare (type simple-string result)) (dotimes (i length result) (setf (aref result i) (ecase (random 5) ((0 1) (code-char (+ #.(char-code #\a) (random 26)))) ((2 3) (code-char (+ #.(char-code #\A) (random 26)))) ((4) (code-char (+ #.(char-code #\0) (random 10)))))))))

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

(defun-speedy make-random-string (&optional (length 12)) (declare (type fixnum length)) (let ((result (make-string length))) (declare (type simple-string result)) (dotimes (i length result) (setf (aref result i) (ecase (random 5) ((0 1) (code-char (+ #.(char-code #\a) (random 26)))) ((2 3) (code-char (+ #.(char-code #\A) (random 26)))) ((4) (code-char (+ #.(char-code #\0) (random 10)))))))))

[Assistant]
(defmacro defun-speedy (name lambda-list &body body)
  `(progn
     (declaim (notinline ,name))
     (defun ,name ,lambda-list
       ,*speedy-declaration*
       ,@body)))

;; macroexpand:
(progn (declaim (notinline make-random-string)) (defun make-random-string (&optional (length 12)) (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0))) (declare (type fixnum length)) (let ((result (make-string length))) (declare (type simple-string result)) (dotimes (i length result) (setf (aref result i) (ecase (random 5) ((0 1) (code-char (+ 97 (random 26)))) ((2 3) (code-char (+ 65 (random 26)))) ((4) (code-char (+ 48 (random 10))))))))))


[User]
Define a macro that eliminates this repetitive pattern:
(subtest "Subtest" (diag "in subtest") (is #\a #\a) (like "truth" "^true"))

Issue: Macro call that should be transformed by subtest

(subtest "Subtest" (diag "in subtest") (is #\a #\a) (like "truth" "^true"))

[Assistant]
(defmacro subtest (desc &body body)
  `(%subtest ,desc (lambda () ,@body)))

;; macroexpand:
(%subtest "Subtest" (lambda nil (diag "in subtest") (is #\LATIN_SMALL_LETTER_A #\LATIN_SMALL_LETTER_A) (like "truth" "^true")))


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

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

(with-symbol-access
  'some-name)

[Assistant]
(defmacro WITH-SYMBOL-ACCESS ...)

;; macroexpand:
(let ((*symbol-access* t))
  'some-name)


[User]
Generate a defmacro form that transforms code like this:
(dynamic-relet* nil
  nil)

Pattern to recognize: Macro call that should be transformed by DYNAMIC-RELET*

(dynamic-relet* nil
  nil)

[Assistant]
(defmacro DYNAMIC-RELET* ...)

;; macroexpand:
(progn nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(defclass/a dbd-null-query (cl-dbi:dbi-query) ())

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

(defclass/a dbd-null-query (cl-dbi:dbi-query) ())

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

;; macroexpand:
(progn (defclass dbd-null-query (dbi.driver:dbi-query) nil) (deftype <dbd-null-query> nil (quote dbd-null-query)) (setf (find-class (quote <dbd-null-query>)) (find-class (quote dbd-null-query))))


[User]
Write a Common Lisp macro to handle this code pattern:
(when (and (node-slot type) (not (eql info 'cast-expression)) (not (eql info 'funcall)) (not (eql info 'declaration-item))) (format stream " "))

Problem: Macro call that should be transformed by when

(when (and (node-slot type) (not (eql info 'cast-expression)) (not (eql info 'funcall)) (not (eql info 'declaration-item))) (format stream " "))

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

;; macroexpand:
(if (and (node-slot type) (not (eql info (quote cast-expression))) (not (eql info (quote funcall))) (not (eql info (quote declaration-item)))) (format stream " "))


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

Problem: Macro call that should be transformed by ITERATE

(iterate nil nil)

[Assistant]
(defmacro ITERATE ...)

;; macroexpand:
(progn (tagbody #:ll-249 ((lambda () nil)) (go #:ll-249)) nil)


[User]
Generate a defmacro form that transforms code like this:
(class/std employee name id salary)

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

(class/std employee name id salary)

[Assistant]
(defmacro class/std (name &body defaulted-slots)
  "The most concise shortcut macro to DEFCLASS.

  (class/std example slot1 slot2 slot3)

  expands to:

  (DEFCLASS/STD EXAMPLE ()
    ((SLOT1 SLOT2 SLOT3)))

  which expands to:

  (DEFCLASS EXAMPLE ()
    ((SLOT1 :ACCESSOR SLOT1 :INITARG :SLOT1 :INITFORM NIL)
    (SLOT2 :ACCESSOR SLOT2 :INITARG :SLOT2 :INITFORM NIL)
    (SLOT3 :ACCESSOR SLOT3 :INITARG :SLOT3 :INITFORM NIL)))
"
  `(defclass/std ,name ()
     ((,@defaulted-slots))))

;; macroexpand:
(defclass/std employee nil ((name id salary)))


[User]
Generate a defmacro form that transforms code like this:
(action (:after node-lisp node bound-variables) (when (and (member target bound-variables :test #'eq) (loop :for (_ . coalton-var) :in (node-lisp-vars node) :thereis (and (eq name coalton-var) (not (member name bound-variables :test #'eq))))) (setf unsafe? t)) (values))

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

(action (:after node-lisp node bound-variables) (when (and (member target bound-variables :test #'eq) (loop :for (_ . coalton-var) :in (node-lisp-vars node) :thereis (and (eq name coalton-var) (not (member name bound-variables :test #'eq))))) (setf unsafe? t)) (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-lisp) (lambda (node bound-variables) (declare (type node-lisp node)) (when (and (member target bound-variables :test (function eq)) (loop :for (_ . coalton-var) :in (node-lisp-vars node) :thereis (and (eq name coalton-var) (not (member name bound-variables :test (function eq)))))) (setf unsafe? t)) (values)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-error merge-env-parent-mismatch () (env-a env-b) "Attempting to merge two environments with different parent environments ~s~%~s~%~s" (cons (v-parent-env env-a) (v-parent-env env-b)) env-a env-b)

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

(define-error merge-env-parent-mismatch () (env-a env-b) "Attempting to merge two environments with different parent environments ~s~%~s~%~s" (cons (v-parent-env env-a) (v-parent-env env-b)) env-a env-b)

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


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

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

(->*
  'some-name)

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

;; macroexpand:
'some-name


[User]
Write a Common Lisp macro to handle this code pattern:
(bind (((:plist a (b _) (c _ 2) (dd d)) '(:b "B" :a "A" :d "D"))) (list a b c dd))

Problem: Macro call that should be transformed by bind

(bind (((:plist a (b _) (c _ 2) (dd d)) '(:b "B" :a "A" :d "D"))) (list a b c dd))

[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-164| (quote (:b "B" :a "A" :d "D"))) (a (getf #:|values-164| :a)) (b (getf #:|values-164| :b)) (c (getf #:|values-164| :c 2)) (dd (getf #:|values-164| :d))) (declare (ignorable #:|values-164|)) (progn (list a b c dd)))


[User]
Generate a defmacro form that transforms code like this:
(with-active-layers* nil
  nil)

Pattern to recognize: Macro call that should be transformed by WITH-ACTIVE-LAYERS*

(with-active-layers* nil
  nil)

[Assistant]
(defmacro WITH-ACTIVE-LAYERS* ...)

;; macroexpand:
(progn nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(builder (:session :store (make-dbi-store :connector (lambda () *conn*))) (lambda (env) (unless (gethash :user (getf env :lack.session)) (setf (gethash :user (getf env :lack.session)) "深町英太郎")) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) `(200 (:content-type "text/plain") (,(format nil "Hello, ~A! You've been here for ~Ath times!" (gethash :user (getf env :lack.session)) (incf (gethash :counter (getf env :lack.session))))))))

Problem: Macro call that should be transformed by builder

(builder (:session :store (make-dbi-store :connector (lambda () *conn*))) (lambda (env) (unless (gethash :user (getf env :lack.session)) (setf (gethash :user (getf env :lack.session)) "深町英太郎")) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) `(200 (:content-type "text/plain") (,(format nil "Hello, ~A! You've been here for ~Ath times!" (gethash :user (getf env :lack.session)) (incf (gethash :counter (getf env :lack.session))))))))

[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 (#:app234) (funcall (find-middleware :session) #:app234 :store (make-dbi-store :connector (lambda nil *conn*)))))) :initial-value (to-app (lambda (env) (unless (gethash :user (getf env :lack.session)) (setf (gethash :user (getf env :lack.session)) "深町英太郎")) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) (sb-int:quasiquote (200 (:content-type "text/plain") (#S(sb-impl::comma :expr (format nil "Hello, ~A! You've been here for ~Ath times!" (gethash :user (getf env :lack.session)) (incf (gethash :counter (getf env :lack.session)))) :kind 0)))))) :from-end t)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-test failing (true (< 8 5)) (fail 'happy) (true (= 5 (read-from-string "OH-SHIT"))))

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

(define-test failing (true (< 8 5)) (fail 'happy) (true (= 5 (read-from-string "OH-SHIT"))))

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

;; macroexpand:
(let ((*package* (find-package #A((9) base-char . "PARACHUTE")))) (setf (find-test (quote failing) (find-package #A((9) base-char . "PARACHUTE"))) (ensure-test (quote test) :name (quote failing) :home (find-package #A((9) base-char . "PARACHUTE")) :tests (list (lambda nil (true (< 8 5))) (lambda nil (fail (quote happy))) (lambda nil (true (= 5 (read-from-string "OH-SHIT"))))) :parent (quote nil))) (quote failing))


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

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

(newq nil :key nil)

[Assistant]
(defmacro NEWQ ...)

;; macroexpand:
(new 'nil :key nil)


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

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

(cond->> nil)

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(define-generic generic ((a a) (b b) &key (c nil)))

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

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

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

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

Example:

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

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

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

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


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

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

(collect-first nil (progn))

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

;; macroexpand:
(common-lisp:let* ((#:generator-632 (generator nil))
                   #:items-626
                   (#:item-628 (progn)))
  (declare (type generator #:generator-632)
           (type (null-or t) #:item-628))
  (tagbody
   #:ll-633
    (setq #:items-626 (next-in #:generator-632 (go end)))
    (setq #:item-628 #:items-626)
   end)
  #:item-628)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-generic generic (a b &key c) (declare (optimize speed)) (+ a b c))

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

(define-generic generic (a b &key c) (declare (optimize speed)) (+ a b c))

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

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

Example:

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

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

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

;; macroexpand:
(prog1 (defgeneric generic (a b &key c) (declare (optimize speed)) (:method (a b &key c) (declare (optimize speed)) (+ a b c))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(when-let (previous *log-manager*) (dolist (messenger (log-manager-messengers previous)) (stop-messenger messenger)))

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

(when-let (previous *log-manager*) (dolist (messenger (log-manager-messengers previous)) (stop-messenger messenger)))

[Assistant]
(defmacro when-let (binding &body body)
  (destructuring-bind (var val) binding
    `(let ((,var ,val))
       (when ,var
	 ,@body))))

;; macroexpand:
(let ((previous *log-manager*)) (when previous (dolist (messenger (log-manager-messengers previous)) (stop-messenger messenger))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defun/1 fmod (x y) (mod x y))

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

(defun/1 fmod (x y) (mod x y))

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

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

;; macroexpand:
(progn (defun fmod (x y) (declare (optimize (speed 0) (debug 3) (sb-ext:inhibit-warnings 3))) (mod x y)) (defparameter fmod (vacietis.c:mkptr& (symbol-function (quote fmod)))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-condition/a dbi-integrity-error (dbi-database-error) () (:documentation "Exception raised when the relational integrity of the database is affected, e.g. a foreign key check fails."))

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

(define-condition/a dbi-integrity-error (dbi-database-error) () (:documentation "Exception raised when the relational integrity of the database is affected, e.g. a foreign key check fails."))

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

;; macroexpand:
(progn (define-condition dbi-integrity-error (dbi-database-error) nil (:documentation "Exception raised when the relational integrity of the database is affected, e.g. a foreign key check fails.")) (deftype <dbi-integrity-error> nil (quote dbi-integrity-error)) (setf (find-class (quote <dbi-integrity-error>)) (find-class (quote dbi-integrity-error))))


[User]
Write a Common Lisp macro to handle this code pattern:
(product-of nil
  (progn))

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

(product-of nil
  (progn))

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

;; macroexpand:
(lc (nil (progn)) multiply)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-element-maker :line "line" '(:x1 :y1 :x2 :y2))

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

(define-element-maker :line "line" '(:x1 :y1 :x2 :y2))

[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 :line)) attributes) (declare (ignore element)) (unless (evenp (length attributes)) (warn "attribute list may be missing data: ~A" attributes)) (let ((missing (set-difference (quote (:x1 :y1 :x2 :y2)) attributes))) (when missing (error (quote missing-attributes) :message (format nil "~A missing attributes: ~{~A~^ ~}" :line missing))))) (defmethod make-svg-element ((element (eql :line)) attributes) (when *check-required-attributes* (assert-required-attributes element attributes)) (make-instance (quote svg-element) :name "line" :attributes attributes)))


[User]
Generate a defmacro form that transforms code like this:
(make-$instance nil (progn))

Pattern to recognize: Macro call that should be transformed by MAKE-$INSTANCE

(make-$instance nil (progn))

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

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


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

Issue: Macro call that should be transformed by FN

(fn nil)

[Assistant]
(defmacro FN ...)

;; macroexpand:
(lambda () nil)


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

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

(define-modf-rewrite cddar (expr) `(cdr (cdar ,(second expr))))

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

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