[User]
Define a macro that eliminates this repetitive pattern:
(do+ (terminate outer-loop 3))

Issue: Macro call that should be transformed by do+

(do+ (terminate outer-loop 3))

[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 (terminate outer-loop 3))


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

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

(->>
  nil
  :key
  nil)

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

;; macroexpand:
(let* ((#:var187 nil) (#:var188 (:key #:var187)) (#:var189 (nil #:var188)))
  #:var189)


[User]
Write a Common Lisp macro to handle this code pattern:
(receive (new-k new-v) (funcall fn k v) (dict* new new-k new-v))

Problem: Macro call that should be transformed by receive

(receive (new-k new-v) (funcall fn k v) (dict* new new-k new-v))

[Assistant]
(defmacro receive (formals expr &body body)
  "Stricter version of `multiple-value-bind'.

Use `receive' when you want to enforce that EXPR should return a
certain number of values, or a minimum number of values.

If FORMALS is a proper list, then EXPR must return exactly as many
values -- no more and no less -- as there are variables in FORMALS.

If FORMALS is an improper list (VARS . REST), then EXPR must return at
least as many values as there are VARS, and any further values are
bound, as a list, to REST.

Lastly, if FORMALS is a symbol, bind that symbol to all the values
returned by EXPR, as if by `multiple-value-list'.

From Scheme (SRFI-8)."
  ;; It's probably not worth stack-allocating the thunk.
  (cond ((null formals)
         `(multiple-value-call
              (lambda ()
                ,@body)
            ,expr))
        ((atom formals)
         ;; This could also be written:
         #+(or) `(let ((,formals (multiple-value-list ,expr)))
                   ,@body)
         ;; But I want it to be possible to declare FORMALS to have
         ;; dynamic extent, and most Lisps support that for &rest
         ;; lists.
         `(multiple-value-call
              (lambda (&rest ,formals)
                ,@body)
            ,expr))
        ((proper-list-p formals)
         (when (intersection formals lambda-list-keywords)
           (error "Lambda list keywords in formals: ~a" formals))
         `(multiple-value-call
              (lambda ,formals
                ,@body)
            ,expr))
        (t (let* ((last (last formals))
                  (vars (append (butlast formals)
                                (list (car last))))
                  (rest (cdr last)))
             (when (intersection (cons rest vars) lambda-list-keywords)
               (error "Lambda list keywords in formals: ~a" formals))
             `(multiple-value-call
                  (lambda (,@vars &rest ,rest)
                    ,@body)
                ,expr)))))

;; macroexpand:
(multiple-value-call (lambda (new-k new-v) (dict* new new-k new-v)) (funcall fn k v))


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

Issue: Macro call that should be transformed by GATHERLET

(gatherlet nil
  (progn))

[Assistant]
(defmacro GATHERLET ...)

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


[User]
Write a Common Lisp macro to handle this code pattern:
(with-cache ("foo" :store storage) 1)

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

(with-cache ("foo" :store storage) 1)

[Assistant]
(defmacro with-cache ((key &key store expire) &body body)
  "If a cache indicated by KEY exists, this just returns the cache
value without evaluating BODY. Otherwise, this evaluates BODY and
stores the evaluated value into STORE with KEY and EXPIRE. KEY is a
form that an evaluated value indicates the cache key.

Example:

    (defun f (x)
      (with-cache (x *store*)
        (very-complex-computation x)))"
  (once-only (key store expire)
    (with-gensyms (value exists-p)
      `(multiple-value-bind (,value ,exists-p)
           (getcache ,key ,store)
         (if ,exists-p
             ,value
             (let ((,value (progn ,@body)))
               (setcache ,key ,value ,store :expire ,expire)
               ,value))))))

;; macroexpand:
(let ((#:key232 "foo") (#:store233 storage) (#:expire234 nil)) (multiple-value-bind (#:value235 #:exists-p236) (getcache #:key232 #:store233) (if #:exists-p236 #:value235 (let ((#:value235 (progn 1))) (setcache #:key232 #:value235 #:store233 :expire #:expire234) #:value235))))


[User]
Write a Common Lisp macro to handle this code pattern:
(deferror "58" system-error)

Problem: Macro call that should be transformed by deferror

(deferror "58" system-error)

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

;; macroexpand:
(progn (define-condition system-error (database-error) nil) (setf (gethash "58" *error-table*) (quote system-error)))


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

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

(some-<>>
  'some-name)

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

;; macroexpand:
'some-name


[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 (&rest #:|ignore126|) (declare (ignore #:|ignore126|)) nil)


[User]
Generate a defmacro form that transforms code like this:
(finish T)

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

(finish T)

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(aprog1 :yes (unless (eql it :yes) (error "Broken.")) :no)

Problem: Macro call that should be transformed by aprog1

(aprog1 :yes (unless (eql it :yes) (error "Broken.")) :no)

[Assistant]
(defmacro aprog1 (first &body rest)
  "Binds IT to the first form so that it can be used in the rest of the
forms. The whole thing returns IT."
  `(anaphoric prog1 ,first ,@rest))

;; macroexpand:
(anaphoric prog1 :yes (unless (eql it :yes) (error "Broken.")) :no)


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

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

(destructuring-bind* nil
    :key
  nil)

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

;; macroexpand:
(let (#:in-body134)
  (flet ((#:handle135 (#:condition136)
           (unless #:in-body134
             (error
              (make-condition 'destructuring-error :lambda-list 'nil
                              :expression ':key :reason #:condition136)))))
    (declare (ignorable (function #:handle135)))
    (let ((#:value137 :key))
      (handler-bind ((error #'#:handle135))
        (destructuring-bind
            ()
            #:value137
          (setf #:in-body134 t)
          (locally nil))))))


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

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

(any-of nil
  :key
  nil)

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

;; macroexpand:
(lc (nil :key nil) thereis)


[User]
Define a macro that eliminates this repetitive pattern:
(when-let (previous (find-messenger name :manager manager)) (stop-messenger previous))

Issue: Macro call that should be transformed by when-let

(when-let (previous (find-messenger name :manager manager)) (stop-messenger previous))

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

;; macroexpand:
(let ((previous (find-messenger name :manager manager))) (when previous (stop-messenger previous)))


[User]
Define a macro that eliminates this repetitive pattern:
(with-mocks () (register-mock 'foo/simple) (foo/simple) (pass))

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

(with-mocks () (register-mock 'foo/simple) (foo/simple) (pass))

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

;; macroexpand:
(call-with-mocks (lambda nil (register-mock (quote foo/simple)) (foo/simple) (pass)) :recordp t)


[User]
Write a Common Lisp macro to handle this code pattern:
(macroexpand-convention (form) (if (consp form) (expand-export-class-using-head (first form) form) form))

Problem: Macro call that should be transformed by macroexpand-convention

(macroexpand-convention (form) (if (consp form) (expand-export-class-using-head (first form) form) form))

[Assistant]
(defmacro macroexpand-convention ((original-form) &body body)
  "Executes BODY as like `progn' and return the result as the first
value.  As the second value, returns a boolean whether the result is
not same with ORIGINAL-FORM or not.
This macro is designed to follow the `macroexpand' convention."
  `(multiple-value-bind (result expanded-p)
       (progn ,@body)
     (values result
             (or expanded-p
                 (not (eq result ,original-form))))))

;; macroexpand:
(multiple-value-bind (result expanded-p) (progn (if (consp form) (expand-export-class-using-head (first form) form) form)) (values result (or expanded-p (not (eq result form)))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-alias-binding range ranging)

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

(define-alias-binding range ranging)

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

;; macroexpand:
(progn (setf (binding (quote range)) (quote ranging)) (quote range))


[User]
Generate a defmacro form that transforms code like this:
(with-changing-vertex (vertex) (call-next-method))

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

(with-changing-vertex (vertex) (call-next-method))

[Assistant]
(defmacro with-changing-vertex ((vertex) &body body)
  "This is used to maintain consistency when changing the value of vertex elements while iterating over the vertexes..."
  (with-variables (v g)
    `(let* ((,v ,vertex)
            (,g (graph ,v)))
       (delete-item-at (graph-vertexes ,g)
                       (funcall (vertex-key ,g) (element ,v)))
       ,@body
       (setf (item-at (graph-vertexes ,g)
                      (funcall (vertex-key ,g) (element ,v))) ,v))))

;; macroexpand:
(let* ((#:v0003 vertex) (#:g0004 (graph #:v0003))) (delete-item-at (graph-vertexes #:g0004) (funcall (vertex-key #:g0004) (element #:v0003))) (call-next-method) (setf (item-at (graph-vertexes #:g0004) (funcall (vertex-key #:g0004) (element #:v0003))) #:v0003))


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

Issue: Macro call that should be transformed by MATCH

(match 'some-name)

[Assistant]
(defmacro MATCH ...)

;; macroexpand:
(match* ('some-name))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(defjs map4() (emit this.name 1) (emit "hello" this.k))

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

(defjs map4() (emit this.name 1) (emit "hello" this.k))

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

;; macroexpand:
(let* ((js-body (parenscript:ps (lambda nil (emit this.name 1) (emit "hello" this.k))))) (setf (gethash (quote map4) *js-definitions*) js-body) (defun map4 nil (get-element "retval" (car (docs (db.eval js-body))))))


[User]
Generate a defmacro form that transforms code like this:
(c?-with-stored (v :foo store 'nothing) (bwhen (val (value v)) val))

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

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

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

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


[User]
Generate a defmacro form that transforms code like this:
(ematch0 list ((cons it nil) (cons (funcall fn it t) nil)) ((cons it rest) (cons (funcall fn it nil) (mapcar1-with-last fn rest))))

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

(ematch0 list ((cons it nil) (cons (funcall fn it t) nil)) ((cons it rest) (cons (funcall fn it nil) (mapcar1-with-last fn rest))))

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

;; macroexpand:
(match0 list ((cons it nil) (cons (funcall fn it t) nil)) ((cons it rest) (cons (funcall fn it nil) (mapcar1-with-last fn rest))) (_ (error "level0 match error!")))


[User]
Define a macro that eliminates this repetitive pattern:
(skip () :report (lambda (s) (format s "Skip the test ~S and all its dependencies." (name test))) (with-run-state (result-list) (push (make-instance 'test-skipped :reason "Circular dependencies" :test-case test) result-list)) (setf (status test) :circular))

Issue: Macro call that should be transformed by skip

(skip () :report (lambda (s) (format s "Skip the test ~S and all its dependencies." (name test))) (with-run-state (result-list) (push (make-instance 'test-skipped :reason "Circular dependencies" :test-case test) result-list)) (setf (status test) :circular))

[Assistant]
(defmacro skip (&rest reason)
  "Generates a TEST-SKIPPED result."
  `(add-result 'test-skipped :reason (format nil ,@reason)))

;; macroexpand:
(add-result (quote test-skipped) :reason (format nil nil :report (lambda (s) (format s "Skip the test ~S and all its dependencies." (name test))) (with-run-state (result-list) (push (make-instance (quote test-skipped) :reason "Circular dependencies" :test-case test) result-list)) (setf (status test) :circular)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-custom-var (:beginning-of-array *beginning-of-array-handler*))

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

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

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(define-error args-incompatible () (previous-args current-args) "Sorry but the output arguments from one stage are not compatible with the input arguments of the next.~%Out vars from previous stage: ~a~%In args from this stage: ~a" previous-args current-args)

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

(define-error args-incompatible () (previous-args current-args) "Sorry but the output arguments from one stage are not compatible with the input arguments of the next.~%Out vars from previous stage: ~a~%In args from this stage: ~a" previous-args current-args)

[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 args-incompatible (:error-type varjo-error :prefix "Varjo") (previous-args current-args) "Sorry but the output arguments from one stage are not compatible with the input arguments of the next.~%Out vars from previous stage: ~a~%In args from this stage: ~a" previous-args current-args)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-mustache-character #\! (make-instance 'comment-tag :text ""))

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

(define-mustache-character #\! (make-instance 'comment-tag :text ""))

[Assistant]
(defmacro define-mustache-character (char &body body)
  `(set-mustache-character
    ,char (lambda (raw-text arg-text escapep start end)
            (declare (ignorable raw-text arg-text escapep start end)
                     (type simple-string raw-text arg-text)
                     (boolean escapep)
                     (offset start end))
            ,@body)))

;; macroexpand:
(set-mustache-character #\EXCLAMATION_MARK (lambda (raw-text arg-text escapep start end) (declare (ignorable raw-text arg-text escapep start end) (type simple-string raw-text arg-text) (boolean escapep) (offset start end)) (make-instance (quote comment-tag) :text "")))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(when (node-slot type) (make-proxy type type))

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

(when (node-slot type) (make-proxy type type))

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

;; macroexpand:
(if (node-slot type) (make-proxy type type))


[User]
Define a macro that eliminates this repetitive pattern:
(macroexpand-convention (form) (if (consp form) (expand-export-accessors-using-head (first form) form) form))

Issue: Macro call that should be transformed by macroexpand-convention

(macroexpand-convention (form) (if (consp form) (expand-export-accessors-using-head (first form) form) form))

[Assistant]
(defmacro macroexpand-convention ((original-form) &body body)
  "Executes BODY as like `progn' and return the result as the first
value.  As the second value, returns a boolean whether the result is
not same with ORIGINAL-FORM or not.
This macro is designed to follow the `macroexpand' convention."
  `(multiple-value-bind (result expanded-p)
       (progn ,@body)
     (values result
             (or expanded-p
                 (not (eq result ,original-form))))))

;; macroexpand:
(multiple-value-bind (result expanded-p) (progn (if (consp form) (expand-export-accessors-using-head (first form) form) form)) (values result (or expanded-p (not (eq result form)))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-simple-definition-resolver special-variable (designator) (eq :special (sb-cltl2:variable-information designator)))

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

(define-simple-definition-resolver special-variable (designator) (eq :special (sb-cltl2:variable-information designator)))

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

;; macroexpand:
(define-definition-resolver special-variable (special-variable #:package145) (when (ignore-errors (let ((designator special-variable)) (eq :special (sb-cltl2:variable-information designator)))) (list (make-instance (quote special-variable) :designator special-variable :package #:package145))))


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

Pattern to recognize: Macro call that should be transformed by $SLOT

($slot nil)

[Assistant]
(defmacro $SLOT ...)

;; macroexpand:
(get-slot nil)


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

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

(some-> 'some-name)

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

;; macroexpand:
(let* ((#:g145 'some-name))
  #:g145)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-api readtable-name (named-readtable) (named-readtable-designator => symbol) "Returns the name of the readtable designated by NAMED-READTABLE, or NIL." (let ((readtable (ensure-readtable named-readtable))) (cond ((%readtable-name readtable)) ((eq readtable *readtable*) :current) ((eq readtable *standard-readtable*) :common-lisp) ((eq readtable *case-preserving-standard-readtable*) :modern) (t nil))))

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

(define-api readtable-name (named-readtable) (named-readtable-designator => symbol) "Returns the name of the readtable designated by NAMED-READTABLE, or NIL." (let ((readtable (ensure-readtable named-readtable))) (cond ((%readtable-name readtable)) ((eq readtable *readtable*) :current) ((eq readtable *standard-readtable*) :common-lisp) ((eq readtable *case-preserving-standard-readtable*) :modern) (t nil))))

[Assistant]
(defmacro define-api (name lambda-list type-list &body body)
  (flet ((parse-type-list (type-list)
           (let ((pos (position '=> type-list)))
             (assert pos () "You forgot to specify return type (`=>' missing.)")
             (values (subseq type-list 0 pos)
                     `(values ,@(nthcdr (1+ pos) type-list) &optional)))))
    (multiple-value-bind (body decls docstring)
        (parse-body body :documentation t :whole `(define-api ,name))
      (multiple-value-bind (arg-typespec value-typespec)
          (parse-type-list type-list)
        (multiple-value-bind (reqs opts rest keys)
            (parse-ordinary-lambda-list lambda-list)
          (declare (ignorable reqs opts rest keys))
          `(progn
             (declaim (ftype (function ,arg-typespec ,value-typespec) ,name))
             (locally
                 ;; Muffle the annoying "&OPTIONAL and &KEY found in
                 ;; the same lambda list" style-warning
                 #+sbcl (declare (sb-ext:muffle-conditions style-warning))
               (defun ,name ,lambda-list
                 ,docstring
                 ,@decls
                 (locally
                     #+sbcl (declare (sb-ext:unmuffle-conditions style-warning))

                     ;; SBCL will interpret the ftype declaration as
                     ;; assertion and will insert type checks for us.
                     #-sbcl
                     (progn
                       ;; CHECK-TYPE required parameters
                       ,@(loop for req-arg in reqs
                               for req-type = (pop type-list)
                               do (assert req-type)
                               collect `(check-type ,req-arg ,req-type))

                       ;; CHECK-TYPE optional parameters
                       ,@(progn
                           (assert (or (null opts)
                                       (eq (pop type-list) '&optional)))
                           (loop for (opt-arg . nil) in opts
                                 for opt-type = (pop type-list)
                                 do (assert opt-type)
                                 collect `(check-type ,opt-arg ,opt-type)))

                       ;; CHECK-TYPE rest parameter
                       ,@(when rest
                           (assert (eq (pop type-list) '&rest))
                           (let ((rest-type (pop type-list)))
                             (assert rest-type)
                             `((dolist (x ,rest)
                                 (check-type x ,rest-type)))))

                       ;; CHECK-TYPE key parameters
                       ,@(progn
                           (assert (or (null keys)
                                       (eq (pop type-list) '&key)))
                           (loop for ((keyword key-arg)  . nil) in keys
                                 for (nil key-type) = (find keyword type-list
                                                            :key #'car)
                                 collect `(check-type ,key-arg ,key-type))))

                     ,@body)))))))))

;; macroexpand:
(progn (declaim (ftype (function (named-readtable-designator) (values symbol &optional)) readtable-name)) (locally (declare (sb-ext:muffle-conditions style-warning)) (defun readtable-name (named-readtable) "Returns the name of the readtable designated by NAMED-READTABLE, or NIL." (locally (declare (sb-ext:unmuffle-conditions style-warning)) (let ((readtable (ensure-readtable named-readtable))) (cond ((%readtable-name readtable)) ((eq readtable *readtable*) :current) ((eq readtable *standard-readtable*) :common-lisp) ((eq readtable *case-preserving-standard-readtable*) :modern) (t nil)))))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(setypecase 'foo (string :nono))

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

(setypecase 'foo (string :nono))

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

;; macroexpand:
(symbolic etypecase (quote foo) (string :nono))


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

Write a macro that addresses: Macro call that should be transformed by MAKE-WINDOW-OR-INSTANCE

(make-window-or-instance nil nil)

[Assistant]
(defmacro MAKE-WINDOW-OR-INSTANCE ...)

;; macroexpand:
(make-$instance nil nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(define-generic generic (a b &key c) "If :export-generic-name-p is true, export the name." (:export-generic-name-p t))

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

(define-generic generic (a b &key c) "If :export-generic-name-p is true, export the name." (:export-generic-name-p t))

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

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

Example:

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

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

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

;; macroexpand:
(prog1 (defgeneric generic (a b &key c) (:documentation "If :export-generic-name-p is true, export the name.")) (eval-when (:compile-toplevel :load-toplevel :execute) (export (quote generic) #A((8) base-char . "NCLASSES"))) (setf (documentation (quote generic) (quote function)) "If :export-generic-name-p is true, export the name.") (setf (documentation (fdefinition (quote generic)) (quote function)) "If :export-generic-name-p is true, export the name."))


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

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

(cond-<>>
  nil
  nil)

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

;; macroexpand:
(let* ((#:var155 nil)
       (#:var156
        (if nil
            (-<>>
              #:var155)
            #:var155)))
  #:var156)


[User]
Write a Common Lisp macro to handle this code pattern:
(inext-or-error nil (progn))

Problem: Macro call that should be transformed by INEXT-OR-ERROR

(inext-or-error nil (progn))

[Assistant]
(defmacro INEXT-OR-ERROR ...)

;; macroexpand:
(let ((vals (multiple-value-list (funcall (i-coro nil) (progn)))))
  (if (not vals)
      (error 'stop-iteration)
      (values (car vals) t)))


[User]
Generate a defmacro form that transforms code like this:
(def-neo4j-fun get-node-property (node-id property) :get (:uri-spec (format nil "node/~A/properties/~A" node-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (:status-handlers (200 (decode-neo4j-json-output body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'property-not-found-error :uri uri))))

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

(def-neo4j-fun get-node-property (node-id property) :get (:uri-spec (format nil "node/~A/properties/~A" node-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (:status-handlers (200 (decode-neo4j-json-output body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'property-not-found-error :uri uri))))

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

;; macroexpand:
(progn (defun get-node-property (&key node-id property) (let ((uri (format nil "node/~A/properties/~A" node-id (if (symbolp property) (string-downcase (symbol-name property)) property))) (json (encode-neo4j-json-payload nil :string))) (make-neo4j-request :get uri json (list (list 200 (lambda (body uri json) (decode-neo4j-json-output body))) (list 400 (lambda (body uri json) (error (quote invalid-data-sent-error) :uri uri :json json))) (list 404 (lambda (body uri json) (error (quote property-not-found-error) :uri uri))))))))


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

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

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

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

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


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

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

(vect-of nil (progn))

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

;; macroexpand:
(let ((#:vect139 (make-array 10 :adjustable t :fill-pointer 0)))
  (do-for ((progn))
    (vector-push-extend nil #:vect139))
  #:vect139)


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

Problem: Macro call that should be transformed by PSETQ

(psetq nil nil)

[Assistant]
(defmacro PSETQ ...)

;; macroexpand:
(progn (setq nil nil) nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(defhandler setq (setq &rest pairs) (declare (ignore setq)) (let ((vars (loop for s in pairs by #'cddr collect (macroexpand s *env*)))) (let ((expanded (loop for n in vars for r in (rest pairs) by #'cddr collect n collect r))) (if (some 'listp vars) (e `(setf ,@expanded)) `(list 'setq ,@(e-list expanded))))))

Problem: Macro call that should be transformed by defhandler

(defhandler setq (setq &rest pairs) (declare (ignore setq)) (let ((vars (loop for s in pairs by #'cddr collect (macroexpand s *env*)))) (let ((expanded (loop for n in vars for r in (rest pairs) by #'cddr collect n collect r))) (if (some 'listp vars) (e `(setf ,@expanded)) `(list 'setq ,@(e-list expanded))))))

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

;; macroexpand:
(progn (defun hander-setq (setq &rest pairs) (declare (ignore setq)) (let ((vars (loop for s in pairs by (function cddr) collect (macroexpand s *env*)))) (let ((expanded (loop for n in vars for r in (rest pairs) by (function cddr) collect n collect r))) (if (some (quote listp) vars) (e (sb-int:quasiquote (setf #S(sb-impl::comma :expr expanded :kind 2)))) (sb-int:quasiquote (list (quote setq) #S(sb-impl::comma :expr (e-list expanded) :kind 2))))))) (setf (gethash (quote setq) *form-handler*) (quote hander-setq)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-preprocessor-state-slots (state) (when if-section-skip-reason (return-from process-preprocessing-directive nil)) (let ((identifier (pop-last-preprocessor-directive-token directive-token-list directive-symbol))) (remove-local-preprocessor-macro state identifier)))

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

(with-preprocessor-state-slots (state) (when if-section-skip-reason (return-from process-preprocessing-directive nil)) (let ((identifier (pop-last-preprocessor-directive-token directive-token-list directive-symbol))) (remove-local-preprocessor-macro state identifier)))

[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 (when if-section-skip-reason (return-from process-preprocessing-directive nil)) (let ((identifier (pop-last-preprocessor-directive-token directive-token-list directive-symbol))) (remove-local-preprocessor-macro state identifier)))


[User]
Generate a defmacro form that transforms code like this:
(enable-quasi-quoted-bivalent-to-bivalent-emitting-form-syntax nil)

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

(enable-quasi-quoted-bivalent-to-bivalent-emitting-form-syntax nil)

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(draw scene (:rect :x 40 :y 40 :height 30 :width 30) :stroke "blue" :stroke-width 1 :fill "yellow")

Problem: Macro call that should be transformed by draw

(draw scene (:rect :x 40 :y 40 :height 30 :width 30) :stroke "blue" :stroke-width 1 :fill "yellow")

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

;; macroexpand:
(let ((#:g143 (funcall (function make-svg-element) :rect (append (list :x 40 :y 40 :height 30 :width 30) (list :stroke "blue" :stroke-width 1 :fill "yellow"))))) (add-element scene #:g143) #:g143)


[User]
Define a macro that eliminates this repetitive pattern:
(define-error for-loop-only-one-var () () "for loops can only iterate over one variable")

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

(define-error for-loop-only-one-var () () "for loops can only iterate over one variable")

[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 for-loop-only-one-var (:error-type varjo-error :prefix "Varjo") nil "for loops can only iterate over one variable")


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

Issue: Macro call that should be transformed by WITH-SPECIAL-INITARGS

(with-special-initargs nil)

[Assistant]
(defmacro WITH-SPECIAL-INITARGS ...)

;; macroexpand:
(funcall-with-special-initargs (list) (lambda ()))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-modf-rewrite cadar (expr) `(car (cdar ,(second expr))))

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

(define-modf-rewrite cadar (expr) `(car (cdar ,(second expr))))

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

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


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

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

(->*
  nil
  nil)

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

;; macroexpand:
(let* ((#:var190 nil) (#:var191 (nil #:var190)))
  #:var191)


[User]
Generate a defmacro form that transforms code like this:
(define SEEK_END 2)

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

(define SEEK_END 2)

[Assistant]
(defmacro define (name value &rest docstring)
  "Like a #define but also visible to Lisp code."
  `(progn
     (eval-when (:compile-toplevel :load-toplevel :execute)
       (defvar ,(pp-defines *package*) (make-hash-table))
       (setf (gethash ',name ,(pp-defines *package*)) ,(prin1-to-string value)))
     (defparameter ,name ,value ,@docstring)))

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


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

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

(quasiquote nil (progn))

[Assistant]
(defmacro QUASIQUOTE ...)

;; macroexpand:
(let ((#:source123 nil))
  (%append #:source123 (common-lisp:list (%quote #:source123 'progn))
           (%quote #:source123 'nil)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(def-neo4j-fun set-node-properties (node-id properties) :put (:encode properties :string) (:uri-spec (format nil "node/~A/properties" node-id)) (:status-handlers (204 (values t body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'node-not-found-error :uri uri))))

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

(def-neo4j-fun set-node-properties (node-id properties) :put (:encode properties :string) (:uri-spec (format nil "node/~A/properties" node-id)) (:status-handlers (204 (values t body)) (400 (error 'invalid-data-sent-error :uri uri :json json)) (404 (error 'node-not-found-error :uri uri))))

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

;; macroexpand:
(progn (defun set-node-properties (&key node-id properties) (let ((uri (format nil "node/~A/properties" node-id)) (json (encode-neo4j-json-payload properties :string))) (make-neo4j-request :put uri json (list (list 204 (lambda (body uri json) (values t body))) (list 400 (lambda (body uri json) (error (quote invalid-data-sent-error) :uri uri :json json))) (list 404 (lambda (body uri json) (error (quote node-not-found-error) :uri uri))))))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-cruft %list-all-readtable-names () "Return a list of all available readtable names." #+ :common-lisp (list* :standard :current :modern (loop for name being each hash-value of *readtable-names* collect name)))

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

(define-cruft %list-all-readtable-names () "Return a list of all available readtable names." #+ :common-lisp (list* :standard :current :modern (loop for name being each hash-value of *readtable-names* collect name)))

[Assistant]
(defmacro define-cruft (name lambda-list &body (docstring . alternatives))
  (assert (typep docstring 'string) (docstring) "Docstring missing!")
  (assert (not (null alternatives)))
  `(progn
     (declaim (inline ,name))
     (defun ,name ,lambda-list ,docstring ,(first alternatives))))

;; macroexpand:
(progn (declaim (inline %list-all-readtable-names)) (defun %list-all-readtable-names nil "Return a list of all available readtable names." (list* :standard :current :modern (loop for name being each hash-value of *readtable-names* collect name))))


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

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

(define-shared-method nil
    :key
  nil)

[Assistant]
(defmacro DEFINE-SHARED-METHOD ...)

;; macroexpand:
(define-incongruent-method incongruent-methods.methods::nil
    :key
  nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(defun-compile-time self-evaluating? (thing) (and (not (consp thing)) (or (not (symbolp thing)) (null thing) (eq thing t) (eq (symbol-package thing) (symbol-package :x)))))

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

(defun-compile-time self-evaluating? (thing) (and (not (consp thing)) (or (not (symbolp thing)) (null thing) (eq thing t) (eq (symbol-package thing) (symbol-package :x)))))

[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 self-evaluating? (thing) (and (not (consp thing)) (or (not (symbolp thing)) (null thing) (eq thing t) (eq (symbol-package thing) (symbol-package :x))))) (eval-when (:compile-toplevel) (compile (quote self-evaluating?))))


[User]
Generate a defmacro form that transforms code like this:
(alist-bind (name fields) form (let ((sym (foreign-type-symbol name :cunion *package*))) (let ((cunion-fields (parse-fields fields))) (when (symbol-package sym) (pushnew `(:union (,sym)) *foreign-record-list* :test #'equal)) `(define-foreign-record ',sym :union ,(aval :bit-size form) ,(aval :bit-alignment form) ',cunion-fields))))

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

(alist-bind (name fields) form (let ((sym (foreign-type-symbol name :cunion *package*))) (let ((cunion-fields (parse-fields fields))) (when (symbol-package sym) (pushnew `(:union (,sym)) *foreign-record-list* :test #'equal)) `(define-foreign-record ',sym :union ,(aval :bit-size form) ,(aval :bit-alignment form) ',cunion-fields))))

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

;; macroexpand:
(let ((#:alist242 form)) (let ((name (aval :name #:alist242)) (fields (aval :fields #:alist242))) (let ((sym (foreign-type-symbol name :cunion *package*))) (let ((cunion-fields (parse-fields fields))) (when (symbol-package sym) (pushnew (sb-int:quasiquote (:union (#S(sb-impl::comma :expr sym :kind 0)))) *foreign-record-list* :test (function equal))) (sb-int:quasiquote (define-foreign-record (quote #S(sb-impl::comma :expr sym :kind 0)) :union #S(sb-impl::comma :expr (aval :bit-size form) :kind 0) #S(sb-impl::comma :expr (aval :bit-alignment form) :kind 0) (quote #S(sb-impl::comma :expr cunion-fields :kind 0))))))))


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

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

(define-global-parameter nil :key nil)

[Assistant]
(defmacro DEFINE-GLOBAL-PARAMETER ...)

;; macroexpand:
(progn
 (store-in-symbol-plist nil :key .value-key.)
 (sb-ext:defglobal nil (get 'nil +value-key+))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (setf nil (get 'nil +value-key+)))
 (remprop 'nil +value-key+)
 'nil)


[User]
Write a Common Lisp macro to handle this code pattern:
(deferror "08003" connection-does-not-exist)

Problem: Macro call that should be transformed by deferror

(deferror "08003" connection-does-not-exist)

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

;; macroexpand:
(progn (define-condition connection-does-not-exist (database-error) nil) (setf (gethash "08003" *error-table*) (quote connection-does-not-exist)))


[User]
Define a macro that eliminates this repetitive pattern:
(*> (take-while (lambda (c) (eql #\a c))) (take-while (lambda (c) (or (eql #\b c) (eql #\c c) (eql #\d c)))))

Issue: Macro call that should be transformed by *>

(*> (take-while (lambda (c) (eql #\a c))) (take-while (lambda (c) (or (eql #\b c) (eql #\c c) (eql #\d c)))))

[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 (#:*>-offset212) (multiple-value-bind (#:*>-res213 #:*>-next214) (funcall (take-while (lambda (c) (eql #\LATIN_SMALL_LETTER_A c))) #:*>-offset212) (if (ok? #:*>-res213) (funcall (take-while (lambda (c) (or (eql #\LATIN_SMALL_LETTER_B c) (eql #\LATIN_SMALL_LETTER_C c) (eql #\LATIN_SMALL_LETTER_D c)))) #:*>-next214) (fail #:*>-next214))))


[User]
Define a macro that eliminates this repetitive pattern:
(define SEEK_CUR 1)

Issue: Macro call that should be transformed by define

(define SEEK_CUR 1)

[Assistant]
(defmacro define (name value &rest docstring)
  "Like a #define but also visible to Lisp code."
  `(progn
     (eval-when (:compile-toplevel :load-toplevel :execute)
       (defvar ,(pp-defines *package*) (make-hash-table))
       (setf (gethash ',name ,(pp-defines *package*)) ,(prin1-to-string value)))
     (defparameter ,name ,value ,@docstring)))

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


[User]
Generate a defmacro form that transforms code like this:
(receive (k v) (apply fn args) (setf (gethash k hash-table) v))

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

(receive (k v) (apply fn args) (setf (gethash k hash-table) v))

[Assistant]
(defmacro receive (formals expr &body body)
  "Stricter version of `multiple-value-bind'.

Use `receive' when you want to enforce that EXPR should return a
certain number of values, or a minimum number of values.

If FORMALS is a proper list, then EXPR must return exactly as many
values -- no more and no less -- as there are variables in FORMALS.

If FORMALS is an improper list (VARS . REST), then EXPR must return at
least as many values as there are VARS, and any further values are
bound, as a list, to REST.

Lastly, if FORMALS is a symbol, bind that symbol to all the values
returned by EXPR, as if by `multiple-value-list'.

From Scheme (SRFI-8)."
  ;; It's probably not worth stack-allocating the thunk.
  (cond ((null formals)
         `(multiple-value-call
              (lambda ()
                ,@body)
            ,expr))
        ((atom formals)
         ;; This could also be written:
         #+(or) `(let ((,formals (multiple-value-list ,expr)))
                   ,@body)
         ;; But I want it to be possible to declare FORMALS to have
         ;; dynamic extent, and most Lisps support that for &rest
         ;; lists.
         `(multiple-value-call
              (lambda (&rest ,formals)
                ,@body)
            ,expr))
        ((proper-list-p formals)
         (when (intersection formals lambda-list-keywords)
           (error "Lambda list keywords in formals: ~a" formals))
         `(multiple-value-call
              (lambda ,formals
                ,@body)
            ,expr))
        (t (let* ((last (last formals))
                  (vars (append (butlast formals)
                                (list (car last))))
                  (rest (cdr last)))
             (when (intersection (cons rest vars) lambda-list-keywords)
               (error "Lambda list keywords in formals: ~a" formals))
             `(multiple-value-call
                  (lambda (,@vars &rest ,rest)
                    ,@body)
                ,expr)))))

;; macroexpand:
(multiple-value-call (lambda (k v) (setf (gethash k hash-table) v)) (apply fn args))


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

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

(define-element-maker :clip-path "clipPath" '(:id))

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

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


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

Issue: Macro call that should be transformed by LAMBDA*

(lambda* nil
  nil)

[Assistant]
(defmacro LAMBDA* ...)

;; macroexpand:
(lambda ()
  (with-yield
    nil))


[User]
Define a macro that eliminates this repetitive pattern:
(match* (pattern qualifiers) (('* _) t) ((nil nil) t) (((type symbol) (type symbol)) (eql pattern qualifiers)) (((list* pfirst prest) (list* qualifier qualifiers)) (and (matches? qualifier pfirst) (matches? qualifiers prest))))

Issue: Macro call that should be transformed by match*

(match* (pattern qualifiers) (('* _) t) ((nil nil) t) (((type symbol) (type symbol)) (eql pattern qualifiers)) (((list* pfirst prest) (list* qualifier qualifiers)) (and (matches? qualifier pfirst) (matches? qualifiers prest))))

[Assistant]
(defmacro match* ((&rest things) &body clauses)
  `(multiple-value-match (values ,@things)
     ,@clauses))

;; macroexpand:
(multiple-value-match (values pattern qualifiers) (((quote *) _) t) ((nil nil) t) (((type symbol) (type symbol)) (eql pattern qualifiers)) (((list* pfirst prest) (list* qualifier qualifiers)) (and (matches? qualifier pfirst) (matches? qualifiers prest))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(*> +octothorp+ +skip-til-end+)

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

(*> +octothorp+ +skip-til-end+)

[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 (#:*>-offset224) (multiple-value-bind (#:*>-res225 #:*>-next226) (funcall +octothorp+ #:*>-offset224) (if (ok? #:*>-res225) (funcall +skip-til-end+ #:*>-next226) (fail #:*>-next226))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-custom-var (:beginning-of-string *beginning-of-string-handler*))

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

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

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(sunless x (setf it :ok))

Issue: Macro call that should be transformed by sunless

(sunless x (setf it :ok))

[Assistant]
(defmacro sunless (test &body body)
  "Like UNLESS, except binds the test form to IT (via SYMBOL-MACROLET) for the
scope of the body. IT can be set with SETF."
  `(symbolic unless ,test ,@body))

;; macroexpand:
(symbolic unless x (setf it :ok))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-space (call-next-method))

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

(with-space (call-next-method))

[Assistant]
(defmacro with-space (&body body)
  (with-thunk (body)
    `(call-with-space ,body)))

;; macroexpand:
(flet ((#:stack-fn-body1 nil (call-next-method))) (declare (dynamic-extent (function #:stack-fn-body1))) (symbol-macrolet ((#:stack-fn-body1 (function #:stack-fn-body1))) (call-with-space #:stack-fn-body1)))


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

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

(with-active-layers nil)

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

;; macroexpand:
(progn)


[User]
Write a Common Lisp macro to handle this code pattern:
(serially (atomically nil () (decf counter)))

Problem: Macro call that should be transformed by serially

(serially (atomically nil () (decf counter)))

[Assistant]
(defmacro serially (&body flow)
  "Executes child elements serially (but possibly in different threads)
returning a value of the last atomic block or flow. Non-consing."
  (with-flow-let-macro (flow-list flow)
    (flow-lambda-macro (flow-context)
      `(dispatch-serially ,flow-context ,flow-list))))

;; macroexpand:
(let ((#:flow-list162 (list (atomically nil nil (decf counter))))) (%flow-lambda (#:flow-context163) (dispatch-serially #:flow-context163 #:flow-list162)))


[User]
Define a macro that eliminates this repetitive pattern:
;; Accessing pandoric variables requires verbose funcall
(let ((sum (funcall box :pandoric-get 'sum))
      (count (funcall box :pandoric-get 'count)))
  (format t "sum=~a count=~a~%" sum count))

;; Setting is even worse:
(progn
  (funcall box :pandoric-set 'sum new-value)
  new-value)

;; Want: regular variable syntax for pandoric access

Issue: Pandoric get/set requires verbose keyword funcalls — want transparent variable syntax using symbol-macrolet

;; Accessing pandoric variables requires verbose funcall
(let ((sum (funcall box :pandoric-get 'sum))
      (count (funcall box :pandoric-get 'count)))
  (format t "sum=~a count=~a~%" sum count))

;; Setting is even worse:
(progn
  (funcall box :pandoric-set 'sum new-value)
  new-value)

;; Want: regular variable syntax for pandoric access

[Assistant]
(defun get-pandoric (box sym)
  (funcall box :pandoric-get sym))

(defsetf get-pandoric (box sym) (val)
  `(progn
     (funcall ,box :pandoric-set ,sym ,val)
     ,val))

(defmacro with-pandoric (syms box &rest body)
  (let ((g!box (gensym "box")))
    `(let ((,g!box ,box))
       (declare (ignorable ,g!box))
       (symbol-macrolet
         (,@(mapcar #`(,a1 (get-pandoric ,g!box ',a1))
                    syms))
         ,@body))))

;; macroexpand:
;; (with-pandoric (sum count) #'counter
;;   (format t "sum=~a count=~a~%" sum count)
;;   (incf sum 10)
;;   (setf count 0))
;;
;; Expands to:
;; (SYMBOL-MACROLET
;;   ((SUM (GET-PANDORIC #:BOX123 'SUM))
;;    (COUNT (GET-PANDORIC #:BOX123 'COUNT)))
;;   (FORMAT T "sum=~a count=~a~%" SUM COUNT)
;;   (INCF SUM 10)
;;   (SETF COUNT 0))
;;
;; Reading SUM expands to (GET-PANDORIC ... 'SUM)
;; Writing SUM expands to setf -> get-pandoric setf expander


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-interpreter oid:+int2+ "int2" int 2)

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

(define-interpreter oid:+int2+ "int2" int 2)

[Assistant]
(defmacro define-interpreter (oid name fields &body value)
  "Shorthand for defining binary readers."
  (declare (ignore name)) ;; Names are there just for clarity
  `(set-sql-reader ,oid (binary-reader ,fields ,@value) :binary-p t))

;; macroexpand:
(set-sql-reader cl-postgres-oid:+int2+ (binary-reader int 2) :binary-p t)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-column-type enum (&rest candidates) `(:enum ,@(mapcar #'(lambda (candidate) (if (symbolp candidate) (symbol-name-literally candidate) candidate)) candidates)))

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

(define-column-type enum (&rest candidates) `(:enum ,@(mapcar #'(lambda (candidate) (if (symbolp candidate) (symbol-name-literally candidate) candidate)) candidates)))

[Assistant]
(defmacro define-column-type (type-symbol lambda-list &body body)
  (let ((type (gensym "TYPE"))
        (args (gensym "ARGS")))
    `(defmethod cltype-to-dbtype ((,type (eql ',type-symbol)) &rest ,args)
       (declare (ignore ,type))
       (destructuring-bind ,lambda-list ,args
         ,@body))))

;; macroexpand:
(defmethod cltype-to-dbtype ((#:type228 (eql (quote enum))) &rest #:args229) (declare (ignore #:type228)) (destructuring-bind (&rest candidates) #:args229 (sb-int:quasiquote (:enum #S(sb-impl::comma :expr (mapcar (function (lambda (candidate) (if (symbolp candidate) (symbol-name-literally candidate) candidate))) candidates) :kind 2)))))


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

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

(-<>> nil :key nil)

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

;; macroexpand:
((:key nil))


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

Problem: Macro call that should be transformed by DEFGENERIC*

(defgeneric* nil
    (progn))

[Assistant]
(defmacro DEFGENERIC* ...)

;; macroexpand:
(defgeneric (progn))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-decoder-simple-clos-semantics (setf x (decode-json-from-string "{\"x\":1}")) (is (equal (symbol-package (first-bound-slot-name x)) (find-package :json-test))))

What needs to change: Macro call that should be transformed by with-decoder-simple-clos-semantics

(with-decoder-simple-clos-semantics (setf x (decode-json-from-string "{\"x\":1}")) (is (equal (symbol-package (first-bound-slot-name x)) (find-package :json-test))))

[Assistant]
(defmacro with-decoder-simple-clos-semantics (&body body)
  "Execute BODY in a dynamic environement where the decoder semantics
is such as set by SET-DECODER-SIMPLE-CLOS-SEMANTICS."
  `(with-shadowed-custom-vars
     (set-decoder-simple-clos-semantics)
     ,@body))

;; macroexpand:
(with-shadowed-custom-vars (set-decoder-simple-clos-semantics) (setf x (decode-json-from-string "{\"x\":1}")) (is (equal (symbol-package (first-bound-slot-name x)) (find-package :json-test))))


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

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

(defvariant 'some-name)

[Assistant]
(defmacro DEFVARIANT ...)

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(assoc-cdr "state" parameters #'equal)

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

(assoc-cdr "state" parameters #'equal)

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

;; macroexpand:
(cdr (assoc "state" parameters :test (function equal)))


[User]
Generate a defmacro form that transforms code like this:
(check-cursor-attached cluffer:item-before-cursor (cursor))

Pattern to recognize: Macro call that should be transformed by check-cursor-attached

(check-cursor-attached cluffer:item-before-cursor (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:item-before-cursor :before ((cursor cluffer:cursor)) (declare (ignore)) (unless (cluffer:cursor-attached-p cursor) (error (quote cluffer:cursor-detached))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(*> (char #\e) (alt (char #\M) (char #\m)))

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

(*> (char #\e) (alt (char #\M) (char #\m)))

[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 (#:*>-offset169) (multiple-value-bind (#:*>-res170 #:*>-next171) (funcall (char #\LATIN_SMALL_LETTER_E) #:*>-offset169) (if (ok? #:*>-res170) (funcall (alt (char #\LATIN_CAPITAL_LETTER_M) (char #\LATIN_SMALL_LETTER_M)) #:*>-next171) (fail #:*>-next171))))


[User]
Write a Common Lisp macro to handle this code pattern:
(binary-reader ((days int 4)) (funcall f days))

Problem: Macro call that should be transformed by binary-reader

(binary-reader ((days int 4)) (funcall f days))

[Assistant]
(defmacro binary-reader (fields &body value)
  "A slightly convoluted macro for defining interpreter functions. It
allows two forms. The first is to pass a single type identifier, in
which case a value of this type will be read and returned directly.
The second is to pass a list of lists containing names and types, and
then a body. In this case the names will be bound to values read from
the socket and interpreted as the given types, and then the body will
be run in the resulting environment. If the last field is of type
bytes, string, or uint2s, all remaining data will be read and
interpreted as an array of the given type."
  (let ((stream-name (gensym))
        (size-name (gensym))
        (length-used 0))
    (flet ((read-type (type &optional modifier)
             (ecase type
               (bytes `(read-bytes ,stream-name (- ,size-name ,length-used)))
               (string `(enc-read-string ,stream-name
                                         :byte-length (- ,size-name ,length-used)))
               (uint2s `(let* ((size (/ (- ,size-name ,length-used) 2))
                               (result
                                 (make-array size
                                             :element-type '(unsigned-byte 16)
                                             :initial-element 0)))
                          (dotimes (i size)
                            (setf (elt result i) (read-uint2 ,stream-name)))
                          result))
               (int (assert (integerp modifier))
                (incf length-used modifier)
                `(,(integer-reader-name modifier t) ,stream-name))
               (uint (assert (integerp modifier))
                (incf length-used modifier)
                `(,(integer-reader-name modifier nil) ,stream-name)))))
      `(lambda (,stream-name ,size-name)
         (declare (type stream ,stream-name)
                  (type integer ,size-name)
                  (ignorable ,size-name))
         ,(if (consp fields)
              (progn
                `(let ,(loop :for field :in fields
                            :collect `(,(first field)
                                       ,(apply #'read-type (cdr field))))
                  ,@value))
              (read-type fields (car value)))))))

;; macroexpand:
(lambda (#:g206 #:g207) (declare (type stream #:g206) (type integer #:g207) (ignorable #:g207)) (let ((days (read-int4 #:g206))) (funcall f days)))


[User]
Generate a defmacro form that transforms code like this:
(builder (lambda (app) (lambda (env) (funcall app env))) *app*)

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

(builder (lambda (app) (lambda (env) (funcall app env))) *app*)

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

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


[User]
Generate a defmacro form that transforms code like this:
(defvar-compile-time *ordered-lambda-list-keywords* '(&optional &rest &key &allow-other-keys &aux) "The allowed lambda list keywords in order.")

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

(defvar-compile-time *ordered-lambda-list-keywords* '(&optional &rest &key &allow-other-keys &aux) "The allowed lambda list keywords in order.")

[Assistant]
(defmacro defvar-compile-time (name &optional initial-value documentation)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (defvar ,name ,initial-value ,documentation)))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defvar *ordered-lambda-list-keywords* (quote (&optional &rest &key &allow-other-keys &aux)) "The allowed lambda list keywords in order."))


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

Issue: Macro call that should be transformed by is

(is (<= less more))

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(macroexpand-convention (form) (if (consp form) (expand-documentation-using-head (first form) docstring form) form))

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

(macroexpand-convention (form) (if (consp form) (expand-documentation-using-head (first form) docstring form) form))

[Assistant]
(defmacro macroexpand-convention ((original-form) &body body)
  "Executes BODY as like `progn' and return the result as the first
value.  As the second value, returns a boolean whether the result is
not same with ORIGINAL-FORM or not.
This macro is designed to follow the `macroexpand' convention."
  `(multiple-value-bind (result expanded-p)
       (progn ,@body)
     (values result
             (or expanded-p
                 (not (eq result ,original-form))))))

;; macroexpand:
(multiple-value-bind (result expanded-p) (progn (if (consp form) (expand-documentation-using-head (first form) docstring form) form)) (values result (or expanded-p (not (eq result form)))))


[User]
Write a Common Lisp macro to handle this code pattern:
(action (:after node-application) #'apply-specialization)

Problem: Macro call that should be transformed by action

(action (:after node-application) #'apply-specialization)

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

;; macroexpand:
(make-action (quote :after) (quote node-application) (function apply-specialization))


[User]
Generate a defmacro form that transforms code like this:
(is (< 0 -1))

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

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


[User]
You are a Common Lisp macro expert. Given this code pattern:
(if-generator (x gen) nil (if fail-if-short (error 'insufficient-items "Insufficient items in generator") (return nil)))

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

(if-generator (x gen) nil (if fail-if-short (error 'insufficient-items "Insufficient items in generator") (return nil)))

[Assistant]
(defmacro if-generator ((var gen) true-clause &optional false-clause)
  "Pulls a single iteration out of gen. If a single var is specified, it places all the values from the iteration in a list under var. If var is a list, destructures values into the vars in the list. If the generator has stopped, evaluates false-clause, otherwise evaluates true-clause."
  `(,@(if (listp var)
	 `(multiple-value-bind ,var
	      (funcall ,gen))
	 `(let ((,var (multiple-value-list (funcall ,gen))))))
      (if (eq 'generator-stop
	      ,(if (listp var)
		   (car var)
		   `(car ,var)))
	  ,false-clause
	  ,true-clause)))

;; macroexpand:
(let ((x (multiple-value-list (funcall gen)))) (if (eq (quote generator-stop) (car x)) (if fail-if-short (error (quote insufficient-items) "Insufficient items in generator") (return nil)) nil))


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

Problem: Macro call that should be transformed by M

(m nil
  :key
  nil)

[Assistant]
(defmacro M ...)

;; macroexpand:
(lambda (&rest #:|macro-lambda-list123|)
  (destructuring-bind () #:|macro-lambda-list123| :key nil))


[User]
Define a macro that eliminates this repetitive pattern:
(with-table-name nil (yield (when-op-left op)))

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

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

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(summing-to total)

Issue: Macro call that should be transformed by sum

(summing-to total)

[Assistant]
(defmacro sum (value &key (to (error "sum requires a target accumulator (:to key)")))
  "Syntactic sugar for collect, intended to be used when the accumulator computes a sum."
  `(collect ,value :into ,to))

;; macroexpand:
(accumulating-to total :initially 0 :by (function +) :finally nil)


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

Problem: Macro call that should be transformed by IGNORE-ERRORS

(ignore-errors nil (progn))

[Assistant]
(defmacro IGNORE-ERRORS ...)

;; macroexpand:
(handler-case (progn nil (progn)) (error (condition) (values nil condition)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-path curvy (move-to 350 350))

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

(with-path curvy (move-to 350 350))

[Assistant]
(defmacro with-path (path &body cmds)
  (let ((s (gensym "stream"))
        (n (gensym)))
    `(flet ((assert-string (s)
              (error-unless-string s)))
       (with-output-to-string (,s ,path)
         ;; Do trivial breaking up of the path data - SVG does not have
         ;; to accept indefinitely long lines of data.
         (let ((,n 0))
           (dolist (inst (mapcar #'assert-string (list ,@cmds)) (format ,s "~&"))
             (format ,s "~@{~A~}" inst)
             (incf ,n)
             (when (= (mod ,n 10) 0)
               (format ,s "~&"))))))))

;; macroexpand:
(flet ((assert-string (s) (error-unless-string s))) (with-output-to-string (#:|stream136| curvy) (let ((#:g137 0)) (dolist (inst (mapcar (function assert-string) (list (move-to 350 350))) (format #:|stream136| "~&")) (format #:|stream136| "~@{~A~}" inst) (incf #:g137) (when (= (mod #:g137 10) 0) (format #:|stream136| "~&"))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-global-var nil (progn))

Problem: Macro call that should be transformed by DEFINE-GLOBAL-VAR

(define-global-var nil (progn))

[Assistant]
(defmacro DEFINE-GLOBAL-VAR ...)

;; macroexpand:
(sb-ext:defglobal nil (progn))


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

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(is (= 2 (length *toplevel-suites*)))

Issue: Macro call that should be transformed by is

(is (= 2 (length *toplevel-suites*)))

[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 ((#:e280 2) (#:a281 (length *toplevel-suites*))) (if (progn (= #:e280 #:a281)) (add-result (quote test-passed) :test-expr (quote (= 2 (length *toplevel-suites*)))) (process-failure (quote (= 2 (length *toplevel-suites*))) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote (length *toplevel-suites*)) #:a281 (quote =) #:e280)))