[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-yield-binds (format nil "~A ~A ~A" (if (sql-statement-p (infix-op-left op)) (yield (make-sql-list (infix-op-left op))) (yield (infix-op-left op))) (sql-op-name op) (if (sql-statement-p (infix-op-right op)) (yield (make-sql-list (infix-op-right op))) (yield (infix-op-right op)))))

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

(with-yield-binds (format nil "~A ~A ~A" (if (sql-statement-p (infix-op-left op)) (yield (make-sql-list (infix-op-left op))) (yield (infix-op-left op))) (sql-op-name op) (if (sql-statement-p (infix-op-right op)) (yield (make-sql-list (infix-op-right op))) (yield (infix-op-right op)))))

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

;; macroexpand:
(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "~A ~A ~A" (if (sql-statement-p (infix-op-left op)) (yield (make-sql-list (infix-op-left op))) (yield (infix-op-left op))) (sql-op-name op) (if (sql-statement-p (infix-op-right op)) (yield (make-sql-list (infix-op-right op))) (yield (infix-op-right op))))) (loop for bind in (reverse *bind-values*) append bind)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defalias path:catdir (&rest pathnames) cl-fad:merge-pathnames-as-directory)

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

(defalias path:catdir (&rest pathnames) cl-fad:merge-pathnames-as-directory)

[Assistant]
(defmacro defalias (name args realname)
  `(progn
     (defun ,name ,args
       ,(if (eql '&rest (first args))
            `(apply #',realname ,(second args))
            `(,realname ,@args)))
     (define-compiler-macro ,name (&rest args)
       (list* ',realname args))))

;; macroexpand:
(progn (defun path:catdir (&rest pathnames) (apply (function merge-pathnames-as-directory) pathnames)) (define-compiler-macro path:catdir (&rest args) (list* (quote merge-pathnames-as-directory) args)))


[User]
Write a Common Lisp macro to handle this code pattern:
(defalias path:catfile (&rest pathnames) cl-fad:merge-pathnames-as-file)

Problem: Macro call that should be transformed by defalias

(defalias path:catfile (&rest pathnames) cl-fad:merge-pathnames-as-file)

[Assistant]
(defmacro defalias (name args realname)
  `(progn
     (defun ,name ,args
       ,(if (eql '&rest (first args))
            `(apply #',realname ,(second args))
            `(,realname ,@args)))
     (define-compiler-macro ,name (&rest args)
       (list* ',realname args))))

;; macroexpand:
(progn (defun path:catfile (&rest pathnames) (apply (function merge-pathnames-as-file) pathnames)) (define-compiler-macro path:catfile (&rest args) (list* (quote merge-pathnames-as-file) args)))


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

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

(dynamic-wind
  nil
  nil)

[Assistant]
(defmacro DYNAMIC-WIND ...)

;; macroexpand:
(flet ((#:dynamic-wind-thunk219 (#:proceed-thunk220)
         (macrolet ((proceed (&body #:proceed-body221)
                      `(if ,'#:proceed-thunk220
                           (funcall (the function ,'#:proceed-thunk220))
                           (progn ,@#:proceed-body221))))
           nil
           nil)))
  (declare (inline #:dynamic-wind-thunk219))
  (let ((*dynamic-wind-stack*
         (cons #'#:dynamic-wind-thunk219 *dynamic-wind-stack*)))
    (#:dynamic-wind-thunk219 nil)))


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

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

(dletf nil
  (progn))

[Assistant]
(defmacro DLETF ...)

;; macroexpand:
(special-symbol-progv (with-symbol-access
                        (list))
    (list)
  (locally (declare (special)) (progn)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-wcs-math-error-handling (ret (log x (float 2 x))) (check-wcs-math-result))

Write a macro that addresses: Macro call that should be transformed by with-wcs-math-error-handling

(with-wcs-math-error-handling (ret (log x (float 2 x))) (check-wcs-math-result))

[Assistant]
(defmacro with-wcs-math-error-handling
    ((var-or-var-list
      (function x &optional (y nil y-supplied-p))
      &rest keyargs
      &key underflow-value)
     &body body)
  (declare (ignorable underflow-value))
  (let ((x_ (gensym)) (y_ (gensym)) (args_ (gensym))
        (var-list (ensure-list var-or-var-list)))
    `(let* ((,x_ ,x)
            (,y_ ,y)
            (,args_ (list ,x_ ,@(if y-supplied-p `(,y_)))))
       (declare (ignorable ,y_)
                (type list ,args_)
                (dynamic-extent ,args_))
       (catch 'return-from-with-wcs-math-error-handling
         (multiple-value-bind ,var-list
             (call-with-wcs-math-error-handler ',function ,args_
                                               ,@keyargs)
           (flet ((check-wcs-math-result
                      (&optional (ret ,(first var-list))
                                 (arg-list ,args_))
                    (check-wcs-math-result ret arg-list)))
             ,@body))))))

;; macroexpand:
(let* ((#:g230 x) (#:g231 (float 2 x)) (#:g232 (list #:g230 #:g231))) (declare (ignorable #:g231) (type list #:g232) (dynamic-extent #:g232)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (ret) (call-with-wcs-math-error-handler (quote log) #:g232) (flet ((check-wcs-math-result (&optional (ret ret) (arg-list #:g232)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result)))))


[User]
Generate a defmacro form that transforms code like this:
(do+ (options :atomic-updates nil) (for x (across #(1 2 3 4) :index index)) (for k (in '(a b c d e))) (returning (list x k :index index)))

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

(do+ (options :atomic-updates nil) (for x (across #(1 2 3 4) :index index)) (for k (in '(a b c d e))) (returning (list x k :index index)))

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

;; macroexpand:
(do+/internal nil (options :atomic-updates nil) (for x (across #(1 2 3 4) :index index)) (for k (in (quote (a b c d e)))) (returning (list x k :index index)))


[User]
Generate a defmacro form that transforms code like this:
(define-custom-var (:symbols-package *json-symbols-package*) (find-package 'keyword))

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

(define-custom-var (:symbols-package *json-symbols-package*) (find-package 'keyword))

[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 (*json-symbols-package* . :symbols-package)) *custom-vars* :test (function equal)) (defvar *json-symbols-package* (find-package (quote keyword)))))


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

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

(-<>> nil nil)

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

;; macroexpand:
(->> nil nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-generic generic ((a a) (b b) &key (c nil) &allow-other-keys) (+ a b))

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

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

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

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

Example:

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

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

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-value-binding table-keys (var table &aux (iterator (hash-table-iterator table)) next key val) (declare (type hash-table table) (type function iterator)) `(multiple-value-bind (,next ,key ,val) (funcall ,iterator) (declare (ignore ,val)) (if ,next (update ,var ,key) (end-for))))

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

(define-value-binding table-keys (var table &aux (iterator (hash-table-iterator table)) next key val) (declare (type hash-table table) (type function iterator)) `(multiple-value-bind (,next ,key ,val) (funcall ,iterator) (declare (ignore ,val)) (if ,next (update ,var ,key) (end-for))))

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

;; macroexpand:
(define-direct-binding table-keys (var table) (let ((#:iterator145 (gensym #A((8) base-char . "ITERATOR"))) (#:next146 (gensym #A((4) base-char . "NEXT"))) (#:key147 (gensym #A((3) base-char . "KEY"))) (#:val148 (gensym #A((3) base-char . "VAL"))) (#:table144 (gensym #A((5) base-char . "TABLE")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:table144 table) (list #:iterator145 (list (quote hash-table-iterator) #:table144)) (list #:next146 nil) (list #:key147 nil) (list #:val148 nil) (loop for #:var143 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var143 nil))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:iterator145 :kind 0) #S(sb-impl::comma :expr #:next146 :kind 0) #S(sb-impl::comma :expr #:key147 :kind 0) #S(sb-impl::comma :expr #:val148 :kind 0) #S(sb-impl::comma :expr #:table144 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote hash-table) :kind 0) #S(sb-impl::comma :expr #:table144 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote function) :kind 0) #S(sb-impl::comma :expr #:iterator145 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((iterator #:iterator145) (next #:next146) (key #:key147) (val #:val148) (table #:table144)) (declare (ignorable iterator next key val table)) (sb-int:quasiquote (multiple-value-bind (#S(sb-impl::comma :expr next :kind 0) #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr val :kind 0)) (funcall #S(sb-impl::comma :expr iterator :kind 0)) (declare (ignore #S(sb-impl::comma :expr val :kind 0))) (if #S(sb-impl::comma :expr next :kind 0) (update #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr key :kind 0)) (end-for))))))))


[User]
Define a macro that eliminates this repetitive pattern:
(defgenerator cycle (list-or-gen) "Repeatedly cycles through a list or generator, yielding its elements indefinitely. Eg: (cycle '(a b c d)) -> a b c d a b c d a b ... Note that this tool may consume considerable storage if the source iterable is long." (let ((data (cond ((generatorp list-or-gen) (let ((accum nil)) (do-generator (g list-or-gen) (yield g) (push g accum)) (nreverse accum))) ((listp list-or-gen) list-or-gen) (t (error "Gen must be a list or generator"))))) (loop do (dolist (x data) (yield x)))))

Issue: Macro call that should be transformed by defgenerator

(defgenerator cycle (list-or-gen) "Repeatedly cycles through a list or generator, yielding its elements indefinitely. Eg: (cycle '(a b c d)) -> a b c d a b c d a b ... Note that this tool may consume considerable storage if the source iterable is long." (let ((data (cond ((generatorp list-or-gen) (let ((accum nil)) (do-generator (g list-or-gen) (yield g) (push g accum)) (nreverse accum))) ((listp list-or-gen) list-or-gen) (t (error "Gen must be a list or generator"))))) (loop do (dolist (x data) (yield x)))))

[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 cycle (list-or-gen) "Repeatedly cycles through a list or generator, yielding its elements indefinitely. Eg: (cycle '(a b c d)) -> a b c d a b c d a b ... Note that this tool may consume considerable storage if the source iterable is long." (with-yield (let ((data (cond ((generatorp list-or-gen) (let ((accum nil)) (do-generator (g list-or-gen) (yield g) (push g accum)) (nreverse accum))) ((listp list-or-gen) list-or-gen) (t (error "Gen must be a list or generator"))))) (loop do (dolist (x data) (yield x))))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-accumulation-binding minimizing (var form &key key) (let ((result (gensym "RESULT"))) `(let ((,result ,form)) (when (or (not ,var) (< ,(if key `(funcall ,key ,result) result) ,(if key `(funcall ,key ,var) var))) (setf ,var ,result)))))

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

(define-accumulation-binding minimizing (var form &key key) (let ((result (gensym "RESULT"))) `(let ((,result ,form)) (when (or (not ,var) (< ,(if key `(funcall ,key ,result) result) ,(if key `(funcall ,key ,var) var))) (setf ,var ,result)))))

[Assistant]
(defmacro define-accumulation-binding (name (var &rest args) &body body)
  `(define-form-binding ,name (,var ,@args)
     ,@(form-fiddle:lambda-declarations `(lambda () ,@body))
     (values
      (progn ,@(form-fiddle:lambda-forms `(lambda () ,@body)))
      (delist var))))

;; macroexpand:
(define-form-binding minimizing (var form &key key) (values (progn (let ((result (gensym "RESULT"))) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr result :kind 0) #S(sb-impl::comma :expr form :kind 0))) (when (or (not #S(sb-impl::comma :expr var :kind 0)) (< #S(sb-impl::comma :expr (if key (sb-int:quasiquote (funcall #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr result :kind 0))) result) :kind 0) #S(sb-impl::comma :expr (if key (sb-int:quasiquote (funcall #S(sb-impl::comma :expr key :kind 0) #S(sb-impl::comma :expr var :kind 0))) var) :kind 0))) (setf #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr result :kind 0))))))) (delist var)))


[User]
Write a Common Lisp macro to handle this code pattern:
(builder :session (lambda (env) (if (equal (getf env :path-info) "/delayed-expire") (lambda (responder) (setf (getf (getf env :lack.session.options) :expire) t) (funcall responder '(200 () ("hi")))) (lambda (responder) (funcall responder '(200 () "hi"))))))

Problem: Macro call that should be transformed by builder

(builder :session (lambda (env) (if (equal (getf env :path-info) "/delayed-expire") (lambda (responder) (setf (getf (getf env :lack.session.options) :expire) t) (funcall responder '(200 () ("hi")))) (lambda (responder) (funcall responder '(200 () "hi"))))))

[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 (find-middleware :session))) :initial-value (to-app (lambda (env) (if (equal (getf env :path-info) "/delayed-expire") (lambda (responder) (setf (getf (getf env :lack.session.options) :expire) t) (funcall responder (quote (200 nil ("hi"))))) (lambda (responder) (funcall responder (quote (200 nil "hi"))))))) :from-end t)


[User]
Write a Common Lisp macro to handle this code pattern:
(def-iter ignored-backing-name (curr-val step) (count (start step) (init-state (curr-val start) step)) (prog1 curr-val (incf curr-val step)))

Problem: Macro call that should be transformed by def-iter

(def-iter ignored-backing-name (curr-val step) (count (start step) (init-state (curr-val start) step)) (prog1 curr-val (incf curr-val step)))

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

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

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

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

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

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

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

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

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

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

;; macroexpand:
(labels ((#:next-fname129 (&key curr-val step) (labels ((self nil (prog1 curr-val (incf curr-val step)))) (function self)))) (defun count (start step) "Function had no docstring, so this one was inserted" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname129)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (init-state (curr-val start) step))))


[User]
Generate a defmacro form that transforms code like this:
(defgenerator islice (generator stop-or-start &optional (stop nil has-stop-p) step) "Emits a subrange of generator. If only stop-or-start is set, islice will emit up to it and stop. If both stop-or-start and stop are set, islice will emit the stretch between stop and start. If step is set, then islice will emit every step-th item between start and stop. If stop is set to nil, then islice will continue through the source generator until it terminates. Eg: (islice (list->generator '(a b c d e f g)) 2) -> A B (islice (list->generator '(a b c d e f g)) 2 4) -> C D (islice (list->generator '(a b c d e f g)) 2 nil) -> C D E F G (islice (list->generator '(a b c d e f g)) 0 nil 2) -> A C E G" (let ((start (if has-stop-p stop-or-start nil)) (stop (or stop (unless has-stop-p stop-or-start))) (step (or step 1))) (when start (consume start generator)) (if stop (dotimes (i (floor (/ (- stop (or start 0)) step))) (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))) (loop do (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))))))

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

(defgenerator islice (generator stop-or-start &optional (stop nil has-stop-p) step) "Emits a subrange of generator. If only stop-or-start is set, islice will emit up to it and stop. If both stop-or-start and stop are set, islice will emit the stretch between stop and start. If step is set, then islice will emit every step-th item between start and stop. If stop is set to nil, then islice will continue through the source generator until it terminates. Eg: (islice (list->generator '(a b c d e f g)) 2) -> A B (islice (list->generator '(a b c d e f g)) 2 4) -> C D (islice (list->generator '(a b c d e f g)) 2 nil) -> C D E F G (islice (list->generator '(a b c d e f g)) 0 nil 2) -> A C E G" (let ((start (if has-stop-p stop-or-start nil)) (stop (or stop (unless has-stop-p stop-or-start))) (step (or step 1))) (when start (consume start generator)) (if stop (dotimes (i (floor (/ (- stop (or start 0)) step))) (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))) (loop do (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))))))

[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 islice (generator stop-or-start &optional (stop nil has-stop-p) step) "Emits a subrange of generator. If only stop-or-start is set, islice will emit up to it and stop. If both stop-or-start and stop are set, islice will emit the stretch between stop and start. If step is set, then islice will emit every step-th item between start and stop. If stop is set to nil, then islice will continue through the source generator until it terminates. Eg: (islice (list->generator '(a b c d e f g)) 2) -> A B (islice (list->generator '(a b c d e f g)) 2 4) -> C D (islice (list->generator '(a b c d e f g)) 2 nil) -> C D E F G (islice (list->generator '(a b c d e f g)) 0 nil 2) -> A C E G" (with-yield (let ((start (if has-stop-p stop-or-start nil)) (stop (or stop (unless has-stop-p stop-or-start))) (step (or step 1))) (when start (consume start generator)) (if stop (dotimes (i (floor (/ (- stop (or start 0)) step))) (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data)))) (loop do (let ((data (take step generator :fail-if-short nil))) (unless data (return)) (yield (car data))))))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-error invalid-function-return-spec () (func spec) "Return type spec of function ~a is invalid:~%~a" func spec)

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

(define-error invalid-function-return-spec () (func spec) "Return type spec of function ~a is invalid:~%~a" func spec)

[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 invalid-function-return-spec (:error-type varjo-error :prefix "Varjo") (func spec) "Return type spec of function ~a is invalid:~%~a" func spec)


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

Issue: Macro call that should be transformed by is

(is (= 0 (add-2 -2)))

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

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

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

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

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

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


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

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

(is (not (plusp -1)))

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

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

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

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

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

;; macroexpand:
(let ((#:v184 -1)) (if (not (plusp #:v184)) (add-result (quote test-passed) :test-expr (quote (not (plusp -1)))) (process-failure (quote (not (plusp -1))) "~2&~S~2% evaluated to ~2&~S~2% which satisfies ~2&~S~2% (it should not)" (quote -1) #:v184 (quote plusp))))


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

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

(is-true nil)

[Assistant]
(defmacro is-true (condition &rest reason-args)
  "Like IS this check generates a pass if CONDITION returns true
  and a failure if CONDITION returns false. Unlike IS this check
  does not inspect CONDITION to determine how to report the
  failure."
  `(if ,condition
       (add-result 'test-passed :test-expr ',condition)
       (process-failure ',condition
                        ,@(or reason-args
                              `("~S did not return a true value" ',condition)))))

;; macroexpand:
(if nil (add-result (quote test-passed) :test-expr (quote nil)) (process-failure (quote nil) "~S did not return a true value" (quote nil)))


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

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

(lambda (quote some-name))

[Assistant]
(defmacro LAMBDA ...)

;; macroexpand:
#'(lambda (quote some-name))


[User]
Generate a defmacro form that transforms code like this:
(augment step-code prev-code)

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

(augment step-code prev-code)

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

;; macroexpand:
(setf step-code (nconc step-code prev-code))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(some-<>> (diamond-wand init (cddr exp) t t))

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

(some-<>> (diamond-wand init (cddr exp) t t))

[Assistant]
(defmacro some-<> (init &body exps) (diamond-wand init exps nil t))

;; macroexpand:
(block #:g127 (diamond-wand init (cddr exp) t t))


[User]
Write a Common Lisp macro to handle this code pattern:
(bind (((:labels doit (x)) "if I knew how to get the docstring out of flet, I'd test it." (setf x (* 2 x)) (setf x (+ x 3)) x)) (ensure-same (doit 1) 5) (ensure-same (doit 2) 7))

Problem: Macro call that should be transformed by bind

(bind (((:labels doit (x)) "if I knew how to get the docstring out of flet, I'd test it." (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) "if I knew how to get the docstring out of flet, I'd test it." (progn (setf x (* 2 x)) (setf x (+ x 3)) x))) (progn (ensure-same (doit 1) 5) (ensure-same (doit 2) 7)))


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

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

(case nil)

[Assistant]
(defmacro CASE ...)

;; macroexpand:
(let ((#:nil nil))
  (declare (ignorable #:nil))
  (cond))


[User]
Generate a defmacro form that transforms code like this:
(with-ps-gensyms nil
  :key
  nil)

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

(with-ps-gensyms nil
  :key
  nil)

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-expander slot-value 1 (expr val new-val) `(let ((new (copy-instance ,val))) (setf (slot-value new ,(third expr)) ,new-val) new))

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

(define-modf-expander slot-value 1 (expr val new-val) `(let ((new (copy-instance ,val))) (setf (slot-value new ,(third expr)) ,new-val) new))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote slot-value) *modf-nth-arg*) 1 (gethash (quote slot-value) *modf-expansions*) (lambda (expr val new-val) (sb-int:quasiquote (let ((new (copy-instance #S(sb-impl::comma :expr val :kind 0)))) (setf (slot-value new #S(sb-impl::comma :expr (third expr) :kind 0)) #S(sb-impl::comma :expr new-val :kind 0)) new)))))


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

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

(define-macro nil
    :key
    nil)

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf (get 'nil ':key)
          (lambda (#:whole122 #:no-environment)
            (declare (ignorable #:no-environment))
            (handler-case
             (destructuring-bind
                 (#:namevar123)
                 #:whole122
               (declare (ignore #:namevar123)))
             (error (e) (error 'foo-syntax-error :form #:whole122 :cause e))))))


[User]
Generate a defmacro form that transforms code like this:
(letrec* ((f (constantly t)) (a (funcall f))) (is-true a))

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

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

[Assistant]
(defmacro letrec ((&rest bindings) &body body)
  "Recursive LET.
The idea is that functions created in BINDINGS can close over one
another, and themselves.

Note that `letrec' only binds variables: it can define recursive
functions, but can't bind them as functions. (But see `fbindrec'.)"
  `(letrec-with psetq ,bindings
     ,@body))

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


[User]
Write a Common Lisp macro to handle this code pattern:
(with-env [assoc-list 'a])

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

(with-env [assoc-list 'a])

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

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


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

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

(with-unbuilder 'some-name)

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

;; macroexpand:
(flet ((with-builder-thunk (quote)
         ))
  (declare (dynamic-extent (function with-builder-thunk)))
  (call-with-unbuilder some-name #'with-builder-thunk))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(when (and (first first-statement) (eql (first parent-node) 'compound-statement) (eql (- level (first curr-level)) 2)) (let ((count (length nodes))) (setf (first first-statement) nil) (setf (first statement-count) (max count (first statement-count)))))

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

(when (and (first first-statement) (eql (first parent-node) 'compound-statement) (eql (- level (first curr-level)) 2)) (let ((count (length nodes))) (setf (first first-statement) nil) (setf (first statement-count) (max count (first statement-count)))))

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

;; macroexpand:
(if (and (first first-statement) (eql (first parent-node) (quote compound-statement)) (eql (- level (first curr-level)) 2)) (let ((count (length nodes))) (setf (first first-statement) nil) (setf (first statement-count) (max count (first statement-count)))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defun-speedy read-until-crlf*2 (stream) (with-fast-output (buf) (tagbody read-cr (loop for byte of-type (or (unsigned-byte 8) null) = (read-byte stream nil nil) if byte do (fast-write-byte byte buf) else do (go eof) until (= byte (char-code #\Return))) read-lf (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf) (go read-cr2)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (T (fast-write-byte next-byte buf) (go read-cr))))) read-cr2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf2)) (T (fast-write-byte next-byte buf) (go read-cr))))) read-lf2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (T (fast-write-byte next-byte buf) (go read-cr))))) eof)))

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

(defun-speedy read-until-crlf*2 (stream) (with-fast-output (buf) (tagbody read-cr (loop for byte of-type (or (unsigned-byte 8) null) = (read-byte stream nil nil) if byte do (fast-write-byte byte buf) else do (go eof) until (= byte (char-code #\Return))) read-lf (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf) (go read-cr2)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (T (fast-write-byte next-byte buf) (go read-cr))))) read-cr2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf2)) (T (fast-write-byte next-byte buf) (go read-cr))))) read-lf2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (T (fast-write-byte next-byte buf) (go read-cr))))) eof)))

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

;; macroexpand:
(progn (declaim (notinline read-until-crlf*2)) (defun read-until-crlf*2 (stream) (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0))) (with-fast-output (buf) (tagbody read-cr (loop for byte of-type (or (unsigned-byte 8) null) = (read-byte stream nil nil) if byte do (fast-write-byte byte buf) else do (go eof) until (= byte (char-code #\Return))) read-lf (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf) (go read-cr2)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (t (fast-write-byte next-byte buf) (go read-cr))))) read-cr2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf2)) (t (fast-write-byte next-byte buf) (go read-cr))))) read-lf2 (let ((next-byte (read-byte stream nil nil))) (unless next-byte (go eof)) (locally (declare (type (unsigned-byte 8) next-byte)) (cond ((= next-byte (char-code #\Newline)) (fast-write-byte next-byte buf)) ((= next-byte (char-code #\Return)) (fast-write-byte next-byte buf) (go read-lf)) (t (fast-write-byte next-byte buf) (go read-cr))))) eof))))


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

Problem: Macro call that should be transformed by F

(f nil)

[Assistant]
(defmacro F ...)

;; macroexpand:
(lambda ())


[User]
Generate a defmacro form that transforms code like this:
(define-custom-var (:object-value *object-value-handler*) (constantly t) "Designator for a function of 1 arbitrary argument (decoded member value of Object).")

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

(define-custom-var (:object-value *object-value-handler*) (constantly t) "Designator for a function of 1 arbitrary argument (decoded member value of Object).")

[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 (*object-value-handler* . :object-value)) *custom-vars* :test (function equal)) (defvar *object-value-handler* (constantly t) "Designator for a function of 1 arbitrary argument (decoded member value of Object).")))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defclass/a dbd-null-connection (cl-dbi:dbi-connection) ())

What needs to change: Macro call that should be transformed by defclass/a

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

[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-connection (dbi.driver:dbi-connection) nil) (deftype <dbd-null-connection> nil (quote dbd-null-connection)) (setf (find-class (quote <dbd-null-connection>)) (find-class (quote dbd-null-connection))))


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

Problem: Macro call that should be transformed by PRODUCING

(producing)

[Assistant]
(defmacro PRODUCING ...)

;; macroexpand:
(non-opt-producing)


[User]
Generate a defmacro form that transforms code like this:
(do+ (for x (in '(1 2 3 4))) (for y (previous x)) (for z (previous y)) (collect (list x y z)))

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

(do+ (for x (in '(1 2 3 4))) (for y (previous x)) (for z (previous y)) (collect (list x y z)))

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

;; macroexpand:
(do+/internal nil (for x (in (quote (1 2 3 4)))) (for y (previous x)) (for z (previous y)) (collect (list x y z)))


[User]
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time indirect-callees (function-name) (indirect-callees-internal (callees function-name) '()))

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(define-alias-binding reduce reducing)

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

(define-alias-binding reduce reducing)

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

;; macroexpand:
(progn (setf (binding (quote reduce)) (quote reducing)) (quote reduce))


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

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

(check-cursor-attached cluffer:beginning-of-line (cursor))

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

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


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

Write a macro that addresses: Macro call that should be transformed by ENABLE-QUASI-QUOTED-STRING-SYNTAX

(enable-quasi-quoted-string-syntax)

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

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


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

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

(with-collectors 'some-name)

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

;; macroexpand:
(with-collector (quote)
  (with-collectors (some-name)))


[User]
Write a Common Lisp macro to handle this code pattern:
(defclause being (form &key (then form)) "Assigns to the iteration variable a value computed by evaluating FORM on each iteration, including the first. Optionally, the variable can be updated evaluating a differen form (the value of the `then' parameter). Examples: (for x (being (random))), (for y (being 'quiet :then (if (> x 0.5) 'angry 'quiet)))." (make-simple-iteration :init form :step then))

Problem: Macro call that should be transformed by defclause

(defclause being (form &key (then form)) "Assigns to the iteration variable a value computed by evaluating FORM on each iteration, including the first. Optionally, the variable can be updated evaluating a differen form (the value of the `then' parameter). Examples: (for x (being (random))), (for y (being 'quiet :then (if (> x 0.5) 'angry 'quiet)))." (make-simple-iteration :init form :step then))

[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 being (form &key (then form)) "Assigns to the iteration variable a value computed by evaluating FORM on each iteration, including the first. Optionally, the variable can be updated evaluating a differen form (the value of the `then' parameter). Examples: (for x (being (random))), (for y (being 'quiet :then (if (> x 0.5) 'angry 'quiet)))." (make-simple-iteration :init form :step then)) (pushnew (quote being) *clauses*))


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

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

(->> (v) (flow-gen v))

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

;; macroexpand:
(dynamically (v) (flow-gen v))


[User]
Generate a defmacro form that transforms code like this:
(define-custom-var (:beginning-of-array *beginning-of-array-handler*) (constantly t) "Designator for a function of no arguments (called at encountering an opening bracket for an Array).")

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

(define-custom-var (:beginning-of-array *beginning-of-array-handler*) (constantly t) "Designator for a function of no arguments (called at encountering an opening bracket for an Array).")

[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-array-handler* . :beginning-of-array)) *custom-vars* :test (function equal)) (defvar *beginning-of-array-handler* (constantly t) "Designator for a function of no arguments (called at encountering an opening bracket for an Array).")))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-preprocessor-state-slots (state) (let ((i-state (pop include-stack))) (unless (eql if-section-stack (saved-include-state-if-section-stack i-state)) (error 'preprocess-error :format-control "#if section does not end in included file ~A" :format-arguments (list file-pathname))) (setf *package* (saved-include-state-package i-state) *readtable* (saved-include-state-readtable i-state) ) i-state))

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

(with-preprocessor-state-slots (state) (let ((i-state (pop include-stack))) (unless (eql if-section-stack (saved-include-state-if-section-stack i-state)) (error 'preprocess-error :format-control "#if section does not end in included file ~A" :format-arguments (list file-pathname))) (setf *package* (saved-include-state-package i-state) *readtable* (saved-include-state-readtable i-state) ) i-state))

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

;; macroexpand:
(with-accessors ((file-pathname pp-state-file-pathname) (token-list pp-state-token-list) (result-list pp-state-result-list) (line-number pp-state-line-number) (tokens-in-line pp-state-tokens-in-line) (macro-alist pp-state-macro-alist) (if-section-stack pp-state-if-section-stack) (if-section-skip-reason pp-state-if-section-skip-reason) (include-stack pp-state-include-stack)) state (let ((i-state (pop include-stack))) (unless (eql if-section-stack (saved-include-state-if-section-stack i-state)) (error (quote preprocess-error) :format-control "#if section does not end in included file ~A" :format-arguments (list file-pathname))) (setf *package* (saved-include-state-package i-state) *readtable* (saved-include-state-readtable i-state)) i-state))


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

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

(dynenv-macrolet nil
  (progn))

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

;; macroexpand:
(macrolet ()
  (progn))


[User]
Write a Common Lisp macro to handle this code pattern:
(*> +any-space+ +skip-all-space+ +pairs+)

Problem: Macro call that should be transformed by *>

(*> +any-space+ +skip-all-space+ +pairs+)

[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 (#:*>-offset254) (multiple-value-bind (#:*>-res257 #:*>-next258) (multiple-value-bind (#:*>-res255 #:*>-next256) (funcall +any-space+ #:*>-offset254) (if (ok? #:*>-res255) (funcall +skip-all-space+ #:*>-next256) (fail #:*>-next256))) (if (ok? #:*>-res257) (funcall +pairs+ #:*>-next258) (fail #:*>-next258))))


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

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

(-<>> nil (progn))

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

;; macroexpand:
(->> nil (progn))


[User]
Define a macro that eliminates this repetitive pattern:
(define-direct-binding when (var test sub-binding &rest args) (multiple-value-bind (init body value) (apply (binding sub-binding) var args) (values init `(when ,test ,body) value)))

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

(define-direct-binding when (var test sub-binding &rest args) (multiple-value-bind (init body value) (apply (binding sub-binding) var args) (values init `(when ,test ,body) value)))

[Assistant]
(defmacro define-direct-binding (name args &body body)
  (let ((env (or (lambda-fiddle:environment-lambda-var args) (gensym "ENVIRONMENT"))))
    `(progn (setf (binding ',name)
                  (lambda ,(lambda-fiddle:remove-environment-part args)
                    (let ((,env *environment*))
                      (declare (ignorable ,env))
                      ,@body)))
            ',name)))

;; macroexpand:
(progn (setf (binding (quote when)) (lambda (var test sub-binding &rest args) (let ((#:environment125 *environment*)) (declare (ignorable #:environment125)) (multiple-value-bind (init body value) (apply (binding sub-binding) var args) (values init (sb-int:quasiquote (when #S(sb-impl::comma :expr test :kind 0) #S(sb-impl::comma :expr body :kind 0))) value))))) (quote when))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-function getf 2 (new-val plist key) (let ((new-plist (copy-list plist))) (setf (getf new-plist key) new-val) new-plist))

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

(define-modf-function getf 2 (new-val plist key) (let ((new-plist (copy-list plist))) (setf (getf new-plist key) new-val) new-plist))

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

;; macroexpand:
(progn (eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote getf) *modf-nth-arg*) 2)) (defun |BUILDER:COMMON-LISP:GETF| (new-val plist key) (let ((new-plist (copy-list plist))) (setf (getf new-plist key) new-val) new-plist)))


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

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(with-flow-function-macro (body-fu lambda-list body) `(dispatch-dynamically ,flow-context #',body-fu))

Issue: Macro call that should be transformed by with-flow-function-macro

(with-flow-function-macro (body-fu lambda-list body) `(dispatch-dynamically ,flow-context #',body-fu))

[Assistant]
(defmacro with-flow-function-macro ((fu-name fu-lambda-list fu-body) &body body)
  `(with-gensyms (,fu-name)
     `(%with-flow-function (,,fu-name ,,fu-lambda-list ,@,fu-body)
        ,,@body)))

;; macroexpand:
(with-gensyms (body-fu) (sb-int:quasiquote (%with-flow-function (#S(sb-impl::comma :expr body-fu :kind 0) #S(sb-impl::comma :expr lambda-list :kind 0) #S(sb-impl::comma :expr body :kind 2)) #S(sb-impl::comma :expr (sb-int:quasiquote (dispatch-dynamically #S(sb-impl::comma :expr flow-context :kind 0) (function #S(sb-impl::comma :expr body-fu :kind 0)))) :kind 0))))


[User]
Define a macro that eliminates this repetitive pattern:
(is = 5 5)

Issue: Macro call that should be transformed by is

(is = 5 5)

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

;; macroexpand:
(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (is = 5 5)) :value-form (quote 5) :body (lambda nil 5) :expected 5 :comparison (quote =)))


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

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

(collecting 'some-name)

[Assistant]
(defmacro COLLECTING ...)

;; macroexpand:
(with-collector-output (output)
  (dolist (quote (alexandria:ensure-list some-name))
    (restart-case (output (progn))
      (skip nil "Skip this element"))))


[User]
Generate a defmacro form that transforms code like this:
(with-capped-stack () (make-instance 'environment :condition condition))

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

(with-capped-stack () (make-instance 'environment :condition condition))

[Assistant]
(defmacro with-capped-stack (() &body body)
  `(stack-capper (lambda () ,@body)))

;; macroexpand:
(stack-capper (lambda nil (make-instance (quote environment) :condition condition)))


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

Problem: Macro call that should be transformed by ->

(-> :g () 1)

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

;; macroexpand:
(atomically :g nil 1)


[User]
Write a Common Lisp macro to handle this code pattern:
(with-html-string (:body (:h* "This is a top level heading") (:p "...") (:section (:p "...") (:h* "This is a second-level heading") (:p "...") (:h* "This is another second-level heading") (:p "...") (:section (:h* "This is a third-level heading") (:p "...")))))

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

(with-html-string (:body (:h* "This is a top level heading") (:p "...") (:section (:p "...") (:h* "This is a second-level heading") (:p "...") (:h* "This is another second-level heading") (:p "...") (:section (:h* "This is a third-level heading") (:p "...")))))

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

;; macroexpand:
(with-output-to-string (*html*) (with-html (:body (:h* "This is a top level heading") (:p "...") (:section (:p "...") (:h* "This is a second-level heading") (:p "...") (:h* "This is another second-level heading") (:p "...") (:section (:h* "This is a third-level heading") (:p "..."))))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(deferror "57P03" cannot-connect-now operator-intervention)

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

(deferror "57P03" cannot-connect-now operator-intervention)

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

;; macroexpand:
(progn (define-condition cannot-connect-now (operator-intervention) nil) (setf (gethash "57P03" *error-table*) (quote cannot-connect-now)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(is-type 1 'string)

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

(is-type 1 'string)

[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 ((#:desc179 nil) (#:expected-type180 (quote string))) (with-catching-errors (:description #:desc179 :expected #:expected-type180) (with-duration ((#:duration177 #:result178) 1) (test #:result178 #:expected-type180 #:desc179 :duration #:duration177 :got-form (quote 1) :test-fn (function typep) :report-expected-label "be a type of"))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-element-maker :group "g" '())

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

(define-element-maker :group "g" '())

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


[User]
You are a Common Lisp macro expert. Given this code pattern:
(multiple-value-prog2 (values 1 1 1) (values 2 20 200) (values 3 3 3))

Write a macro that addresses: Macro call that should be transformed by multiple-value-prog2

(multiple-value-prog2 (values 1 1 1) (values 2 20 200) (values 3 3 3))

[Assistant]
(defmacro multiple-value-prog2 (first-form second-form &body forms)
  "Evaluates FIRST-FORM, then SECOND-FORM, and then FORMS. Yields as its value
all the value returned by SECOND-FORM."
  `(progn ,first-form (multiple-value-prog1 ,second-form ,@forms)))

;; macroexpand:
(progn (values 1 1 1) (multiple-value-prog1 (values 2 20 200) (values 3 3 3)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(assoc-cdr :token--endpoint disc)

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

(assoc-cdr :token--endpoint disc)

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

;; macroexpand:
(cdr (assoc :token--endpoint disc :test (function eql)))


[User]
Define a macro that eliminates this repetitive pattern:
(define-modf-rewrite first (expr) `(car ,(second expr)))

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

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

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

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


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

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

(ψ 'some-name)

[Assistant]
(defmacro Ψ ...)

;; macroexpand:
(mapcar (λ) 'some-name)


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

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

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

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(def-iter iterator-range (curr stop step) (range (s0 &optional s1 (step 1)) "Works [as in Python](https://docs.python.org/3/library/stdtypes.html#typesseq-range) but produces an iterator (as defined by PICL) instead of a Python-esque range object ``` (range 5) ;; 0, 1, 2, 3, 4 (range 2 5) ;; 2, 3, 4 (range -2) ;; 0, -1 (range 1 7 2) ;; 1, 3, 5 ```" (init-state (curr (if s1 s0 0)) (stop (if s1 s1 s0)) step)) (if (or (and (> step 0) (< curr stop)) (and (< step 0) (> curr stop))) (values (prog1 curr (incf curr step)) t) (values nil nil)))

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

(def-iter iterator-range (curr stop step) (range (s0 &optional s1 (step 1)) "Works [as in Python](https://docs.python.org/3/library/stdtypes.html#typesseq-range) but produces an iterator (as defined by PICL) instead of a Python-esque range object ``` (range 5) ;; 0, 1, 2, 3, 4 (range 2 5) ;; 2, 3, 4 (range -2) ;; 0, -1 (range 1 7 2) ;; 1, 3, 5 ```" (init-state (curr (if s1 s0 0)) (stop (if s1 s1 s0)) step)) (if (or (and (> step 0) (< curr stop)) (and (< step 0) (> curr stop))) (values (prog1 curr (incf curr step)) t) (values nil nil)))

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

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

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

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

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

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

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

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

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

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

;; macroexpand:
(labels ((#:next-fname131 (&key curr stop step) (labels ((self nil (if (or (and (> step 0) (< curr stop)) (and (< step 0) (> curr stop))) (values (prog1 curr (incf curr step)) t) (values nil nil)))) (function self)))) (defun range (s0 &optional s1 (step 1)) "Works [as in Python](https://docs.python.org/3/library/stdtypes.html#typesseq-range) but produces an iterator (as defined by PICL) instead of a Python-esque range object ``` (range 5) ;; 0, 1, 2, 3, 4 (range 2 5) ;; 2, 3, 4 (range -2) ;; 0, -1 (range 1 7 2) ;; 1, 3, 5 ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname131)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (init-state (curr (if s1 s0 0)) (stop (if s1 s1 s0)) step))))


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

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

(defpackage nil)

[Assistant]
(defmacro DEFPACKAGE ...)

;; macroexpand:
(common-lisp:defpackage nil
  (:use :adhoc :closer-mop :cl)
  (:shadowing-import-from :closer-mop
                          #:defmethod
                          #:standard-generic-function
                          #:defgeneric
                          #:standard-method
                          #:standard-class)
  (:shadowing-import-from :adhoc #:defpackage #:variable #:the))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defclause (collect expr &optional into var at (place 'end) result-type (type 'list)) "Collect into a list" (return-collection-code :variable var :expression expr :one-element t :start-operation 'cons :end-operation '(subst (var expr) (list expr)) :place place :result-type type))

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

(defclause (collect expr &optional into var at (place 'end) result-type (type 'list)) "Collect into a list" (return-collection-code :variable var :expression expr :one-element t :start-operation 'cons :end-operation '(subst (var expr) (list expr)) :place place :result-type type))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defun clause-collect-18 (&key ((:collect expr)) ((:into var)) ((:at place) (quote end)) ((:result-type type) (quote list))) "Collect into a list" (return-collection-code :variable var :expression expr :one-element t :start-operation (quote cons) :end-operation (quote (subst (var expr) (list expr))) :place place :result-type type)) (install-clause-info (quote (collect)) (quote (collect &optional :into :at :result-type)) (quote clause-collect-18) "Collect into a list" nil) (quote (collect expr &optional into var at (place (quote end)) result-type (type (quote list)))))


[User]
Write a Common Lisp macro to handle this code pattern:
(when (second item) `(declaration-value (make-node ,(second item))))

Problem: Macro call that should be transformed by when

(when (second item) `(declaration-value (make-node ,(second item))))

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

;; macroexpand:
(if (second item) (sb-int:quasiquote (declaration-value (make-node #S(sb-impl::comma :expr (second item) :kind 0)))))


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

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

(ct-let nil
  :key
  nil)

[Assistant]
(defmacro CT-LET ...)

;; macroexpand:
(cond
 (*within-captured-dynenv*
  (let ()
    (let ((#:new-var-space161
           (reduce
            (lambda (#:accum162 #:item163)
              (destructuring-bind
                  (#:name164 . #:value165)
                  #:item163
                (update-alist #:name164 #:value165 #:accum162)))
            (list) :initial-value *var-space*)))
      `(symbol-macrolet ((var-space ,#:new-var-space161))
         ,(let ((*var-space* #:new-var-space161))
            :key
            nil)))))
 (t
  (error
   "No macrodynamic environment has been captured to establish CT-LET bindings.")))


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

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

(destructuring-case nil)

[Assistant]
(defmacro DESTRUCTURING-CASE ...)

;; macroexpand:
(destructuring-case-alt nil)


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

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

(defmacro nil ())

[Assistant]
(defmacro DEFMACRO ...)

;; macroexpand:
(progn
 (eval-when (:compile-toplevel)
   (sb-c::%compiler-defmacro :macro-function 'nil))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (sb-c::%defmacro 'nil
                    (sb-int:named-lambda (macro-function nil)
                        (#:expr #:env)
                      (declare (sb-c::lambda-list nil))
                      (declare (ignore #:env))
                      (sb-int:named-ds-bind (:macro nil . defmacro)
                          nil
                          (cdr #:expr)
                        (declare (sb-c::constant-value))))
                    (sb-c:source-location))))


[User]
Define a macro that eliminates this repetitive pattern:
(pop-preprocessor-directive-token token-list directive-symbol :errorp nil)

Issue: Macro call that should be transformed by pop-preprocessor-directive-token

(pop-preprocessor-directive-token token-list directive-symbol :errorp nil)

[Assistant]
(defmacro pop-preprocessor-directive-token (token-list directive-name &key (errorp t))
  "Pops the next token in TOKEN-LIST ignoring `+whitespace-marker+'"
  (with-gensyms (head_)
    `(let ((,head_
             (check-and-pop-pp-directive-token-1 ,token-list ,directive-name ,errorp)))
       (if (eq +whitespace-marker+ ,head_)
           (check-and-pop-pp-directive-token-1 ,token-list ,directive-name ,errorp)
           ,head_))))

;; macroexpand:
(let ((#:head_263 (check-and-pop-pp-directive-token-1 token-list directive-symbol nil))) (if (eq +whitespace-marker+ #:head_263) (check-and-pop-pp-directive-token-1 token-list directive-symbol nil) #:head_263))


[User]
Define a macro that eliminates this repetitive pattern:
(is (<= (length s) 2))

Issue: Macro call that should be transformed by is

(is (<= (length s) 2))

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

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

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

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

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

;; macroexpand:
(let ((#:e256 (length s)) (#:a257 2)) (if (progn (<= #:e256 #:a257)) (add-result (quote test-passed) :test-expr (quote (<= (length s) 2))) (process-failure (quote (<= (length s) 2)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote 2) #:a257 (quote <=) #:e256)))


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

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

(continue-whopper nil nil)

[Assistant]
(defmacro CONTINUE-WHOPPER ...)

;; macroexpand:
(call-next-method-fn self class-env inst-env mcs%caller mcs%next-methods
                     (list nil nil))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-local-readtable
  nil
  nil)

Problem: Macro call that should be transformed by WITH-LOCAL-READTABLE

(with-local-readtable
  nil
  nil)

[Assistant]
(defmacro WITH-LOCAL-READTABLE ...)

;; macroexpand:
(bind ((*readtable* (copy-readtable *readtable*)))
  nil
  nil)