[User]
You are a Common Lisp macro expert. Given this code pattern:
(bind ((#(a nil c) #(1 2 3))) (list a c))

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

(bind ((#(a nil c) #(1 2 3))) (list a c))

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

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

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

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

;; macroexpand:
(let* ((#:|values-168| #(1 2 3)) (a (aref #:|values-168| 0)) (c (aref #:|values-168| 2))) (declare (ignorable #:|values-168|)) (progn (list a c)))


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

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

(defsynonym finish :finish)

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(define-error multi-val-bind-mismatch () (bindings val-form return-set) "Multiple Value Bind - Number of values returned from value form does not match bindings: Bindings: ~a Value Form: ~a Returned Values: ~a" bindings val-form (map 'list #'type->type-spec return-set))

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

(define-error multi-val-bind-mismatch () (bindings val-form return-set) "Multiple Value Bind - Number of values returned from value form does not match bindings: Bindings: ~a Value Form: ~a Returned Values: ~a" bindings val-form (map 'list #'type->type-spec return-set))

[Assistant]
(defmacro define-error (name (&key (error-type 'varjo-error) (prefix "Varjo"))
                            (&rest args) error-string &body body)
  `(defcondition ,name (:error-type ,error-type :prefix ,prefix) ,args
       ,error-string ,@body))

;; macroexpand:
(defcondition multi-val-bind-mismatch (:error-type varjo-error :prefix "Varjo") (bindings val-form return-set) "Multiple Value Bind - Number of values returned from value form does not match bindings: Bindings: ~a Value Form: ~a Returned Values: ~a" bindings val-form (map (quote list) (function type->type-spec) return-set))


[User]
Generate a defmacro form that transforms code like this:
(with-open-temporary-file (f :keep nil))

Pattern to recognize: Macro call that should be transformed by with-open-temporary-file

(with-open-temporary-file (f :keep nil))

[Assistant]
(defmacro with-open-temporary-file ((stream &rest args &key keep &allow-other-keys) &body body)
  "Create a temporary file using OPEN-TEMPORARY with ARGS and run BODY
  with STREAM bound to the temporary file stream.  Returns the values
  returned by BODY.  By default, the file is deleted when BODY is
  exited. If a true value is passed in KEEP, the file is not deleted
  when the body is exited.  See OPEN-TEMPORARY for more permitted
  options."
  `(with-open-stream (,stream (open-temporary ,@(alexandria:remove-from-plist args :keep)))
     #+sbcl
     (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
     ,(if (and (constantp keep)
               keep)
          `(progn ,@body)
          `(unwind-protect
                (progn ,@body)
             (unless ,keep
               (close ,stream)
               (delete-file (pathname ,stream)))))))

;; macroexpand:
(with-open-stream (f (open-temporary)) (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note)) (unwind-protect (progn) (unless nil (close f) (delete-file (pathname f)))))


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

What needs to change: Macro call that should be transformed by DYNAMIC-RELET*

(dynamic-relet* nil
  :key
  nil)

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

;; macroexpand:
(progn :key nil)


[User]
Define a macro that eliminates this repetitive pattern:
(with-symbol-access
  nil
  :key
  nil)

Issue: Macro call that should be transformed by WITH-SYMBOL-ACCESS

(with-symbol-access
  nil
  :key
  nil)

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

;; macroexpand:
(let ((*symbol-access* t))
  nil
  :key
  nil)


[User]
Define a macro that eliminates this repetitive pattern:
(defun/1 log10 (x) (log x 10))

Issue: Macro call that should be transformed by defun/1

(defun/1 log10 (x) (log x 10))

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

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

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


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

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

(cond-<>
  nil
  nil)

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

;; macroexpand:
(let* ((#:var134 nil)
       (#:var135
        (if nil
            (-<>
              #:var134)
            #:var134)))
  #:var135)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-cruft %clear-readtable (readtable) "Make all macro characters in READTABLE be constituents." #+ :sbcl (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (setf (sb-impl::dispatch-tables readtable) nil)) #+ :allegro (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (let ((dispatch-tables (excl::readtable-dispatch-tables readtable))) (setf (cdr dispatch-tables) nil) (setf (caar dispatch-tables) #\Backspace) (setf (cadar dispatch-tables) (fill (cadar dispatch-tables) nil)))) #+ :cmucl (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (setf (lisp::dispatch-tables readtable) nil)) #+ :common-lisp (do-readtable (char readtable readtable) (set-syntax-from-char char #\A readtable)))

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

(define-cruft %clear-readtable (readtable) "Make all macro characters in READTABLE be constituents." #+ :sbcl (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (setf (sb-impl::dispatch-tables readtable) nil)) #+ :allegro (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (let ((dispatch-tables (excl::readtable-dispatch-tables readtable))) (setf (cdr dispatch-tables) nil) (setf (caar dispatch-tables) #\Backspace) (setf (cadar dispatch-tables) (fill (cadar dispatch-tables) nil)))) #+ :cmucl (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\A readtable)) (setf (lisp::dispatch-tables readtable) nil)) #+ :common-lisp (do-readtable (char readtable readtable) (set-syntax-from-char char #\A readtable)))

[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 %clear-readtable)) (defun %clear-readtable (readtable) "Make all macro characters in READTABLE be constituents." (prog1 readtable (do-readtable (char readtable) (set-syntax-from-char char #\LATIN_CAPITAL_LETTER_A readtable)) (setf (sb-impl:dispatch-tables readtable) nil))))


[User]
Define a macro that eliminates this repetitive pattern:
(with-package (package) (loop for (type . args) in options do (expand-option type package args)))

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

(with-package (package) (loop for (type . args) in options do (expand-option type package args)))

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

;; macroexpand:
(let ((package (ensure-package package))) (loop for (type . args) in options do (expand-option type package args)))


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

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

(defsynonym count :count)

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(with-yield-binds (format nil "DROP~:[~; IF EXISTS~] VIEW ~A" (drop-view-statement-if-exists statement) (yield (drop-view-statement-view-name statement))))

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

(with-yield-binds (format nil "DROP~:[~; IF EXISTS~] VIEW ~A" (drop-view-statement-if-exists statement) (yield (drop-view-statement-view-name statement))))

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

;; macroexpand:
(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "DROP~:[~; IF EXISTS~] VIEW ~A" (drop-view-statement-if-exists statement) (yield (drop-view-statement-view-name statement)))) (loop for bind in (reverse *bind-values*) append bind)))


[User]
Write a Common Lisp macro to handle this code pattern:
(*> +opt-fws+ #'comment)

Problem: Macro call that should be transformed by *>

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

[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 (#:*>-offset137) (multiple-value-bind (#:*>-res138 #:*>-next139) (funcall +opt-fws+ #:*>-offset137) (if (ok? #:*>-res138) (funcall (function comment) #:*>-next139) (fail #:*>-next139))))


[User]
Generate a defmacro form that transforms code like this:
(compiler-macro-lambda (int) `(format t "~&Compile time: ~A -> ~A.~%" ',int ,int))

Pattern to recognize: Macro call that should be transformed by compiler-macro-lambda

(compiler-macro-lambda (int) `(format t "~&Compile time: ~A -> ~A.~%" ',int ,int))

[Assistant]
(defmacro compiler-macro-lambda (lambda-list &body body)
  (introspect-environment:parse-compiler-macro (gensym "COMPILER-MACRO-LAMBDA")
                                               lambda-list
                                               body))

;; macroexpand:
(sb-int:named-lambda (compiler-macro #:compiler-macro-lambda145) (#:expr #:env) (declare (sb-c::lambda-list (int))) (declare (ignore #:env)) (sb-int:named-ds-bind (:macro #:compiler-macro-lambda145 . define-compiler-macro) (int) (sb-c::compiler-macro-args #:expr) (declare (sb-c::constant-value int) (sb-c::no-compiler-macro #:compiler-macro-lambda145)) (block #:compiler-macro-lambda145 (sb-int:quasiquote (format t "~&Compile time: ~A -> ~A.~%" (quote #S(sb-impl::comma :expr int :kind 0)) #S(sb-impl::comma :expr int :kind 0))))))


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

Pattern to recognize: Macro call that should be transformed by IN-COMPILE-TIME

(in-compile-time nil
  :key
  nil)

[Assistant]
(defmacro IN-COMPILE-TIME ...)

;; macroexpand:
(macrolet ((#:macro144 (&environment ())
             :key
             nil))
  (#:macro144))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-yield-binds (format nil "~A AS ~A" (if (sql-statement-p (as-op-left op)) (yield (make-sql-list (as-op-left op))) (yield (as-op-left op))) (with-table-name nil (yield (as-op-right op)))))

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

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

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

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


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

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

(vect-of nil nil)

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(def-iter iterator-repeat (max curr item) (repeat (s0 &optional s1) "If a single argument is given, yields `s0` repeatedly forever If two arguments are given, then yields `s1` `s0` times ``` (repeat t) ;; t, t, etc (repeat 4 t) ;; t, t, t, t ```" (init-state (item (or s1 s0)) (max (and s1 s0)) (curr 0))) (if max (if (< curr max) (values (progn (incf curr) item) t) (values nil nil)) (values item t)))

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

(def-iter iterator-repeat (max curr item) (repeat (s0 &optional s1) "If a single argument is given, yields `s0` repeatedly forever If two arguments are given, then yields `s1` `s0` times ``` (repeat t) ;; t, t, etc (repeat 4 t) ;; t, t, t, t ```" (init-state (item (or s1 s0)) (max (and s1 s0)) (curr 0))) (if max (if (< curr max) (values (progn (incf curr) item) t) (values nil nil)) (values item t)))

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

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

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

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

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

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

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

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

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

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

;; macroexpand:
(labels ((#:next-fname133 (&key max curr item) (labels ((self nil (if max (if (< curr max) (values (progn (incf curr) item) t) (values nil nil)) (values item t)))) (function self)))) (defun repeat (s0 &optional s1) "If a single argument is given, yields `s0` repeatedly forever If two arguments are given, then yields `s1` `s0` times ``` (repeat t) ;; t, t, etc (repeat 4 t) ;; t, t, t, t ```" (macrolet ((init-state (&rest argspecs) (list (quote apply) (quote (function #:next-fname133)) (apply (function append) (quote (list)) (mapcar (lambda (aspec) (if (symbolp aspec) (list (alx:make-keyword aspec) aspec) (destructuring-bind (aname adef) aspec (list (alx:make-keyword aname) adef)))) argspecs))))) (init-state (item (or s1 s0)) (max (and s1 s0)) (curr 0)))))


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

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

(setf nil (progn))

[Assistant]
(defmacro SETF ...)

;; macroexpand:
(setq nil (progn))


[User]
Generate a defmacro form that transforms code like this:
(define-global-parameter nil (progn))

Pattern to recognize: Macro call that should be transformed by DEFINE-GLOBAL-PARAMETER

(define-global-parameter nil (progn))

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

;; macroexpand:
(progn
 (store-in-symbol-plist nil (progn) .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]
Create a Common Lisp macro for the following transformation. Before code:
(define-definition-resolver optimizer (designator package) (let ((fun-info (when (symbolp designator) (sb-int:info :function :info designator)))) (when fun-info (let ((otypes '(sb-c:fun-info-derive-type sb-c:fun-info-ltn-annotate sb-c:fun-info-optimizer sb-c:fun-info-ir2-convert sb-c::fun-info-stack-allocate-result sb-c::fun-info-constraint-propagate sb-c::fun-info-constraint-propagate-if sb-c::fun-info-call-type-deriver))) (loop for reader in otypes for fn = (funcall reader fun-info) when fn collect (make-instance 'optimizer :designator designator :package package :optimizer fn))))))

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

(define-definition-resolver optimizer (designator package) (let ((fun-info (when (symbolp designator) (sb-int:info :function :info designator)))) (when fun-info (let ((otypes '(sb-c:fun-info-derive-type sb-c:fun-info-ltn-annotate sb-c:fun-info-optimizer sb-c:fun-info-ir2-convert sb-c::fun-info-stack-allocate-result sb-c::fun-info-constraint-propagate sb-c::fun-info-constraint-propagate-if sb-c::fun-info-call-type-deriver))) (loop for reader in otypes for fn = (funcall reader fun-info) when fn collect (make-instance 'optimizer :designator designator :package package :optimizer fn))))))

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

;; macroexpand:
(progn (setf (definition-resolver (quote optimizer)) (lambda (designator package) (let ((fun-info (when (symbolp designator) (sb-int:info :function :info designator)))) (when fun-info (let ((otypes (quote (sb-c:fun-info-derive-type sb-c:fun-info-ltn-annotate sb-c:fun-info-optimizer sb-c:fun-info-ir2-convert sb-c::fun-info-stack-allocate-result sb-c::fun-info-constraint-propagate sb-c::fun-info-constraint-propagate-if sb-c::fun-info-call-type-deriver)))) (loop for reader in otypes for fn = (funcall reader fun-info) when fn collect (make-instance (quote optimizer) :designator designator :package package :optimizer fn))))))) (quote optimizer))


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

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

(->
  nil
  :key
  nil)

[Assistant]
(defmacro -> ...)

;; macroexpand:
(let* ((#:var152 nil) (#:var153 (:key #:var152)) (#:var154 (nil #:var153)))
  #:var154)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-mocks () (register-mock 'foo) (dotimes (i 3) (foo)) (is (eql 3 (length (invocations)))))

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

(with-mocks () (register-mock 'foo) (dotimes (i 3) (foo)) (is (eql 3 (length (invocations)))))

[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)) (dotimes (i 3) (foo)) (is (eql 3 (length (invocations))))) :recordp t)


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

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

(with-env (setp 7 [struct 'a]))

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

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


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

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

(define-element-maker :symbol "symbol" '(: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 :symbol)) 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~^ ~}" :symbol missing))))) (defmethod make-svg-element ((element (eql :symbol)) attributes) (when *check-required-attributes* (assert-required-attributes element attributes)) (make-instance (quote svg-element) :name "symbol" :attributes attributes)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(*> #'any #'eof)

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

(*> #'any #'eof)

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

;; macroexpand:
(lambda (#:*>-offset161) (multiple-value-bind (#:*>-res162 #:*>-next163) (funcall (function any) #:*>-offset161) (if (ok? #:*>-res162) (funcall (function eof) #:*>-next163) (fail #:*>-next163))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(when head (if (eql (first head) t) (cons 'progn (cdr head)) `(if ,(first head) ,(when (cdr head) (cons 'progn (cdr head))) ,(when (cdr clauses) `(cond ,@(cdr clauses))))))

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

(when head (if (eql (first head) t) (cons 'progn (cdr head)) `(if ,(first head) ,(when (cdr head) (cons 'progn (cdr head))) ,(when (cdr clauses) `(cond ,@(cdr clauses))))))

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

;; macroexpand:
(if head (if (eql (first head) t) (cons (quote progn) (cdr head)) (sb-int:quasiquote (if #S(sb-impl::comma :expr (first head) :kind 0) #S(sb-impl::comma :expr (when (cdr head) (cons (quote progn) (cdr head))) :kind 0) #S(sb-impl::comma :expr (when (cdr clauses) (sb-int:quasiquote (cond #S(sb-impl::comma :expr (cdr clauses) :kind 2)))) :kind 0)))))


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

Issue: Macro call that should be transformed by DEFITER

(defiter nil
    nil)

[Assistant]
(defmacro DEFITER ...)

;; macroexpand:
(defun nil () (make-instance 'iterator :coro (lambda-coro)))


[User]
Generate a defmacro form that transforms code like this:
(c-assert (typep fm-parent 'family))

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

(c-assert (typep fm-parent 'family))

[Assistant]
(defmacro c-assert (assertion &optional places fmt$ &rest fmt-args)
  (declare (ignorable assertion places fmt$ fmt-args))
   #+(or)`(progn)
  `(unless *stop*
     (unless ,assertion
       ,(if fmt$
            `(c-break ,fmt$ ,@fmt-args)
          `(c-break "failed assertion: ~a" ',assertion)))))

;; macroexpand:
(unless *stop* (unless (typep fm-parent (quote family)) (c-break "failed assertion: ~a" (quote (typep fm-parent (quote family))))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-error no-valid-function () (name types form) "There is no applicable method for the glsl function '~s' when called with ~a ~@[Form: ~a~]" name (if types (format nil "argument types:~%~s" (mapcar #'type->type-spec types)) "no arguments.") form)

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

(define-error no-valid-function () (name types form) "There is no applicable method for the glsl function '~s' when called with ~a ~@[Form: ~a~]" name (if types (format nil "argument types:~%~s" (mapcar #'type->type-spec types)) "no arguments.") form)

[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 no-valid-function (:error-type varjo-error :prefix "Varjo") (name types form) "There is no applicable method for the glsl function '~s' when called with ~a ~@[Form: ~a~]" name (if types (format nil "argument types:~%~s" (mapcar (function type->type-spec) types)) "no arguments.") form)


[User]
Define a macro that eliminates this repetitive pattern:
(when-let (name (messenger-name self)) (format stream "~a" name))

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

(when-let (name (messenger-name self)) (format stream "~a" name))

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

;; macroexpand:
(let ((name (messenger-name self))) (when name (format stream "~a" name)))


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

Issue: Macro call that should be transformed by COLLECT-PRODUCT

(collect-product nil)

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

;; macroexpand:
(common-lisp:let* ((#:generator-125 (generator nil))
                   #:numbers-121
                   (#:mul-122 1))
  (declare (type generator #:generator-125)
           (type number #:mul-122))
  (tagbody
   #:ll-126
    (setq #:numbers-121 (next-in #:generator-125 (go end)))
    (setq #:mul-122 (* #:mul-122 #:numbers-121))
    (go #:ll-126)
   end)
  #:mul-122)


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

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

(resolving
  nil
  :key
  nil)

[Assistant]
(defmacro RESOLVING ...)

;; macroexpand:
(resolve
  nil
  :key
  nil)


[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:
((:key nil))


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

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

(continue-whopper nil)

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(define-condition/a dbi-programming-error (dbi-database-error) () (:documentation "Exception raised for programming errors, e.g. table not found or already exists, syntax error in SQL statement, wrong number of parameters specified, etc."))

Issue: Macro call that should be transformed by define-condition/a

(define-condition/a dbi-programming-error (dbi-database-error) () (:documentation "Exception raised for programming errors, e.g. table not found or already exists, syntax error in SQL statement, wrong number of parameters specified, etc."))

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

;; macroexpand:
(progn (define-condition dbi-programming-error (dbi-database-error) nil (:documentation "Exception raised for programming errors, e.g. table not found or already exists, syntax error in SQL statement, wrong number of parameters specified, etc.")) (deftype <dbi-programming-error> nil (quote dbi-programming-error)) (setf (find-class (quote <dbi-programming-error>)) (find-class (quote dbi-programming-error))))


[User]
Define a macro that eliminates this repetitive pattern:
(when item `(make-node ,item))

Issue: Macro call that should be transformed by when

(when item `(make-node ,item))

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-accumulation-binding appending (var form &aux (head (cons NIL NIL)) (tail head)) (declare (type list var) (type cons head tail)) (let ((result (gensym "RESULT")) (new-tail (gensym "NEW-TAIL"))) `(let ((,result ,form)) (when ,result (multiple-value-bind (,head ,new-tail) (copy-list* ,result) (setf (cdr ,tail) ,head ,tail ,new-tail)) (setf ,var (cdr ,head))))))

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

(define-accumulation-binding appending (var form &aux (head (cons NIL NIL)) (tail head)) (declare (type list var) (type cons head tail)) (let ((result (gensym "RESULT")) (new-tail (gensym "NEW-TAIL"))) `(let ((,result ,form)) (when ,result (multiple-value-bind (,head ,new-tail) (copy-list* ,result) (setf (cdr ,tail) ,head ,tail ,new-tail)) (setf ,var (cdr ,head))))))

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

;; macroexpand:
(define-form-binding appending (var form &aux (head (cons nil nil)) (tail head)) (declare (type list var) (type cons head tail)) (values (progn (let ((result (gensym "RESULT")) (new-tail (gensym "NEW-TAIL"))) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr result :kind 0) #S(sb-impl::comma :expr form :kind 0))) (when #S(sb-impl::comma :expr result :kind 0) (multiple-value-bind (#S(sb-impl::comma :expr head :kind 0) #S(sb-impl::comma :expr new-tail :kind 0)) (copy-list* #S(sb-impl::comma :expr result :kind 0)) (setf (cdr #S(sb-impl::comma :expr tail :kind 0)) #S(sb-impl::comma :expr head :kind 0) #S(sb-impl::comma :expr tail :kind 0) #S(sb-impl::comma :expr new-tail :kind 0))) (setf #S(sb-impl::comma :expr var :kind 0) (cdr #S(sb-impl::comma :expr head :kind 0)))))))) (delist var)))


[User]
Define a macro that eliminates this repetitive pattern:
(when (find (first x) (list 'stropt)) (let ((s (short x)) (l (long x))) (if s (push s opts-short)) (if l (push l opts-long))))

Issue: Macro call that should be transformed by when

(when (find (first x) (list 'stropt)) (let ((s (short x)) (l (long x))) (if s (push s opts-short)) (if l (push l opts-long))))

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

;; macroexpand:
(if (find (first x) (list (quote stropt))) (let ((s (short x)) (l (long x))) (if s (push s opts-short)) (if l (push l opts-long))))


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

Issue: Macro call that should be transformed by ->

(-> :g (v) (put v))

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

;; macroexpand:
(atomically :g (v) (put v))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(-> (from :users) (where (:= :active 1)) (order-by :name))

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

(-> (from :users) (where (:= :active 1)) (order-by :name))

[Assistant]
(defmacro -> (value &rest forms)
  "Smart threading macro that dispatches based on clause types returned by forms.

   This macro enables immutable query composition by threading clauses through
   query-state objects. Creates a single copy at the beginning, then destructively
   adds clauses for efficiency. Supports both v1 select-statements and composer query-states.

   Forms that evaluate to NIL are skipped, enabling conditional composition:
     (-> (from :users)
         (when active-only (where (:= :active 1)))
         (when sort-by-name (order-by :name)))

   Examples:
     ;; With composer clause
     (-> (from :users)
         (where (:= :active 1))
         (order-by :name))

     ;; With v1 select-statement (backward compatible)
     (-> (select (:id :name) (from :users))
         (where (:= :active 1))
         (order-by :name))

     ;; Conditional composition
     (-> (from :users)
         (when include-inactive (where (:= :active 0)))
         (when sort-by-date (order-by :created_at)))"
  (a:with-gensyms (threaded-var clause-var)
    `(let* ((,threaded-var ,value)
            ;; Convert to query-state and copy once at the beginning
            (,threaded-var
              (typecase ,threaded-var
                (query-state-base (copy-query-state-immutable ,threaded-var))
                (stmt:select-statement (select-statement-to-query-state ,threaded-var))
                (stmt:insert-into-statement (insert-statement-to-query-state ,threaded-var))
                (stmt:update-statement (update-statement-to-query-state ,threaded-var))
                (stmt:delete-from-statement (delete-statement-to-query-state ,threaded-var))
                (otherwise (add-clause (make-select-query-state) ,threaded-var)))))
       ;; Now destructively add clauses (no more copying), skipping NILs
       ,@(loop for form in forms
               collect `(let ((,clause-var ,(if (listp form)
                                                ;; For list forms, call the function with its arguments (no threading)
                                                `(,(car form) ,@(cdr form))
                                                ;; For symbol forms, call the function with no arguments
                                                `(,form))))
                          (when ,clause-var
                            (add-clause ,threaded-var ,clause-var))))
       ,threaded-var)))

;; macroexpand:
(let* ((#:threaded-var143 (from :users)) (#:threaded-var143 (typecase #:threaded-var143 (query-state-base (copy-query-state-immutable #:threaded-var143)) (stmt:select-statement (select-statement-to-query-state #:threaded-var143)) (stmt:insert-into-statement (insert-statement-to-query-state #:threaded-var143)) (stmt:update-statement (update-statement-to-query-state #:threaded-var143)) (stmt:delete-from-statement (delete-statement-to-query-state #:threaded-var143)) (otherwise (add-clause (make-select-query-state) #:threaded-var143))))) (let ((#:clause-var144 (where (:= :active 1)))) (when #:clause-var144 (add-clause #:threaded-var143 #:clause-var144))) (let ((#:clause-var144 (order-by :name))) (when #:clause-var144 (add-clause #:threaded-var143 #:clause-var144))) #:threaded-var143)


[User]
Write a Common Lisp macro to handle this code pattern:
(implies (slot-boundp object (slot-definition-name slot)) (typep (slot-value object (slot-definition-name slot)) (slot-definition-type slot)))

Problem: Macro call that should be transformed by implies

(implies (slot-boundp object (slot-definition-name slot)) (typep (slot-value object (slot-definition-name slot)) (slot-definition-type slot)))

[Assistant]
(defmacro implies (condition consequent)
  "A boolean operator that evaluates to the value of CONSEQUENT if CONDITION is
   true, and otherwise evaluates to T. This isn't particularly specific to Quid
   Pro Quo, but it is a useful logical operator for contracts."
  `(if ,condition ,consequent t))

;; macroexpand:
(if (slot-boundp object (slot-definition-name slot)) (typep (slot-value object (slot-definition-name slot)) (slot-definition-type slot)) t)


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

Problem: Macro call that should be transformed by DLET*

(dlet* nil
  (progn))

[Assistant]
(defmacro DLET* ...)

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


[User]
Write a Common Lisp macro to handle this code pattern:
(deferror "22" data-exception)

Problem: Macro call that should be transformed by deferror

(deferror "22" data-exception)

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

;; macroexpand:
(progn (define-condition data-exception (database-error) nil) (setf (gethash "22" *error-table*) (quote data-exception)))


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

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

(newq 'some-name)

[Assistant]
(defmacro NEWQ ...)

;; macroexpand:
(new ''some-name)


[User]
Generate a defmacro form that transforms code like this:
(if-generator (tmp gen) (mapcar #'list tmp))

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

(if-generator (tmp gen) (mapcar #'list tmp))

[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 ((tmp (multiple-value-list (funcall gen)))) (if (eq (quote generator-stop) (car tmp)) nil (mapcar (function list) tmp)))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-yield-binds (format nil "CREATE~:[~; OR REPLACE~] VIEW ~A AS ~A" (create-view-statement-or-replace statement) (yield (create-view-statement-view-name statement)) (let ((as (create-view-statement-as statement))) (typecase as (string as) (otherwise (yield as))))))

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

(with-yield-binds (format nil "CREATE~:[~; OR REPLACE~] VIEW ~A AS ~A" (create-view-statement-or-replace statement) (yield (create-view-statement-view-name statement)) (let ((as (create-view-statement-as statement))) (typecase as (string as) (otherwise (yield as))))))

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

;; macroexpand:
(let ((*bind-values* nil) (*use-global-bind-values* t)) (values (progn (format nil "CREATE~:[~; OR REPLACE~] VIEW ~A AS ~A" (create-view-statement-or-replace statement) (yield (create-view-statement-view-name statement)) (let ((as (create-view-statement-as statement))) (typecase as (string as) (otherwise (yield as)))))) (loop for bind in (reverse *bind-values*) append bind)))


[User]
Write a Common Lisp macro to handle this code pattern:
(action (:after node-variable node bound-variables) (when (and (eq name (node-variable-value node)) (not (member name bound-variables :test #'eq))) (incf count) (unless (identifiers-disjoint-p value-vars bound-variables) (setf unsafe? t))) (values))

Problem: Macro call that should be transformed by action

(action (:after node-variable node bound-variables) (when (and (eq name (node-variable-value node)) (not (member name bound-variables :test #'eq))) (incf count) (unless (identifiers-disjoint-p value-vars bound-variables) (setf unsafe? t))) (values))

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

;; macroexpand:
(make-action (quote :after) (quote node-variable) (lambda (node bound-variables) (declare (type node-variable node)) (when (and (eq name (node-variable-value node)) (not (member name bound-variables :test (function eq)))) (incf count) (unless (identifiers-disjoint-p value-vars bound-variables) (setf unsafe? t))) (values)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
($ "value-1" 600)

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

($ "value-1" 600)

[Assistant]
(defmacro $ (&rest args)
  `(kv ,@args))

;; macroexpand:
(kv "value-1" 600)


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

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

(dlet* nil
  nil)

[Assistant]
(defmacro DLET* ...)

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-case-aware-find-symbol find-preprocessor-directive #:with-c-syntax.preprocessor-directive)

What needs to change: Macro call that should be transformed by define-case-aware-find-symbol

(define-case-aware-find-symbol find-preprocessor-directive #:with-c-syntax.preprocessor-directive)

[Assistant]
(defmacro define-case-aware-find-symbol
    (finder-function-name package-name
     &key (upcased-package-name (format nil "~A.~A" (string package-name) '#:UPCASED))
       (docstring
        (format nil "Find a symbol in `~A' package having a same NAME. If not found, returns `nil'."
                package-name)))
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (defpackage ,upcased-package-name
       (:use)
       (:intern
        ,@(loop for sym being the external-symbol of package-name
                collect (string-upcase (symbol-name sym)))))
     ,@(loop for sym being the external-symbol of package-name
             for upcased = (string-upcase (symbol-name sym))
             collect `(setf (symbol-value (find-symbol ,upcased ',upcased-package-name))
                            ',sym))
     (defun ,finder-function-name (string &optional (readtable-case (readtable-case *readtable*)))
       ,@(if docstring `(,docstring))
       (ecase readtable-case
         ((:upcase :invert)
          (if-let ((up-sym (find-symbol string ',upcased-package-name)))
            (symbol-value up-sym)))
         ((:downcase :preserve)
          (find-symbol string ',package-name))))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defpackage #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED") (:use) (:intern #A((4) base-char . "ELIF") #A((6) base-char . "IFNDEF") #A((5) base-char . "UNDEF") #A((5) base-char . "ERROR") #A((5) base-char . "ENDIF") #A((6) base-char . "PRAGMA") #A((6) base-char . "DEFINE") #A((4) base-char . "ELSE") #A((2) base-char . "IF") #A((7) base-char . "INCLUDE") #A((5) base-char . "IFDEF") #A((4) base-char . "LINE"))) (setf (symbol-value (find-symbol #A((4) base-char . "ELIF") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|elif|)) (setf (symbol-value (find-symbol #A((6) base-char . "IFNDEF") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|ifndef|)) (setf (symbol-value (find-symbol #A((5) base-char . "UNDEF") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|undef|)) (setf (symbol-value (find-symbol #A((5) base-char . "ERROR") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|error|)) (setf (symbol-value (find-symbol #A((5) base-char . "ENDIF") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|endif|)) (setf (symbol-value (find-symbol #A((6) base-char . "PRAGMA") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|pragma|)) (setf (symbol-value (find-symbol #A((6) base-char . "DEFINE") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|define|)) (setf (symbol-value (find-symbol #A((4) base-char . "ELSE") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|else|)) (setf (symbol-value (find-symbol #A((2) base-char . "IF") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|if|)) (setf (symbol-value (find-symbol #A((7) base-char . "INCLUDE") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|include|)) (setf (symbol-value (find-symbol #A((5) base-char . "IFDEF") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|ifdef|)) (setf (symbol-value (find-symbol #A((4) base-char . "LINE") (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED")))) (quote with-c-syntax.preprocessor-directive:|line|)) (defun find-preprocessor-directive (string &optional (readtable-case (readtable-case *readtable*))) #A((112) base-char . "Find a symbol in `WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE' package having a same NAME. If not found, returns `nil'.") (ecase readtable-case ((:upcase :invert) (if-let ((up-sym (find-symbol string (quote #A((44) base-char . "WITH-C-SYNTAX.PREPROCESSOR-DIRECTIVE.UPCASED"))))) (symbol-value up-sym))) ((:downcase :preserve) (find-symbol string (quote #:with-c-syntax.preprocessor-directive))))))


[User]
Generate a defmacro form that transforms code like this:
(do-files (file (repo-dir *config*) file-type) (let ((obj (construct (class-name doc-type) (read-content file)))) (add-document obj)))

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

(do-files (file (repo-dir *config*) file-type) (let ((obj (construct (class-name doc-type) (read-content file)))) (add-document obj)))

[Assistant]
(defmacro do-files ((var path &optional extension) &body body)
  "For each file under PATH, run BODY. If EXTENSION is provided, only run
BODY on files that match the given extension."
  (alexandria:with-gensyms (extension-p)
    `(flet ((,extension-p (file)
              (string= (pathname-type file) ,extension)))
       (cl-fad:walk-directory ,path (lambda (,var) ,@body)
                              :follow-symlinks nil
                              :test (if ,extension
                                        #',extension-p
                                        (constantly t))))))

;; macroexpand:
(flet ((#:extension-p287 (file) (string= (pathname-type file) file-type))) (cl-fad:walk-directory (repo-dir *config*) (lambda (file) (let ((obj (construct (class-name doc-type) (read-content file)))) (add-document obj))) :follow-symlinks nil :test (if file-type (function #:extension-p287) (constantly t))))


[User]
Generate a defmacro form that transforms code like this:
(bind (((:plist- a (b _) (c _ 2) (dd d)) '(b "B" a "A" d "D"))) (list a b c dd))

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

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

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

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

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

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

;; macroexpand:
(let* ((#:|values-165| (quote (b "B" a "A" d "D"))) (a (getf #:|values-165| (quote a))) (b (getf #:|values-165| (quote b))) (c (getf #:|values-165| (quote c) 2)) (dd (getf #:|values-165| (quote d)))) (declare (ignorable #:|values-165|)) (progn (list a b c dd)))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-simple-object-lookup package find-package)

Problem: Macro call that should be transformed by define-simple-object-lookup

(define-simple-object-lookup package find-package)

[Assistant]
(defmacro define-simple-object-lookup (class lookup-function &body body)
  `(defmethod object ((,class ,class))
     ,(if body
          `(let ((,(first lookup-function) ,class))
             ,@body)
          `(,lookup-function (designator ,class)))))

;; macroexpand:
(defmethod object ((package package)) (find-package (designator package)))


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

Pattern to recognize: Macro call that should be transformed by WITHOUT-DEPENDENCY-CAPTURE

(without-dependency-capture
  'some-name)

[Assistant]
(defmacro WITHOUT-DEPENDENCY-CAPTURE ...)

;; macroexpand:
(let ((%dependent% nil))
  'some-name)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(dotable (k v ht2) (setf (gethash k rez) (funcall fn v (gethash k rez))))

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

(dotable (k v ht2) (setf (gethash k rez) (funcall fn v (gethash k rez))))

[Assistant]
(defmacro dotable ((k v table &optional rez) &body body)
  "Like DOLIST but iterates over key-value pairs (K V) in anything, that can be
   viewed as a table (hash-table, alist, plist, object).
   Autodeclares variables named _ as ignored."
  (with-gensyms (pair)
    (once-only (table)
      (let ((_ (find "_" (list k v)
                     :test 'string=
                     :key 'symbol-name)))
        `(block nil
           (etypecase ,table
             (hash-table (maphash (lambda (,k ,v)
                                    ,(when _ `(declare (ignore rutils.bind:_)))
                                    ,@body)
                                  ,table))

             (list (if (rutils.list:alistp ,table)
                       (dolist (,pair ,table)
                         (destructuring-bind (,k . ,v) ,pair
                           ,@(when _ `((declare (ignore ,_))))
                           ,@body))
                       (error 'simple-type-error
                              :format-control "Can't iterate over proper list ~
                                               in DOTABLE: need an alist"))))
           ,rez)))))

;; macroexpand:
(let ((#:table170 ht2)) (block nil (etypecase #:table170 (hash-table (maphash (lambda (k v) nil (setf (gethash k rez) (funcall fn v (gethash k rez)))) #:table170)) (list (if (alistp #:table170) (dolist (#:g169 #:table170) (destructuring-bind (k . v) #:g169 (setf (gethash k rez) (funcall fn v (gethash k rez))))) (error (quote simple-type-error) :format-control "Can't iterate over proper list ~
                                               in DOTABLE: need an alist")))) nil))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(%define-hash-table-entries-pattern hash-table-entries hash-table-entry)

Write a macro that addresses: Macro call that should be transformed by %define-hash-table-entries-pattern

(%define-hash-table-entries-pattern hash-table-entries hash-table-entry)

[Assistant]
(defmacro %define-hash-table-entries-pattern (name entry-pattern)
  `(defpattern ,name (key pattern &rest keys-and-patterns)
    ,(format nil "Matches hash table which has KEY set to value matching PATTERN.~
                  Multiple KEY PATTERN pairs can be provided, e.g. `(~A :key1 _ :key2 value :key3 1)`.~
                  Expands into list of ~A patterns combined with AND."
             name entry-pattern)
    (when (oddp (length keys-and-patterns))
      (warn 'hash-table-odd-number-of-entries-warning
            :format-control ,(format nil "Odd number of arguments given to ~A pattern. NIL will be used as ~~S pattern." name)
            :format-arguments (last keys-and-patterns)))
    `(and ,(list ',entry-pattern key pattern)
          ,@(loop :for (key pattern) :on keys-and-patterns :by #'cddr
                  :collect (list ',entry-pattern key pattern)))))

;; macroexpand:
(defpattern hash-table-entries (key pattern &rest keys-and-patterns) #A((228) base-char . "Matches hash table which has KEY set to value matching PATTERN.Multiple KEY PATTERN pairs can be provided, e.g. `(HASH-TABLE-ENTRIES :key1 _ :key2 value :key3 1)`.Expands into list of HASH-TABLE-ENTRY patterns combined with AND.") (when (oddp (length keys-and-patterns)) (warn (quote hash-table-odd-number-of-entries-warning) :format-control #A((92) base-char . "Odd number of arguments given to HASH-TABLE-ENTRIES pattern. NIL will be used as ~S pattern.") :format-arguments (last keys-and-patterns))) (sb-int:quasiquote (and #S(sb-impl::comma :expr (list (quote hash-table-entry) key pattern) :kind 0) #S(sb-impl::comma :expr (loop :for (key pattern) :on keys-and-patterns :by (function cddr) :collect (list (quote hash-table-entry) key pattern)) :kind 2))))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-error conditional-return-type-mismatch () (sets) "Due to a conditional the function could return any of the following:~{~%~a~} This stopped us working out the correct return types for this function" (mapcar (lambda (x) (or (map 'list #'type->type-spec x) :void)) sets))

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

(define-error conditional-return-type-mismatch () (sets) "Due to a conditional the function could return any of the following:~{~%~a~} This stopped us working out the correct return types for this function" (mapcar (lambda (x) (or (map 'list #'type->type-spec x) :void)) sets))

[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 conditional-return-type-mismatch (:error-type varjo-error :prefix "Varjo") (sets) "Due to a conditional the function could return any of the following:~{~%~a~} This stopped us working out the correct return types for this function" (mapcar (lambda (x) (or (map (quote list) (function type->type-spec) x) :void)) sets))


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

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

(cond-<>
  nil
  (progn))

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

;; macroexpand:
(let* ((#:var136 nil)
       (#:var137
        (if progn
            (-<>
              #:var136)
            #:var136)))
  #:var137)


[User]
Define a macro that eliminates this repetitive pattern:
(alist-bind (name type) form (let ((sym (foreign-type-symbol name :ctype *package*))) (if (pointer*-to-record-form-p type) (pushnew sym *foreign-record-list* :test #'equal) (if (pointer-alias-form-p type) (pushnew sym *foreign-alias-list* :test #'equal) (pushnew sym *foreign-other-exports-list*))) `(define-foreign-alias ',sym ',@(parse-type type (aval :tag type)))))

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

(alist-bind (name type) form (let ((sym (foreign-type-symbol name :ctype *package*))) (if (pointer*-to-record-form-p type) (pushnew sym *foreign-record-list* :test #'equal) (if (pointer-alias-form-p type) (pushnew sym *foreign-alias-list* :test #'equal) (pushnew sym *foreign-other-exports-list*))) `(define-foreign-alias ',sym ',@(parse-type type (aval :tag type)))))

[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 ((#:alist239 form)) (let ((name (aval :name #:alist239)) (type (aval :type #:alist239))) (let ((sym (foreign-type-symbol name :ctype *package*))) (if (pointer*-to-record-form-p type) (pushnew sym *foreign-record-list* :test (function equal)) (if (pointer-alias-form-p type) (pushnew sym *foreign-alias-list* :test (function equal)) (pushnew sym *foreign-other-exports-list*))) (sb-int:quasiquote (define-foreign-alias (quote #S(sb-impl::comma :expr sym :kind 0)) (quote #S(sb-impl::comma :expr (parse-type type (aval :tag type)) :kind 2)))))))


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

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

(some-> nil)

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

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


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

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

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

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(define-cfun __error)

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

(define-cfun __error)

[Assistant]
(defmacro define-cfun (name-or-function &optional (package *package*))
  (when-let ((fun (find-function name-or-function)))
    (with-wrap-attempt ("function ~S" name-or-function) name-or-function
      (with-slots (name type c-symbol fields) fun
        (let* ((fun-name (intern (symbol-name name) package))
               (param-names (mapcar #'foreign-type-name fields))
               (param-syms (mapcar (lambda (x) (gensym (symbol-name x))) param-names))
               (make-function-p (not (foreign-function-variadic-p fun)))
               (maybe-cbv-return
                 (when (cbv-return-p fun)
                   (list 'return-value))))
          (with-gensyms (!fun !fields rest)
            (let ((form
                    (if make-function-p
                        `(defun ,fun-name (,@maybe-cbv-return
                                           ,@param-names ,@(when (foreign-function-variadic-p fun) `(&rest ,rest)))
                           ,@(when maybe-cbv-return `((declare (ignorable ,@maybe-cbv-return))))
                           ,(let ((!fun (find-function name-or-function)))
                              (with-slots ((!fields fields)) !fun
                                (foreign-to-ffi
                                 (and (car !fields) (foreign-type (car !fields)))
                                 param-syms
                                 param-names
                                 !fields
                                 (make-foreign-funcall !fun (and maybe-cbv-return 'return-value)
                                                       param-syms (when (foreign-function-variadic-p fun) rest))))))
                        `(defmacro ,fun-name (,@maybe-cbv-return
                                              ,@param-names ,@(when (foreign-function-variadic-p fun) `(&rest ,rest)))
                           ,@(when maybe-cbv-return `((declare (ignorable ,@maybe-cbv-return))))
                           (let ((,!fun (find-function ',name-or-function)))
                             (with-slots ((,!fields fields)) ,!fun
                               (foreign-to-ffi
                                (and (car ,!fields) (foreign-type (car ,!fields)))
                                ',param-syms
                                (list ,@param-names)
                                ,!fields
                                (make-foreign-funcall ,!fun ,(and maybe-cbv-return 'return-value)
                                                      ',param-syms ,(when (foreign-function-variadic-p fun) rest)))))))))
              `(progn
                 ,@(when (foreign-function-cbv-p fun)
                     (list (funcall *build-libffi-definition* fun)))
                 ,form))))))))

;; macroexpand:
(progn (defun __error nil (cffi-sys:%foreign-funcall "__error" (:pointer) :convention :cdecl)))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-color (:green :stream stream) (format/indent reporter stream "✓ ~D test~:*~P completed" count))

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

(with-color (:green :stream stream) (format/indent reporter stream "✓ ~D test~:*~P completed" count))

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

;; macroexpand:
(if *enable-colors* (if (or (eq :green :gray) (eq :green :grey) (eq :green +gray+) (eq :green +grey+)) (with-gray stream (format/indent reporter stream "✓ ~D test~:*~P completed" count)) (cl-ansi-text:with-color (:green :stream stream) (format/indent reporter stream "✓ ~D test~:*~P completed" count))) (progn (format/indent reporter stream "✓ ~D test~:*~P completed" count)))


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

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

(collect-append nil (progn))

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

;; macroexpand:
(common-lisp:let* ((#:generator-223 (generator (progn)))
                   #:items-218
                   (#:seq-219 nil))
  (declare (type generator #:generator-223))
  (tagbody
   #:ll-224
    (setq #:items-218 (next-in #:generator-223 (go end)))
    (setq #:seq-219 (cons #:items-218 #:seq-219))
    (go #:ll-224)
   end)
  (apply #'concatenate nil (nreverse #:seq-219)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-temp (input-file :tmpdir d :template "XXXXXX.prolog" :debug (<= 1 *debug-prolog*)) (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (run-command-with-debug-print `("swipl" "--quiet" "-l" ,input-file ,@args) :input input :output output :error error))

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

(with-temp (input-file :tmpdir d :template "XXXXXX.prolog" :debug (<= 1 *debug-prolog*)) (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (run-command-with-debug-print `("swipl" "--quiet" "-l" ,input-file ,@args) :input input :output output :error error))

[Assistant]
(defmacro with-temp ((var &key directory template (tmpdir "/tmp/") debug) &body body)
  "Create a temporary file, then remove the file by unwind-protect.
Most arguments are analogous to mktemp.
When DIRECTORY is non-nil, creates a directory instead.
DEBUG is a form.
When evaluated to non-nil, it does not remove the directory so that you can investigate what happened inside the directory.
It may be evaluated multiple times."
  (with-gensyms (command)
    `(let ((,var (uiop:run-program
                  (let ((,command (format nil "mktemp --tmpdir='~a' ~@[-d~*~] ~@[~a~]"
                                          ,tmpdir ,directory ,template)))
                    (when ,debug
                      (format *error-output* "~&; ~a~%" ,command))
                    ,command)
                  :output '(:string :stripped t))))
       (unwind-protect
            (progn ,@body)
         (if ,debug
             (format *error-output* "~&; not removing ~a for debugging~%" ,var)
             (uiop:run-program (format nil "rm -rf ~a" (namestring ,var)) :ignore-error-status t))))))

;; macroexpand:
(let ((input-file (uiop/run-program:run-program (let ((#:command176 (format nil "mktemp --tmpdir='~a' ~@[-d~*~] ~@[~a~]" d nil "XXXXXX.prolog"))) (when (<= 1 *debug-prolog*) (format *error-output* "~&; ~a~%" #:command176)) #:command176) :output (quote (:string :stripped t))))) (unwind-protect (progn (with-open-file (s input-file :direction :output :if-does-not-exist :error) (dolist (r rules) (print-rule s r))) (run-command-with-debug-print (sb-int:quasiquote ("swipl" "--quiet" "-l" #S(sb-impl::comma :expr input-file :kind 0) #S(sb-impl::comma :expr args :kind 2))) :input input :output output :error error)) (if (<= 1 *debug-prolog*) (format *error-output* "~&; not removing ~a for debugging~%" input-file) (uiop/run-program:run-program (format nil "rm -rf ~a" (namestring input-file)) :ignore-error-status t))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-test timeout :time-limit 0.5 (sleep 0.75))

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

(define-test timeout :time-limit 0.5 (sleep 0.75))

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

;; macroexpand:
(let ((*package* (find-package #A((9) base-char . "PARACHUTE")))) (setf (find-test (quote timeout) (find-package #A((9) base-char . "PARACHUTE"))) (ensure-test (quote test) :name (quote timeout) :home (find-package #A((9) base-char . "PARACHUTE")) :tests (list (lambda nil (sleep 0.75))) :parent (quote nil) (quote :time-limit) (quote 0.5))) (quote timeout))


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

Problem: Macro call that should be transformed by ENABLE-READER-SYNTAX

(enable-reader-syntax nil)

[Assistant]
(defmacro ENABLE-READER-SYNTAX ...)

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute)
  (push *readtable* *previous-readtables*)
  (setq *readtable* (copy-readtable))
  (%enable-reader-syntax *readtable* nil))


[User]
Generate a defmacro form that transforms code like this:
(when (node-slot type) (del-proxy type))

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

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

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

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


[User]
Create a Common Lisp macro for the following transformation. Before code:
(do+ (for x (across #(3 2 1) :start 2 :end 0)) (collect x))

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

(do+ (for x (across #(3 2 1) :start 2 :end 0)) (collect x))

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

;; macroexpand:
(do+/internal nil (for x (across #(3 2 1) :start 2 :end 0)) (collect x))


[User]
Write a Common Lisp macro to handle this code pattern:
(defhandler load-time-value (load-time-value form &optional (read-only-p nil rop-p)) `(list ',load-time-value ,(e form) ,@(when rop-p `(',read-only-p))))

Problem: Macro call that should be transformed by defhandler

(defhandler load-time-value (load-time-value form &optional (read-only-p nil rop-p)) `(list ',load-time-value ,(e form) ,@(when rop-p `(',read-only-p))))

[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-load-time-value (load-time-value form &optional (read-only-p nil rop-p)) (sb-int:quasiquote (list (quote #S(sb-impl::comma :expr load-time-value :kind 0)) #S(sb-impl::comma :expr (e form) :kind 0) #S(sb-impl::comma :expr (when rop-p (sb-int:quasiquote ((quote #S(sb-impl::comma :expr read-only-p :kind 0))))) :kind 2)))) (setf (gethash (quote load-time-value) *form-handler*) (quote hander-load-time-value)))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(when (or body initializer) `(make-block ,body))

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

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

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

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


[User]
You are a Common Lisp macro expert. Given this code pattern:
(deferror "42P07" duplicate-table syntax-error-or-access-violation)

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

(deferror "42P07" duplicate-table syntax-error-or-access-violation)

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

;; macroexpand:
(progn (define-condition duplicate-table (syntax-error-or-access-violation) nil) (setf (gethash "42P07" *error-table*) (quote duplicate-table)))


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

Pattern to recognize: Macro call that should be transformed by AUTO-PERMUTE-TYPECASE

(auto-permute-typecase 'some-name)

[Assistant]
(defmacro AUTO-PERMUTE-TYPECASE ...)

;; macroexpand:
(typecase 'some-name)


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

Issue: Macro call that should be transformed by DYNAMIC-RELET

(dynamic-relet nil
  :key
  nil)

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

;; macroexpand:
(dynamic-wind
  :proceed
  #:proceed191
  (let ()
    (declare (special))
    (#:proceed191 :key nil)))


[User]
Define a macro that eliminates this repetitive pattern:
(rem-bops)

Issue: Macro call that should be transformed by REM-BOPS

(rem-bops)

[Assistant]
(defmacro REM-BOPS ...)

;; macroexpand:
(eval-when (:load-toplevel :compile-toplevel :execute)
  (progn (save-binfix) (mapc 'rmbop 'nil) (assign-properties)))


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

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

(mvlet* 'some-name)

[Assistant]
(defmacro MVLET* ...)

;; macroexpand:
(progn (let* ((quote) (some-name))))


[User]
Generate a defmacro form that transforms code like this:
(define-bug user-func-invalid-x () (kind name args) "Invalid types found in internal user-function construction. Our apologies for this mistake. If you have the time please raise an issue at https://github.com/cbaggers/varjo/issues including the code that triggered this issue. Problematic Definition: NAME: ~s ~a: ~s" name kind args)

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

(define-bug user-func-invalid-x () (kind name args) "Invalid types found in internal user-function construction. Our apologies for this mistake. If you have the time please raise an issue at https://github.com/cbaggers/varjo/issues including the code that triggered this issue. Problematic Definition: NAME: ~s ~a: ~s" name kind args)

[Assistant]
(defmacro define-bug (name (&key (error-type 'varjo-error) (prefix "Varjo Bug"))
                            (&rest args) error-string &body body)
  `(defcondition ,name (:error-type ,error-type :prefix ,prefix) ,args
       ,error-string ,@body))

;; macroexpand:
(defcondition user-func-invalid-x (:error-type varjo-error :prefix "Varjo Bug") (kind name args) "Invalid types found in internal user-function construction. Our apologies for this mistake. If you have the time please raise an issue at https://github.com/cbaggers/varjo/issues including the code that triggered this issue. Problematic Definition: NAME: ~s ~a: ~s" name kind args)


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

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

(define-op (:not unary-op))

[Assistant]
(defmacro define-op ((op-name struct-type &key sql-op-name include-slots (package (find-package '#:sxql/operator))) &body body)
  (check-type op-name symbol)
  (let ((struct-name (intern (concatenate 'string (symbol-name op-name) #.(string :-op)) package)))
    `(defstruct (,struct-name (:include ,struct-type
                               (name ,(or sql-op-name
                                          (with-output-to-string (s)
                                            (loop for c across (symbol-name op-name)
                                                  if (char= c #\-)
                                                    do (write-char #\Space s)
                                                  else
                                                    do (write-char c s)))))
                               ,@include-slots)
                              (:constructor ,(intern (concatenate 'string
                                                                  #.(string :make-)
                                                                  (symbol-name op-name)
                                                                  #.(string :-op))
                                                     package)
                                  ,(ecase struct-type
                                     ((unary-op
                                       unary-splicing-op
                                       unary-postfix-op) '(var))
                                     ((infix-op
                                       infix-splicing-op
                                       infix-list-op) '(left right))
                                     (conjunctive-op '(&rest expressions)))))
       ,@body)))

;; macroexpand:
(defstruct (not-op (:include unary-op (name "NOT")) (:constructor make-not-op (var))))


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

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

(collect-or nil)

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

;; macroexpand:
(common-lisp:let* ((#:generator-326 (generator nil))
                   #:bools-322
                   (#:bool-323 nil))
  (declare (type generator #:generator-326))
  (tagbody
   #:ll-327
    (setq #:bools-322 (next-in #:generator-326 (go end)))
    (if (setq #:bool-323 #:bools-322)
        (go end))
    (go #:ll-327)
   end)
  #:bool-323)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(action (:after node-field) #'handle-static-superclass)

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

(action (:after node-field) #'handle-static-superclass)

[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-field) (function handle-static-superclass))


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

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

(inext-noexit 'some-name)

[Assistant]
(defmacro INEXT-NOEXIT ...)

;; macroexpand:
(let ((vals (multiple-value-list (funcall (i-coro 'some-name) nil))))
  (if (not vals)
      (values nil nil)
      (values (car vals) t)))


[User]
Generate a defmacro form that transforms code like this:
(bind (((:flet doit (x)) "whatever" (declare (type fixnum x)) (setf x (* 2 x)) (setf x (+ x 3)) x)) (ensure-same (doit 1) 5) (ensure-same (doit 2) 7))

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

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

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

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

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

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

;; macroexpand:
(flet ((doit (x) "whatever" (declare (type fixnum x)) (progn (setf x (* 2 x)) (setf x (+ x 3)) x))) (progn (ensure-same (doit 1) 5) (ensure-same (doit 2) 7)))


[User]
Generate a defmacro form that transforms code like this:
(without-dependency-capture
  nil
  (progn))

Pattern to recognize: Macro call that should be transformed by WITHOUT-DEPENDENCY-CAPTURE

(without-dependency-capture
  nil
  (progn))

[Assistant]
(defmacro WITHOUT-DEPENDENCY-CAPTURE ...)

;; macroexpand:
(let ((%dependent% nil))
  nil
  (progn))


[User]
Generate a defmacro form that transforms code like this:
(with-constant-values (start end) env ((start end) (let* ((counted? (or (> start 0) end)) (test (if counted? `(and ,more? (cl:< ,index ,size)) more?)) (inc (when counted? `((cl:incf ,index))))) (values `((,table ,form) ,@(when counted? `((,index ,start) (,size ,(or end `(hash-table-count ,table)))))) `((with-custom-hash-table (with-hash-table-iterator (,next ,table) ,@body))) (make-iter-value test inc) (make-iter-place test inc)))) (nil (values `((,table ,form) (,index ,start) (,size (or ,end (hash-table-count ,table)))) `((with-custom-hash-table (with-hash-table-iterator (,next ,table) ,@body))) (make-iter-value `(and ,more? (cl:< ,index ,size)) `((cl:incf ,index))) (make-iter-place `(and ,more? (cl:< ,index ,size)) `((cl:incf ,index))))))

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

(with-constant-values (start end) env ((start end) (let* ((counted? (or (> start 0) end)) (test (if counted? `(and ,more? (cl:< ,index ,size)) more?)) (inc (when counted? `((cl:incf ,index))))) (values `((,table ,form) ,@(when counted? `((,index ,start) (,size ,(or end `(hash-table-count ,table)))))) `((with-custom-hash-table (with-hash-table-iterator (,next ,table) ,@body))) (make-iter-value test inc) (make-iter-place test inc)))) (nil (values `((,table ,form) (,index ,start) (,size (or ,end (hash-table-count ,table)))) `((with-custom-hash-table (with-hash-table-iterator (,next ,table) ,@body))) (make-iter-value `(and ,more? (cl:< ,index ,size)) `((cl:incf ,index))) (make-iter-place `(and ,more? (cl:< ,index ,size)) `((cl:incf ,index))))))

[Assistant]
(defmacro with-constant-values ((&rest things) env &body clauses)
  "Check whether one or more forms are constant and retrieve their values.

   THINGS:

     A list of bindings each of the form (VAR INITFORM).

     Each INITFORM is evaluated and the result is checked whether it
     is a constant form in the environment ENV. If so the constant
     value is stored in VAR otherwise the resulting form (to which
     INITFORM evaluates) itself is stored in VAR.

     Alternatively each element of THINGS can be a symbol in which
     case it is a shorthand for (VAR VAR).

   ENV:

     The environment in which to check whether the forms are
     constants.

   CLAUSES:

     A list of clauses each of the form (VARS . FORMS), where
     VARS is a list of variables, listed in THINGS, which should be
     constant in order for the corresponding FORMS to be evaluated.

     If all variables in VARS are constants FORMS are evaluated in an
     implicit PROGN, with the result of the last form returned.

     If not all of VARS are constant, FORMS are not evaluated and the
     next clause is tried. If no clause succeeds NIL is returned."

  (let ((const-vars (pairlis (mapcar #'ensure-car things)
                             (make-gensym-list (length things) "CONST?"))))

    (labels ((make-get-value (thing body)
               (destructuring-bind (var &optional (form var))
                   (ensure-list thing)

                 (let ((const-var (cdr (assoc var const-vars))))
                   (assert const-var)

                   `(multiple-value-bind (,var ,const-var)
                        (constant-form-value ,form ,env)

                      ,body))))

             (const-var (var)
               (let ((cvar (cdr (assoc var const-vars))))
                 (unless cvar
                   (error "Variable ~s in clause not one of ~s."
                          var (mapcar #'ensure-car things)))

                 cvar))

             (make-clause (clause)
               (destructuring-bind (vars &rest body) clause
                 `((and ,@(mapcar #'const-var vars))
                   ,@body))))

      (cl:reduce
       #'make-get-value
       things
       :from-end t
       :initial-value
       `(cond ,@(mapcar #'make-clause clauses))))))

;; macroexpand:
(multiple-value-bind (start #:const?144) (constant-form-value start env) (multiple-value-bind (end #:const?145) (constant-form-value end env) (cond ((and #:const?144 #:const?145) (let* ((counted? (or (> start 0) end)) (test (if counted? (sb-int:quasiquote (and #S(sb-impl::comma :expr more? :kind 0) (< #S(sb-impl::comma :expr index :kind 0) #S(sb-impl::comma :expr size :kind 0)))) more?)) (inc (when counted? (sb-int:quasiquote ((incf #S(sb-impl::comma :expr index :kind 0))))))) (values (sb-int:quasiquote ((#S(sb-impl::comma :expr table :kind 0) #S(sb-impl::comma :expr form :kind 0)) #S(sb-impl::comma :expr (when counted? (sb-int:quasiquote ((#S(sb-impl::comma :expr index :kind 0) #S(sb-impl::comma :expr start :kind 0)) (#S(sb-impl::comma :expr size :kind 0) #S(sb-impl::comma :expr (or end (sb-int:quasiquote (hash-table-count #S(sb-impl::comma :expr table :kind 0)))) :kind 0))))) :kind 2))) (sb-int:quasiquote ((with-custom-hash-table (with-hash-table-iterator (#S(sb-impl::comma :expr next :kind 0) #S(sb-impl::comma :expr table :kind 0)) #S(sb-impl::comma :expr body :kind 2))))) (make-iter-value test inc) (make-iter-place test inc)))) ((and) (values (sb-int:quasiquote ((#S(sb-impl::comma :expr table :kind 0) #S(sb-impl::comma :expr form :kind 0)) (#S(sb-impl::comma :expr index :kind 0) #S(sb-impl::comma :expr start :kind 0)) (#S(sb-impl::comma :expr size :kind 0) (or #S(sb-impl::comma :expr end :kind 0) (hash-table-count #S(sb-impl::comma :expr table :kind 0)))))) (sb-int:quasiquote ((with-custom-hash-table (with-hash-table-iterator (#S(sb-impl::comma :expr next :kind 0) #S(sb-impl::comma :expr table :kind 0)) #S(sb-impl::comma :expr body :kind 2))))) (make-iter-value (sb-int:quasiquote (and #S(sb-impl::comma :expr more? :kind 0) (< #S(sb-impl::comma :expr index :kind 0) #S(sb-impl::comma :expr size :kind 0)))) (sb-int:quasiquote ((incf #S(sb-impl::comma :expr index :kind 0))))) (make-iter-place (sb-int:quasiquote (and #S(sb-impl::comma :expr more? :kind 0) (< #S(sb-impl::comma :expr index :kind 0) #S(sb-impl::comma :expr size :kind 0)))) (sb-int:quasiquote ((incf #S(sb-impl::comma :expr index :kind 0))))))))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-condition missing-partial (serious-condition) ())

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

(define-condition missing-partial (serious-condition) ())

[Assistant]
(defmacro define (name template)
  "Define a named renderer of string TEMPLATE."
  `(setf (symbol-function ',name)
         (compile-template ,template)))

;; macroexpand:
(progn (sb-kernel::%define-condition (quote missing-partial) (quote (serious-condition)) (sb-kernel::find-condition-layout (quote missing-partial) (quote (serious-condition))) (list) (list) (quote nil) (quote nil) (sb-c:source-location)) (sb-kernel::%set-condition-report (quote missing-partial) nil) (quote missing-partial))