[User]
Generate a defmacro form that transforms code like this:
(c-assert (eql :nascent (md-state self)))

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

(c-assert (eql :nascent (md-state self)))

[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 (eql :nascent (md-state self)) (c-break "failed assertion: ~a" (quote (eql :nascent (md-state self))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(def-neo4j-fun get-paths (node-id to-node-id relationships (max-depth 3) (algorithm :shortest-path)) :post (:uri-spec (format nil "node/~A/paths" node-id)) (:encode (list (list (cons "to" to-node-id) :node-url) (list (cons "relationships" relationships)) (list (cons "max_depth" max-depth)) (list (cons "algorithm" (case algorithm (:shortest-path "shortestPath") (:all-paths "allPaths") (:all-simple-paths "allSimplePaths") (:dijkstra "dijkstra"))))) :object) (:status-handlers (200 (decode-neo4j-json-output body)) (204 (error 'path-not-found-error :uri uri))))

Problem: Macro call that should be transformed by def-neo4j-fun

(def-neo4j-fun get-paths (node-id to-node-id relationships (max-depth 3) (algorithm :shortest-path)) :post (:uri-spec (format nil "node/~A/paths" node-id)) (:encode (list (list (cons "to" to-node-id) :node-url) (list (cons "relationships" relationships)) (list (cons "max_depth" max-depth)) (list (cons "algorithm" (case algorithm (:shortest-path "shortestPath") (:all-paths "allPaths") (:all-simple-paths "allSimplePaths") (:dijkstra "dijkstra"))))) :object) (:status-handlers (200 (decode-neo4j-json-output body)) (204 (error 'path-not-found-error :uri uri))))

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

;; macroexpand:
(progn (defun get-paths (&key node-id to-node-id relationships (max-depth 3) (algorithm :shortest-path)) (let ((uri (format nil "node/~A/paths" node-id)) (json (encode-neo4j-json-payload (list (list (cons "to" to-node-id) :node-url) (list (cons "relationships" relationships)) (list (cons "max_depth" max-depth)) (list (cons "algorithm" (case algorithm (:shortest-path "shortestPath") (:all-paths "allPaths") (:all-simple-paths "allSimplePaths") (:dijkstra "dijkstra"))))) :object))) (make-neo4j-request :post uri json (list (list 200 (lambda (body uri json) (decode-neo4j-json-output body))) (list 204 (lambda (body uri json) (error (quote path-not-found-error) :uri uri))))))))


[User]
Generate a defmacro form that transforms code like this:
(define-cfun c-calloc)

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

(define-cfun c-calloc)

[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 c-calloc (nmemb size) (let ((#:nmemb204 nmemb)) (declare (ignorable #:nmemb204)) (let ((#:size205 size)) (declare (ignorable #:size205)) (cffi-sys:%foreign-funcall "calloc" (:unsigned-long-long #:nmemb204 :unsigned-long-long #:size205 :pointer) :convention :cdecl)))))


[User]
Define a macro that eliminates this repetitive pattern:
(defstore nxpy (y x &optional (a 1) (b 1)))

Issue: Macro call that should be transformed by defstore

(defstore nxpy (y x &optional (a 1) (b 1)))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (progn (ensure-store (quote nxpy) (quote (y x &optional (a 1 #:a?149) (b 1 #:b?150))))))


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

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

(define-modf-rewrite third (expr) `(caddr ,(second expr)))

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

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


[User]
You are a Common Lisp macro expert. Given this code pattern:
(when (not (slot-value parent 'tail-qualifiers)) (format stream " "))

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

(when (not (slot-value parent 'tail-qualifiers)) (format stream " "))

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

;; macroexpand:
(if (not (slot-value parent (quote tail-qualifiers))) (format stream " "))


[User]
You are a Common Lisp macro expert. Given this code pattern:
;; Threading a value through multiple dependent checks
(let ((user (find-user id)))
  (if user
      (let ((orders (get-orders user)))
        (if orders
            (let ((latest (first orders)))
              (if latest
                  (process latest)
                  :no-orders))
            :no-orders))
      :no-user))
;; Deeply nested ifs obscure the linear flow

Write a macro that addresses: Threading a value through dependent operations creates deep if-nesting — want linear, pipeline-like syntax

;; Threading a value through multiple dependent checks
(let ((user (find-user id)))
  (if user
      (let ((orders (get-orders user)))
        (if orders
            (let ((latest (first orders)))
              (if latest
                  (process latest)
                  :no-orders))
            :no-orders))
      :no-user))
;; Deeply nested ifs obscure the linear flow

[Assistant]
(defmacro aand (&rest args)
  (cond ((null args) t)
        ((null (cdr args)) (car args))
        (t `(aif ,(car args) (aand ,@(cdr args))))))

;; macroexpand:
;; (aand (find-user id)
;;       (get-orders it)
;;       (first it)
;;       (process it))
;;
;; Each form's result is bound to 'it' for the next form.
;; If any form returns nil, the chain stops and returns nil.
;; Linear, readable, no nesting.


[User]
Create a Common Lisp macro for the following transformation. Before code:
(integer-reader 8)

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

(integer-reader 8)

[Assistant]
(defmacro integer-reader (bytes)
  "Create a function to read integers from a binary stream."
  (let ((bits (* bytes 8)))
    (labels ((return-form (signed)
               (if signed
                   `(if (logbitp ,(1- bits) result)
                        (dpb result (byte ,(1- bits) 0) -1)
                        result)
                   `result))
             (generate-reader (signed)
               `(defun ,(integer-reader-name bytes signed) (socket)
                  (declare (type stream socket)
                           #.*optimize*)
                  ,(if (= bytes 1)
                       `(let ((result (the (unsigned-byte 8) (read-byte socket))))
                          (declare (type (unsigned-byte 8) result))
                          ,(return-form signed))
                       `(let ((result 0))
                          (declare (type (unsigned-byte ,bits) result))
                          ,@(loop :for byte :from (1- bytes) :downto 0
                                  :collect `(setf (ldb (byte 8 ,(* 8 byte))
                                                       result)
                                                  (the (unsigned-byte 8)
                                                       (read-byte socket))))
                          ,(return-form signed))))))
      `(progn
         ;; This causes weird errors on SBCL in some circumstances. Disabled for now.
         ;;         (declaim (inline ,(integer-reader-name bytes t)
         ;;                          ,(integer-reader-name bytes nil)))
         (declaim (ftype (function (t) (signed-byte ,bits))
                         ,(integer-reader-name bytes t)))
         ,(generate-reader t)
         (declaim (ftype (function (t) (unsigned-byte ,bits))
                         ,(integer-reader-name bytes nil)))
         ,(generate-reader nil)))))

;; macroexpand:
(progn (declaim (ftype (function (t) (signed-byte 64)) read-int8)) (defun read-int8 (socket) (declare (type stream socket) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (let ((result 0)) (declare (type (unsigned-byte 64) result)) (setf (ldb (byte 8 56) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 48) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 40) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 32) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 24) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 16) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 8) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 0) result) (the (unsigned-byte 8) (read-byte socket))) (if (logbitp 63 result) (dpb result (byte 63 0) -1) result))) (declaim (ftype (function (t) (unsigned-byte 64)) read-uint8)) (defun read-uint8 (socket) (declare (type stream socket) (optimize (speed 3) (safety 0) (space 1) (debug 1) (compilation-speed 0))) (let ((result 0)) (declare (type (unsigned-byte 64) result)) (setf (ldb (byte 8 56) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 48) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 40) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 32) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 24) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 16) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 8) result) (the (unsigned-byte 8) (read-byte socket))) (setf (ldb (byte 8 0) result) (the (unsigned-byte 8) (read-byte socket))) result)))


[User]
Generate a defmacro form that transforms code like this:
(define-op (:>= infix-op))

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

(define-op (:>= infix-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 (>=-op (:include infix-op (name ">=")) (:constructor make->=-op (left right))))


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

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

(defun+ nil
    nil)

[Assistant]
(defmacro DEFUN+ ...)

;; macroexpand:
(defun nil () (let+ nil))


[User]
Define a macro that eliminates this repetitive pattern:
(defun-compile-time cps-convert-function-name (function-name) (if (symbolp function-name) (intern (format nil "~A-NONDETERMINISTIC" (string function-name)) (symbol-package function-name)) `(setf ,(intern (format nil "~A-NONDETERMINISTIC" (string (second function-name))) (symbol-package (second function-name))))))

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

(defun-compile-time cps-convert-function-name (function-name) (if (symbolp function-name) (intern (format nil "~A-NONDETERMINISTIC" (string function-name)) (symbol-package function-name)) `(setf ,(intern (format nil "~A-NONDETERMINISTIC" (string (second function-name))) (symbol-package (second function-name))))))

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (common-lisp:defun cps-convert-function-name (function-name) (if (symbolp function-name) (intern (format nil "~A-NONDETERMINISTIC" (string function-name)) (symbol-package function-name)) (sb-int:quasiquote (setf #S(sb-impl::comma :expr (intern (format nil "~A-NONDETERMINISTIC" (string (second function-name))) (symbol-package (second function-name))) :kind 0))))) (eval-when (:compile-toplevel) (compile (quote cps-convert-function-name))))


[User]
Generate a defmacro form that transforms code like this:
(let-syntax common-lisp:nil (common-lisp:progn))

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

(let-syntax common-lisp:nil (common-lisp:progn))

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

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


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

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

(augment steppers step)

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list ,@body))

Problem: Macro call that should be transformed by destructure-specialized-lambda-list

(destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list ,@body))

[Assistant]
(defmacro destructure-specialized-lambda-list (descriptive-lambda-list-sym vanilla-lambda-list-sym type-list-sym specialized-lambda-list &body body)
  "if specialized-lambda-list is ((a integer) b):
descriptive-lambda-list will be ((x integer) (x t))
type-list will be (integer t) and vanilla-lambda-list is (a b)"
  (let ((item (gensym)))
    `(let* ((,descriptive-lambda-list-sym
             (loop :for ,item :in ,specialized-lambda-list
                :if (listp ,item)
                :collect ,item
                :else :collect (list ,item t)))
            (,vanilla-lambda-list-sym (mapcar #'first ,descriptive-lambda-list-sym))
            (,type-list-sym (mapcar #'second ,descriptive-lambda-list-sym)))
       (declare (ignorable ,descriptive-lambda-list-sym ,vanilla-lambda-list-sym ,type-list-sym))
       ,@body)))

;; macroexpand:
(let* ((descriptive-lambda-list (loop :for #:g127 :in specialized-lambda-list :if (listp #:g127) :collect #:g127 :else :collect (list #:g127 t))) (vanilla-lambda-list (mapcar (function first) descriptive-lambda-list)) (type-list (mapcar (function second) descriptive-lambda-list))) (declare (ignorable descriptive-lambda-list vanilla-lambda-list type-list)) (sb-int:quasiquote (%lay-method-base-for-dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr type-list :kind 0) #S(sb-impl::comma :expr descriptive-lambda-list :kind 0) #S(sb-impl::comma :expr body :kind 2))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(disable-infix-reader)

What needs to change: Macro call that should be transformed by DISABLE-INFIX-READER

(disable-infix-reader)

[Assistant]
(defmacro DISABLE-INFIX-READER ...)

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute)
  (setq *readtable* (pop *readtables*)))


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

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

(defsynonym for :for)

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(signal-syntax-error* (1- (lexer-pos lexer)) "Character '~A' may not follow '(?<'." next-char )

Issue: Macro call that should be transformed by signal-syntax-error*

(signal-syntax-error* (1- (lexer-pos lexer)) "Character '~A' may not follow '(?<'." next-char )

[Assistant]
(defmacro signal-syntax-error* (pos format-control &rest format-arguments)
  `(error 'ppcre-syntax-error
          :pos ,pos
          :format-control ,format-control
          :format-arguments (list ,@format-arguments)))

;; macroexpand:
(error (quote ppcre-syntax-error) :pos (1- (lexer-pos lexer)) :format-control "Character '~A' may not follow '(?<'." :format-arguments (list next-char))


[User]
Define a macro that eliminates this repetitive pattern:
(define BUFSIZ 512)

Issue: Macro call that should be transformed by define

(define BUFSIZ 512)

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

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


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

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

(define-modf-rewrite cdaadr (expr) `(cdr (caadr ,(second expr))))

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(letrec* ((f (constantly t)) (a (funcall f))) (is-true a))

Problem: Macro call that should be transformed by letrec*

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

[Assistant]
(defmacro letrec* ((&rest bindings) &body body)
  "Like LETREC, but the bindings are evaluated in order.
See Waddell et al., *Fixing Letrec* for motivation.

Cf. `fbindrec*'."
  `(letrec-with setq ,bindings
     ,@body))

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


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

Problem: Macro call that should be transformed by GATHER-NEXT

(gather-next nil nil)

[Assistant]
(defmacro GATHER-NEXT ...)

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


[User]
Write a Common Lisp macro to handle this code pattern:
(bind ((#2a((a b c) (d e f)) #2a((1 2 3) (4 5 6)))) (list a b c d e f))

Problem: Macro call that should be transformed by bind

(bind ((#2a((a b c) (d e f)) #2a((1 2 3) (4 5 6)))) (list a b c d e f))

[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-167| #2A((1 2 3) (4 5 6))) (a (row-major-aref #:|values-167| 0)) (b (row-major-aref #:|values-167| 1)) (c (row-major-aref #:|values-167| 2)) (d (row-major-aref #:|values-167| 3)) (e (row-major-aref #:|values-167| 4)) (f (row-major-aref #:|values-167| 5))) (declare (ignorable #:|values-167|)) (progn (list a b c d e f)))


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

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

(ps-once-only nil
  :key
  nil)

[Assistant]
(defmacro PS-ONCE-ONLY ...)

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


[User]
You are a Common Lisp macro expert. Given this code pattern:
(match maybe m ((just x) x) (nothing else))

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

(match maybe m ((just x) x) (nothing else))

[Assistant]
(defmacro match (adt obj &body clauses)
  "Perform pattern matching on OBJ with (adt-type) ADT.

Each clause must have the following syntax:

<var> := <symbol> | '_'
<lhs> := '_'
       | (<symbol> <var>*)
<clause> := (<lhs> <lisp code>)

The symbol '_' denotes a wildcard, as well as a fallthough.

Note that pattern matching is only shallow (patterns are one-level
deep).
"
  (assert (symbolp adt)
          (adt)
          "MATCH requires a symbol for the first argument. Given ~S."
          adt)

  (let ((ctors (mapcar #'car (get-constructors adt)))
        (types (mapcar (lambda (clause)
                         (ensure-car (car clause)))
                       clauses))
        (once (gensym "OBJ-")))

    ;; Check for duplicate matches.
    (let ((dupes (duplicates types)))
      (when dupes
        (warn "Duplicate matching clauses exist. Duplicate pattern ~
               constructors:~{ ~S~}"
              dupes)))

    ;; Check for match exhaustiveness.
    (unless (some #'wild? types)
      (let ((diff (set-difference ctors types)))
        (when diff
          (warn "Non-exhaustive match on ~A data ~
                 type. Missing cases:~{ ~S~}" adt diff))))

    ;; Generate the matching code.
    `(let ((,once ,obj))
       (check-type ,once ,adt)
       (etypecase ,once
         ,@(loop :for (bindings . body) :in clauses
                 :collect (let ((type (ensure-car bindings)))
                            (if (wild? type)
                                `(t ,@body)
                                `(,type
                                  (with-data ,(ensure-list bindings)
                                             ,once
                                    ,@body)))))))))

;; macroexpand:
(let ((#:obj-147 m)) (check-type #:obj-147 maybe) (etypecase #:obj-147 (just (with-data (just x) #:obj-147 x)) (nothing (with-data (nothing) #:obj-147 else))))


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

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

(dig 'some-name)

[Assistant]
(defmacro DIG ...)

;; macroexpand:
(dig 1 'some-name)


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

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

(as->* nil nil)

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

;; macroexpand:
(as-> nil nil)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(when (slot-boundp item slot) (when (eq (slot-value item slot) nil) (setf subnodes (remove slot subnodes))) (let ((position (position slot subnodes))) (setf (slot-value node-copy slot) (if position (nth position subnode-copies) (slot-value item slot)))))

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

(when (slot-boundp item slot) (when (eq (slot-value item slot) nil) (setf subnodes (remove slot subnodes))) (let ((position (position slot subnodes))) (setf (slot-value node-copy slot) (if position (nth position subnode-copies) (slot-value item slot)))))

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

;; macroexpand:
(if (slot-boundp item slot) (progn (when (eq (slot-value item slot) nil) (setf subnodes (remove slot subnodes))) (let ((position (position slot subnodes))) (setf (slot-value node-copy slot) (if position (nth position subnode-copies) (slot-value item slot))))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-env [str 0])

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

(with-env [str 0])

[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 (#:g123) (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 #:g123 (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)) [str 0])) (setf (find-class (quote foo) nil) nil) (setf (find-class (quote bar) nil) nil) #:g123)


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

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

(without-symbol-access
  nil
  nil)

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

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


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

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

(matrix-typecase nil)

[Assistant]
(defmacro MATRIX-TYPECASE ...)

;; macroexpand:
nil


[User]
Generate a defmacro form that transforms code like this:
(define-simple-definition-resolver symbol-macro designator-symbol-macro-p)

Pattern to recognize: Macro call that should be transformed by define-simple-definition-resolver

(define-simple-definition-resolver symbol-macro designator-symbol-macro-p)

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

;; macroexpand:
(define-definition-resolver symbol-macro (symbol-macro #:package141) (when (ignore-errors (designator-symbol-macro-p symbol-macro)) (list (make-instance (quote symbol-macro) :designator symbol-macro :package #:package141))))


[User]
Define a macro that eliminates this repetitive pattern:
($/ "[_]*.mr." "i")

Issue: Macro call that should be transformed by $/

($/ "[_]*.mr." "i")

[Assistant]
(defmacro $/ (regex options)
  `(make-bson-regex (empty-str ,regex) ,options))

;; macroexpand:
(make-bson-regex (empty-str "[_]*.mr.") "i")


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

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

(cond->)

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

;; macroexpand:
nil


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

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

(enable-sharp-boolean-syntax)

[Assistant]
(defmacro ENABLE-SHARP-BOOLEAN-SYNTAX ...)

;; macroexpand:
(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-sharp-boolean-syntax-in-readtable)
  (values))


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

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

(collect-file nil nil)

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

;; macroexpand:
(common-lisp:let* ((#:generator-542 (generator nil)) #:items-536 (#:out-538 t))
  (declare (type generator #:generator-542)
           (type boolean #:out-538))
  (with-open-file (#:outfile-535 nil :direction :output)
    (tagbody
     #:ll-543
      (setq #:items-536 (next-in #:generator-542 (go end)))
      (common-lisp:funcall #'print #:items-536 #:outfile-535)
      (go #:ll-543)
     end))
  #:out-538)


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

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

(enable-readtime-wrapper-syntax 'some-name)

[Assistant]
(defmacro ENABLE-READTIME-WRAPPER-SYNTAX ...)

;; macroexpand:
(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-readtime-wrapper-syntax-in-readtable 'some-name #\RIGHT_CURLY_BRACKET)
  (values))


[User]
Define a macro that eliminates this repetitive pattern:
(true "Happy")

Issue: Macro call that should be transformed by true

(true "Happy")

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

;; macroexpand:
(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (true "Happy")) :value-form (quote "Happy") :body (lambda nil "Happy") :expected (quote t) :comparison (quote geq)))


[User]
Define a macro that eliminates this repetitive pattern:
(defhandler labels (labels bindings &rest body) `(with-imposed-bindings (,labels ,(clean-fbindings bindings) ,(declare-fbindings-ignorable bindings) (list* ',labels ,(dump-fbindings bindings) (m-list ,@body)))))

Issue: Macro call that should be transformed by defhandler

(defhandler labels (labels bindings &rest body) `(with-imposed-bindings (,labels ,(clean-fbindings bindings) ,(declare-fbindings-ignorable bindings) (list* ',labels ,(dump-fbindings bindings) (m-list ,@body)))))

[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-labels (labels bindings &rest body) (sb-int:quasiquote (with-imposed-bindings (#S(sb-impl::comma :expr labels :kind 0) #S(sb-impl::comma :expr (clean-fbindings bindings) :kind 0) #S(sb-impl::comma :expr (declare-fbindings-ignorable bindings) :kind 0) (list* (quote #S(sb-impl::comma :expr labels :kind 0)) #S(sb-impl::comma :expr (dump-fbindings bindings) :kind 0) (m-list #S(sb-impl::comma :expr body :kind 2))))))) (setf (gethash (quote labels) *form-handler*) (quote hander-labels)))


[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* ((#:|some120| nil))
  #:|some120|)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-binary-op-mapping-definer define-comparison-ops `(progn (defmethod ,op ((x memptr) (y memptr)) (if (and (eq (memptr-mem x) (memptr-mem y)) (,cl (memptr-ptr x) (memptr-ptr y))) 1 0)) (defmethod ,op ((x number) (y number)) (if (,cl x y) 1 0))))

Write a macro that addresses: Macro call that should be transformed by define-binary-op-mapping-definer

(define-binary-op-mapping-definer define-comparison-ops `(progn (defmethod ,op ((x memptr) (y memptr)) (if (and (eq (memptr-mem x) (memptr-mem y)) (,cl (memptr-ptr x) (memptr-ptr y))) 1 0)) (defmethod ,op ((x number) (y number)) (if (,cl x y) 1 0))))

[Assistant]
(defmacro define-binary-op-mapping-definer (name &body body)
  `(defmacro ,name (&rest map)
     `(progn ,@(loop for (vacietis cl) on map by #'cddr collect
                    (let ((op (find-symbol (symbol-name vacietis) '#:vacietis.c)))
                      ,@body)))))

;; macroexpand:
(defmacro define-comparison-ops (&rest map) (sb-int:quasiquote (progn #S(sb-impl::comma :expr (loop for (vacietis cl) on map by (function cddr) collect (let ((op (find-symbol (symbol-name vacietis) (quote #:vacietis.c)))) (sb-int:quasiquote (progn (defmethod #S(sb-impl::comma :expr op :kind 0) ((x memptr) (y memptr)) (if (and (eq (memptr-mem x) (memptr-mem y)) (#S(sb-impl::comma :expr cl :kind 0) (memptr-ptr x) (memptr-ptr y))) 1 0)) (defmethod #S(sb-impl::comma :expr op :kind 0) ((x number) (y number)) (if (#S(sb-impl::comma :expr cl :kind 0) x y) 1 0)))))) :kind 2))))


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

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

(false (sleep 1))

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

;; macroexpand:
(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (false (sleep 1))) :value-form (quote (sleep 1)) :body (lambda nil (sleep 1)) :expected (quote nil) :comparison (quote geq)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list (with-effective-qualifier generic-function qualifier `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list (dispatch ,generic-function ,qualifier ,specialized-lambda-list) ,@body)))

What needs to change: Macro call that should be transformed by destructure-specialized-lambda-list

(destructure-specialized-lambda-list descriptive-lambda-list vanilla-lambda-list type-list specialized-lambda-list (with-effective-qualifier generic-function qualifier `(%lay-method-base-for-dispatch ,generic-function ,qualifier ,type-list ,descriptive-lambda-list (dispatch ,generic-function ,qualifier ,specialized-lambda-list) ,@body)))

[Assistant]
(defmacro destructure-specialized-lambda-list (descriptive-lambda-list-sym vanilla-lambda-list-sym type-list-sym specialized-lambda-list &body body)
  "if specialized-lambda-list is ((a integer) b):
descriptive-lambda-list will be ((x integer) (x t))
type-list will be (integer t) and vanilla-lambda-list is (a b)"
  (let ((item (gensym)))
    `(let* ((,descriptive-lambda-list-sym
             (loop :for ,item :in ,specialized-lambda-list
                :if (listp ,item)
                :collect ,item
                :else :collect (list ,item t)))
            (,vanilla-lambda-list-sym (mapcar #'first ,descriptive-lambda-list-sym))
            (,type-list-sym (mapcar #'second ,descriptive-lambda-list-sym)))
       (declare (ignorable ,descriptive-lambda-list-sym ,vanilla-lambda-list-sym ,type-list-sym))
       ,@body)))

;; macroexpand:
(let* ((descriptive-lambda-list (loop :for #:g125 :in specialized-lambda-list :if (listp #:g125) :collect #:g125 :else :collect (list #:g125 t))) (vanilla-lambda-list (mapcar (function first) descriptive-lambda-list)) (type-list (mapcar (function second) descriptive-lambda-list))) (declare (ignorable descriptive-lambda-list vanilla-lambda-list type-list)) (with-effective-qualifier generic-function qualifier (sb-int:quasiquote (%lay-method-base-for-dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr type-list :kind 0) #S(sb-impl::comma :expr descriptive-lambda-list :kind 0) (dispatch #S(sb-impl::comma :expr generic-function :kind 0) #S(sb-impl::comma :expr qualifier :kind 0) #S(sb-impl::comma :expr specialized-lambda-list :kind 0)) #S(sb-impl::comma :expr body :kind 2)))))


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

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

(defmethod* nil
    nil)

[Assistant]
(defmacro DEFMETHOD* ...)

;; macroexpand:
(defmethod nil (the t ()))


[User]
Generate a defmacro form that transforms code like this:
(mvlet* ((x)) x)

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

(mvlet* ((x)) x)

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

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

    (var var*... expr)

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

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

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

;; macroexpand:
(let* ((x)) x)


[User]
Define a macro that eliminates this repetitive pattern:
(form-fiddle:lambda-forms `(lambda () ,@body))

Issue: Macro call that should be transformed by for

(form-fiddle:lambda-forms `(lambda () ,@body))

[Assistant]
(defmacro for (&environment env bindings &body body)
  (let ((*environment* env))
    (multiple-value-bind (bind-init bind-forms bind-exit bind-post) (convert-bindings bindings)
      (multiple-value-bind (clause-init body-forms clause-exit) (convert-clauses body)
        `(with-interleaving
           ,@bind-init
           ,@clause-init
           (with-for-block ()
             (with-for-tagbody
                 (progn ,@bind-forms
                        ,@body-forms
                        ,@bind-post)
               (return-for
                ,@clause-exit
                ,@bind-exit))))))))

;; macroexpand:
(form-fiddle:lambda-forms (sb-int:quasiquote (lambda nil #S(sb-impl::comma :expr body :kind 2))))


[User]
Define a macro that eliminates this repetitive pattern:
(signal-syntax-error* error-pos "No character for hex-code ~X." number)

Issue: Macro call that should be transformed by signal-syntax-error*

(signal-syntax-error* error-pos "No character for hex-code ~X." number)

[Assistant]
(defmacro signal-syntax-error* (pos format-control &rest format-arguments)
  `(error 'ppcre-syntax-error
          :pos ,pos
          :format-control ,format-control
          :format-arguments (list ,@format-arguments)))

;; macroexpand:
(error (quote ppcre-syntax-error) :pos error-pos :format-control "No character for hex-code ~X." :format-arguments (list number))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(nth-value-or 1 (values 1 nil 1) (values 2 2 2))

What needs to change: Macro call that should be transformed by nth-value-or

(nth-value-or 1 (values 1 nil 1) (values 2 2 2))

[Assistant]
(defmacro nth-value-or (nth-value &body forms)
  "Evaluates FORM arguments one at a time, until the NTH-VALUE returned by one
of the forms is true. It then returns all the values returned by evaluating
that form. If none of the forms return a true nth value, this form returns
NIL."
  (once-only (nth-value)
    (with-gensyms (values)
      `(let ((,values (multiple-value-list ,(first forms))))
         (if (nth ,nth-value ,values)
             (values-list ,values)
             ,(if (rest forms)
                  `(nth-value-or ,nth-value ,@(rest forms))
                  nil))))))

;; macroexpand:
(let ((#:nth-value149 1)) (let ((#:values150 (multiple-value-list (values 1 nil 1)))) (if (nth #:nth-value149 #:values150) (values-list #:values150) (nth-value-or #:nth-value149 (values 2 2 2)))))


[User]
Write a Common Lisp macro to handle this code pattern:
(defdata (point :mutable t) (rect float float))

Problem: Macro call that should be transformed by defdata

(defdata (point :mutable t) (rect float float))

[Assistant]
(defmacro defdata (adt-name &body constructors)
  "Define a new ADT. ADT-name has the following grammar:

ADT-NAME := <symbol>
          | (<symbol> <options>*)

There is no difference between specifying it as a symbol or as a
singleton list. There are two possible options, specified as a
property list:

    * :MUTABLE {T, NIL} (default: NIL): Specifies whether the fields
      of the type are mutable, allowing the use of SET-DATA.

    * :INCLUDE <adt-type>: Specifies whether another defined ADT
      should be inherited.

Constructors is a list of clauses with the following grammar:

<clause> := <symbol>
          | (<symbol> <type-specifier>*)

Each clause defines a constructor for the ADT. Nullary constructors
will define constants and all other constructors will define
functions."
  ;; Do some extreme sanity checking.
  (assert
   (or
    ;; Must be a symbol, or...
    (symbolp adt-name)
    (and
     ;; a list that is...
     (listp adt-name)
     ;; non-empty
     (not (null adt-name))
     ;; whose first element is a symbol (the name of the adt)
     (symbolp (first adt-name))
     ;; and the rest is a property list
     (property-list-p (rest adt-name))))
   (adt-name)
   "ADT-NAME must either be a symbol, a singleton list with the ADT ~
      name as a symbol, or a list of two elements with the ADT name ~
      and :MUTABLE respectively. Given ~S."
   adt-name)
  (let ((valid-options (list ':mutable ':include)))
    (when (and (listp adt-name) (= (mod (length (rest adt-name)) 2) 0))
      (loop for opt in (rest adt-name) by #'cddr do
	   (when (not (member opt valid-options))
	     (error "Option ~A is not valid, valid options are member of ~A." opt valid-options)))))

  (let ((adt-name (ensure-car adt-name))
        (mutable? (and (listp adt-name)
                       (getf (rest adt-name) ':mutable)
                       t))
        (include (or (and (listp adt-name)
                          (getf (rest adt-name) ':include))
                     'algebraic-data-type))
        (object (gensym "OBJECT-"))
        (stream (gensym "STREAM-"))
        (depth (gensym "DEPTH-"))
        (env (gensym "ENVIRONMENT-"))
        (documentation
          (when (stringp (car constructors))
            (pop constructors))))

    ;; Sanity check that INCLUDE is a proper algebraic data type.
    (assert (algebraic-data-type-p include)
            ()
            "When defining the algebraic data type ~S, the :INCLUDE option ~
             was specified with ~S, which is not another algebraic data ~
             type."
            adt-name
            include)

    ;; Add constructors and their arity to the database.
    (flet ((constructor-and-arity (ctor)
             (if (listp ctor)
                 (list (first ctor) (length (rest ctor)))
                 (list ctor 0))))
      (set-constructors adt-name (append (get-constructors include)
                                         (mapcar #'constructor-and-arity constructors))))

    (flet ((make-printer (name &optional (nfields 0))
             "Make a printer function for the structs."
             `(lambda (,object ,stream ,depth)
                (declare (ignore ,depth)
                         (ignorable ,object))
                ;; We don't check *PRINT-READABLY* because these can
                ;; be readably printed always, provided the arguments
                ;; can be printed readably.
                ;;
                ;; However, we do respect a convenience option
                ;; *PRINT-ADT-READABLY* in case someone finds the
                ;; printing of the #. to be annoying.
                (when *print-adt-readably*
                  (write-string "#." ,stream))
                ,(when (plusp nfields)
                   `(write-char #\( ,stream))
                (prin1 ',name ,stream)
                ,@(when (plusp nfields)
                    (loop :for i :below nfields
                          :append (list
                                   `(write-char #\Space ,stream)
                                   `(prin1 (,(field name i) ,object)
                                           ,stream))))
                ,(when (plusp nfields)
                   `(write-char #\) ,stream)))))
      ;; Define everything.
      (let ((component-documentation
             ;; Force the adt-name symbol to print with a package
             ;; prefix
             (let ((*package* (find-package :keyword)))
               (format nil "A component of ADT ~S" adt-name))))
        `(eval-when (:compile-toplevel :load-toplevel :execute)
           ;; Define the data type.
           (defstruct (,adt-name (:constructor nil)
                                 (:copier nil)
                                 (:predicate nil)
                                 (:include ,include))
             ,@(unsplice documentation))

           ;; Define each of the field constructors.
           ,@(loop :for ctor :in (unwrap-singletons constructors)
                   :collect
                   (etypecase ctor
                     ;; Nullary constructor
                     (symbol `(progn
                                (eval-when (:compile-toplevel :load-toplevel :execute)
                                  (defstruct
                                      (,ctor
                                       (:include ,adt-name)
                                       (:constructor ,(internal ctor))
                                       (:copier nil)
                                       (:predicate nil)
                                       (:print-function ,(make-printer ctor)))
                                    ,component-documentation))
                                #+sbcl (declaim (sb-ext:freeze-type ,ctor))
                                (defmethod make-load-form ((,object ,ctor) &optional ,env)
                                  (make-load-form-saving-slots ,object
                                                               :slot-names nil
                                                               :environment ,env))
                                (define-constant ,ctor (,(internal ctor))
                                  ,component-documentation)
                                (fmakunbound ',(internal ctor))))

                     ;; N-ary constructors
                     (list (let* ((ctor-name (first ctor))
                                  (field-types (rest ctor))
                                  (field-names (gen-names (length field-types))))
                             `(progn
                                (defstruct (,ctor-name
                                            (:include ,adt-name)
                                            (:constructor ,ctor-name (,@field-names))
                                            (:conc-name ,ctor-name)
                                            (:copier nil)
                                            (:predicate nil)
                                            (:print-function
                                             ,(make-printer ctor-name
                                                            (length field-names))))
                                  ,component-documentation
                                  ,@(mapcar (lambda (name type)
                                              `(,name (error "Unspecified field.")
                                                      :type ,type
                                                      ,@(if mutable?
                                                            nil
                                                            '(:read-only t))))
                                     field-names
                                     field-types))
                                #+sbcl (declaim (sb-ext:freeze-type ,ctor-name))
                                (defmethod make-load-form ((,object ,ctor-name) &optional ,env)
                                  (make-load-form-saving-slots ,object
                                                               :slot-names ',field-names
                                                               :environment ,env)))))))
           ;; Return the type name
           ',adt-name)))))

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (defstruct (point (:constructor nil) (:copier nil) (:predicate nil) (:include algebraic-data-type))) (progn (defstruct (rect (:include point) (:constructor rect (%0 %1)) (:conc-name rect) (:copier nil) (:predicate nil) (:print-function (lambda (#:object-141 #:stream-142 #:depth-143) (declare (ignore #:depth-143) (ignorable #:object-141)) (when *print-adt-readably* (write-string "#." #:stream-142)) (write-char #\LEFT_PARENTHESIS #:stream-142) (prin1 (quote rect) #:stream-142) (write-char #\Space #:stream-142) (prin1 (rect%0 #:object-141) #:stream-142) (write-char #\Space #:stream-142) (prin1 (rect%1 #:object-141) #:stream-142) (write-char #\RIGHT_PARENTHESIS #:stream-142)))) #A((48) base-char . "A component of ADT CL-ALGEBRAIC-DATA-TYPE::POINT") (%0 (error "Unspecified field.") :type float) (%1 (error "Unspecified field.") :type float)) (declaim (sb-ext:freeze-type rect)) (defmethod make-load-form ((#:object-141 rect) &optional #:environment-144) (make-load-form-saving-slots #:object-141 :slot-names (quote (%0 %1)) :environment #:environment-144))) (quote point))


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

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

(defvar* nil nil)

[Assistant]
(defmacro DEFVAR* ...)

;; macroexpand:
(defvar/param defvar nil nil nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-simple-definition-resolver special-operator special-operator-p)

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

(define-simple-definition-resolver special-operator special-operator-p)

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

;; macroexpand:
(define-definition-resolver special-operator (special-operator #:package131) (when (ignore-errors (special-operator-p special-operator)) (list (make-instance (quote special-operator) :designator special-operator :package #:package131))))


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

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

(newq nil nil)

[Assistant]
(defmacro NEWQ ...)

;; macroexpand:
(new 'nil nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(when shared `(make-node ,shared))

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

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

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

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


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

Problem: Macro call that should be transformed by CASE

(case nil (progn))

[Assistant]
(defmacro CASE ...)

;; macroexpand:
(let ((#:nil nil))
  (declare (ignorable #:nil))
  (cond ((eql #:nil 'progn) nil)))


[User]
Define a macro that eliminates this repetitive pattern:
(with-html-string (:link :rel :stylesheet))

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

(with-html-string (:link :rel :stylesheet))

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

;; macroexpand:
(with-output-to-string (*html*) (with-html (:link :rel :stylesheet)))


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

Issue: Macro call that should be transformed by ->

(-> :p (a) (+ a 1))

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

;; macroexpand:
(atomically :p (a) (+ a 1))


[User]
Define a macro that eliminates this repetitive pattern:
(with-yield (loop for line = (read-line stream nil 'eof) until (eq line 'eof) do (yield line)))

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

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

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(of-type symbol 'foo)

Issue: Macro call that should be transformed by of-type

(of-type symbol 'foo)

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

;; macroexpand:
(eval-in-context *context* (make-instance (quote comparison-result) :expression (quote (of-type symbol (quote foo))) :value-form (quote (quote foo)) :body (lambda nil (quote foo)) :expected (quote symbol) :comparison (quote typep)))


[User]
Define a macro that eliminates this repetitive pattern:
(ematch0 more (nil nil) ((list* gen sub more) (let ((newsub (correct-pattern sub))) (list* gen newsub (let ((*lexvars* (append (variables newsub) *lexvars*))) (%correct-more-patterns more))))))

Issue: Macro call that should be transformed by ematch0

(ematch0 more (nil nil) ((list* gen sub more) (let ((newsub (correct-pattern sub))) (list* gen newsub (let ((*lexvars* (append (variables newsub) *lexvars*))) (%correct-more-patterns more))))))

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

;; macroexpand:
(match0 more (nil nil) ((list* gen sub more) (let ((newsub (correct-pattern sub))) (list* gen newsub (let ((*lexvars* (append (variables newsub) *lexvars*))) (%correct-more-patterns more))))) (_ (error "level0 match error!")))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-form-fields (name) form (print (field-value name)))

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

(with-form-fields (name) form (print (field-value name)))

[Assistant]
(defmacro with-form (form &body body)
  "Bind *FORM* to FORM and evaluate BODY in that context."
  `(call-with-form ,form (lambda () ,@body)))

;; macroexpand:
(let ((name (get-field form (quote name)))) (print (field-value name)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-error no-version-in-context () (env) "No supported version found in context:~%~a" (v-context env))

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

(define-error no-version-in-context () (env) "No supported version found in context:~%~a" (v-context env))

[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-version-in-context (:error-type varjo-error :prefix "Varjo") (env) "No supported version found in context:~%~a" (v-context env))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-wcs-math-error-handling ((quot rem) (ftruncate x y)) (check-wcs-math-result) rem)

What needs to change: Macro call that should be transformed by with-wcs-math-error-handling

(with-wcs-math-error-handling ((quot rem) (ftruncate x y)) (check-wcs-math-result) rem)

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

;; macroexpand:
(let* ((#:g254 x) (#:g255 y) (#:g256 (list #:g254 #:g255))) (declare (ignorable #:g255) (type list #:g256) (dynamic-extent #:g256)) (catch (quote return-from-with-wcs-math-error-handling) (multiple-value-bind (quot rem) (call-with-wcs-math-error-handler (quote ftruncate) #:g256) (flet ((check-wcs-math-result (&optional (ret quot) (arg-list #:g256)) (check-wcs-math-result ret arg-list))) (check-wcs-math-result) rem))))


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

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

(keep-bops nil :key nil)

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

;; macroexpand:
(eval-when (:load-toplevel :compile-toplevel :execute)
  (progn
   (init-binfix)
   (unless nil
     (setq *binfix*
             (delete nil
                     (mapcar
                      (lambda (bs)
                        (setq bs
                                (delete-if
                                 (lambda (b)
                                   (unless (member (car b) '(nil :key nil))
                                     (remprop (car b) 'properties)
                                     t))
                                 bs)))
                      *binfix*)))
     (assign-properties))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
($ "value-1" 610)

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

($ "value-1" 610)

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

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


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

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

(cond-<>)

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

;; macroexpand:
nil


[User]
Generate a defmacro form that transforms code like this:
($> "l" -900)

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

($> "l" -900)

[Assistant]
(defmacro $> (&rest args)
  `($op "$gt" ,@args))

;; macroexpand:
($op "$gt" "l" -900)


[User]
Write a Common Lisp macro to handle this code pattern:
(without-dependency-capture)

Problem: Macro call that should be transformed by WITHOUT-DEPENDENCY-CAPTURE

(without-dependency-capture)

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

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


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

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

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

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

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


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

Write a macro that addresses: Macro call that should be transformed by ENABLE-READTIME-WRAPPER-SYNTAX

(enable-readtime-wrapper-syntax)

[Assistant]
(defmacro ENABLE-READTIME-WRAPPER-SYNTAX ...)

;; macroexpand:
(eval-when (:compile-toplevel :execute)
  (setf *readtable* (copy-readtable *readtable*))
  (set-readtime-wrapper-syntax-in-readtable #\LEFT_CURLY_BRACKET
                                            #\RIGHT_CURLY_BRACKET)
  (values))


[User]
Define a macro that eliminates this repetitive pattern:
(defhandler sb-int:named-lambda (named-lambda name lambda-list &rest body) `(list* ',named-lambda ,(apply 'dump-fbinding name lambda-list body)))

Issue: Macro call that should be transformed by defhandler

(defhandler sb-int:named-lambda (named-lambda name lambda-list &rest body) `(list* ',named-lambda ,(apply 'dump-fbinding name lambda-list body)))

[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-named-lambda (named-lambda name lambda-list &rest body) (sb-int:quasiquote (list* (quote #S(sb-impl::comma :expr named-lambda :kind 0)) #S(sb-impl::comma :expr (apply (quote dump-fbinding) name lambda-list body) :kind 0)))) (setf (gethash (quote sb-int:named-lambda) *form-handler*) (quote hander-named-lambda)))


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

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

(is-true nil)

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

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

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

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

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(member (first tree) stop-on :test #'eq)

Issue: Macro call that should be transformed by m

(member (first tree) stop-on :test #'eq)

[Assistant]
(defmacro m (form &environment *env*)
  (e form))

;; macroexpand:
(member (first tree) stop-on :test (function eq))


[User]
Define a macro that eliminates this repetitive pattern:
(deferror "08006" connection-failure)

Issue: Macro call that should be transformed by deferror

(deferror "08006" connection-failure)

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

;; macroexpand:
(progn (define-condition connection-failure (database-error) nil) (setf (gethash "08006" *error-table*) (quote connection-failure)))


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

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

(defsynonym nil (progn))

[Assistant]
(defmacro DEFSYNONYM ...)

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf (get 'nil 'iterate::synonym) '(progn)))


[User]
Write a Common Lisp macro to handle this code pattern:
(assert-values ("assert fresh initialization") (foo 'nothing) (foo+1 'nothing) (bar 'nothing) (bar-1 'nothing))

Problem: Macro call that should be transformed by assert-values

(assert-values ("assert fresh initialization") (foo 'nothing) (foo+1 'nothing) (bar 'nothing) (bar-1 'nothing))

[Assistant]
(defmacro assert-values ((desc) &body objects-and-values)
  `(progn
     (trc ,desc)
     ,@(loop for (obj val) in objects-and-values
	    collect `(assert (eql (value ,obj) ,val)))))

;; macroexpand:
(progn (trc "assert fresh initialization") (assert (eql (value foo) (quote nothing))) (assert (eql (value foo+1) (quote nothing))) (assert (eql (value bar) (quote nothing))) (assert (eql (value bar-1) (quote nothing))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(iterate:display-iterate-clauses)

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

(iterate:display-iterate-clauses)

[Assistant]
(defmacro iter (&body body &environment env)
  "Jonathan Amsterdam's powerful and extensible iteration facility,
providing multiple accumulation, generators, memory of previous
iterations, over 50 clauses to start with and a Lisp-like syntax.
Evaluate (iterate:display-iterate-clauses) for an overview of clauses"
  (let* ((*env* env)
	 (*result-var* (genvar 'result))
	 (*type-alist* nil)
	 (*declare-variables* *always-declare-variables*)
	 (*bindings* nil)
	 (*internal-variables* nil)
	 (*previous-vars-alist* nil)
	 (*declarations* nil)
	 (*loop-body-wrappers* nil)
	 (*accum-var-alist* nil)
	 (*shared-bindings-alist* nil)
	 (*top-level?* t)
	 (*binding-context?* nil)
	 (*temps* nil)
	 (*temps-in-use* nil)
	 (*driver-info-alist* nil)
	 (*loop-name* (if (symbolp (car body))
			  (car body)
			  (gensym "ITERATE")))
	 (*block-name* (if (symbolp (car body))
			   (pop body)
			   nil))
	 (*loop-top* (symbol-append 'loop-top- *block-name*))
	 (*loop-step* (symbol-append 'loop-step- *block-name*))
	 (*loop-end* (symbol-append 'loop-end- *block-name*))
	 (*loop-step-used?* nil)
	 (*loop-end-used?* nil))
    (process-top-level-decls body)
    (multiple-value-bind (body decls init-code steppers final-code final-prot)
	(walk-list body)
      (multiple-value-bind (init step)
	  (insert-previous-code)
	(augment init-code init)
	(augment steppers step))
      (prepend (default-driver-code) body)
      (let* ((it-bod `(block ,*loop-name*
			(tagbody
			  (progn ,.init-code)
			  ,*loop-top*
			  (progn ,.body)
			  ,.(if *loop-step-used?* (list *loop-step*))
			  (progn ,.steppers)
			  (go ,*loop-top*)
			  ,.(if *loop-end-used?* (list *loop-end*))
			  (progn ,.final-code))
			,(if (member *result-var* *bindings* :key #'car)
			   *result-var*
			   nil)))
	     (it-bod (if (eql *block-name* nil)
			 `(block nil ,it-bod)
			 it-bod)))
	(wrap-form *loop-body-wrappers*
		   `(let* ,(nreverse *bindings*)
		     ,.(if *declarations*
			   `((declare .,*declarations*)))
		     ,.decls
		     ,(if final-prot
			  `(unwind-protect ,it-bod .,final-prot)
			  it-bod)))))))

;; macroexpand:
(display-iterate-clauses)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-class some-class (some super classes) ((slot1 :unbound)) (:accessor-name-package (find-package :nclasses/test.dummy)))

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

(define-class some-class (some super classes) ((slot1 :unbound)) (:accessor-name-package (find-package :nclasses/test.dummy)))

[Assistant]
(defmacro define-class (name supers slots &rest options)
  "Convenience wrapper of `defclass'.

It automates a lot of boilerplate (like exporting all the accessors of a class)
plus adds some new features.

Slot options:

- The initform can be specified as the second value.

- `:accessor', `:reader' and `:writer' can be set to either a name, NIL or T.
  If NIL, the method is not generated.
  If T, the method is generated using the `:accessor-name-transformer' class option value.

- The `:export' option allows to control the slot-name export on a per-slot basis.

New class options (defaults are NIL unless specified):

- `:slot-definition-transformer' (default: `default-slot-definition-transformer').
  A function that takes a SLOT-DEFINITION and returns a new one.

- `:accessor-name-package': The package of the generated accessors.  See
  `:accessor-name-transformer'.  Some special values are accepted:
  - `:slot-name': The package of the slot-name.
  - `:default': The current package.

- `:accessor-name-transformer' (default `default-accessor-name-transformer').

  A function of (SLOT-NAME SLOT-DEFINITION) arguments that returns the accessor
  name (a symbol).  Other transformer: `dwim-accessor-name-transformer'.

- `:automatic-accessors-p': Whether to generate accessor names automatically for
  all slots.

  As a special case, the accessor is not generated if all following conditions are met:
  - `:accessor-name-package' is `:slot-name',
  - slot name package is different from current package,
  - if the `:accessor' slot option is not provided,

- `:initarg-name-transformer' (default: `default-initarg-name-transformer'.)

  A function of (SLOT-NAME SLOT-DEFINITION) arguments that returns the accessor
  name (a symbol.

- `:automatic-initargs-p' (default: T): Whether to generate accessor names
  automatically for all slots.

- `:predicate-name-transformer' (default: `default-predicate-name-transformer').

  A function of (SLOT-NAME SLOT-DEFINITION) arguments that returns the predicate
  name (a symbol).

- `:automatic-predicates-p' (default: T): Whether to generate a predicate
  for the class.

- `:type-inference' (default: `default-type-inference').

  Function that returns the type of a slot definition (with an initform).  It
  takes 3 arguments:

  - The initform.
  - The slot name.
  - The rest of the slot definition.

- `:automatic-types-p': Whether to generate the type automatically for all
  slots.  The type can still be specified manually with the `:type' slot option.

- Self-explanatory export options (all NIL by default):
  - `:export-class-name-p'
  - `:export-accessor-names-p'
  - `:export-slot-names-p'
  - `:export-predicate-name'"
  (build-defclass-like-expansion
   name supers slots options
   (lambda (processed-slots clean-options)
     `(defclass ,name ,supers
        ,processed-slots
        ,@clean-options))))

;; macroexpand:
(progn (defclass some-class (some super classes) ((slot1 :accessor slot1 :initarg :slot1))) (unless (fboundp (quote some-class-p)) (define-generic some-class-p (object) #A((75) base-char . "Auto-generated predicate for whether OBJECT is an instance of `some-class'.") (declare (sb-ext:muffle-conditions style-warning)) (typep object (quote some-class)))) (setf (documentation (quote slot1) (quote function)) #A((48) base-char . "Auto-generated accessor function for slot SLOT1.")) (ignore-errors (setf (documentation (fdefinition (quote slot1)) (quote function)) #A((48) base-char . "Auto-generated accessor function for slot SLOT1."))) (ignore-errors (setf (documentation (fdefinition (quote (setf slot1))) (quote function)) #A((48) base-char . "Auto-generated accessor function for slot SLOT1."))) (find-class (quote some-class) nil))


[User]
Generate a defmacro form that transforms code like this:
(define-modf-function aref 1 (new-val array &rest idx) (let ((new-arr (alexandria:copy-array array))) (setf (apply #'aref new-arr idx) new-val) new-arr))

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

(define-modf-function aref 1 (new-val array &rest idx) (let ((new-arr (alexandria:copy-array array))) (setf (apply #'aref new-arr idx) new-val) new-arr))

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

;; macroexpand:
(progn (eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash (quote aref) *modf-nth-arg*) 1)) (defun |BUILDER:COMMON-LISP:AREF| (new-val array &rest idx) (let ((new-arr (alexandria:copy-array array))) (setf (apply (function aref) new-arr idx) new-val) new-arr)))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-packages-unlocked nil
  :key
  nil)

Problem: Macro call that should be transformed by WITH-PACKAGES-UNLOCKED

(with-packages-unlocked nil
  :key
  nil)

[Assistant]
(defmacro WITH-PACKAGES-UNLOCKED ...)

;; macroexpand:
(let ((#:|packages123| (locked-packages 'nil)))
  (unlock-packages #:|packages123|)
  (unwind-protect :key nil (lock-packages #:|packages123|)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(defclause across (vector &rest args &key index start end by) "Synonym for in-vector." (declare (ignore index start end by)) `(in-vector ,vector ,@args))

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

(defclause across (vector &rest args &key index start end by) "Synonym for in-vector." (declare (ignore index start end by)) `(in-vector ,vector ,@args))

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

;; macroexpand:
(progn (defmacro across (vector &rest args &key index start end by) "Synonym for in-vector." (declare (ignore index start end by)) (sb-int:quasiquote (in-vector #S(sb-impl::comma :expr vector :kind 0) #S(sb-impl::comma :expr args :kind 2)))) (pushnew (quote across) *clauses*))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-value-binding ranging ((var (if ascending (- from by) (+ from by))) from to &key (by 1) &aux (ascending (< from to))) (declare (type real var from to by) (type boolean ascending)) (declare (ignore from)) `(cond (,ascending (incf ,var ,by) (when (< ,to ,var) (end-for))) (T (decf ,var ,by) (when (< ,var ,to) (end-for)))))

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

(define-value-binding ranging ((var (if ascending (- from by) (+ from by))) from to &key (by 1) &aux (ascending (< from to))) (declare (type real var from to by) (type boolean ascending)) (declare (ignore from)) `(cond (,ascending (incf ,var ,by) (when (< ,to ,var) (end-for))) (T (decf ,var ,by) (when (< ,var ,to) (end-for)))))

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

;; macroexpand:
(define-direct-binding ranging (var from to &key (by 1)) (let ((#:ascending171 (gensym #A((9) base-char . "ASCENDING"))) (#:from168 (gensym #A((4) base-char . "FROM"))) (#:to169 (gensym #A((2) base-char . "TO"))) (#:by170 (gensym #A((2) base-char . "BY")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:from168 from) (list #:to169 to) (list #:by170 by) (list #:ascending171 (list (quote <) #:from168 #:to169)) (loop for #:var167 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var167 (list (quote if) #:ascending171 (list (quote -) #:from168 #:by170) (list (quote +) #:from168 #:by170))))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:ascending171 :kind 0) #S(sb-impl::comma :expr #:from168 :kind 0) #S(sb-impl::comma :expr #:to169 :kind 0) #S(sb-impl::comma :expr #:by170 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote real) :kind 0) #S(sb-impl::comma :expr var :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote real) :kind 0) #S(sb-impl::comma :expr #:from168 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote real) :kind 0) #S(sb-impl::comma :expr #:to169 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote real) :kind 0) #S(sb-impl::comma :expr #:by170 :kind 0)))) :kind 0) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote boolean) :kind 0) #S(sb-impl::comma :expr #:ascending171 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((ascending #:ascending171) (from #:from168) (to #:to169) (by #:by170)) (declare (ignorable ascending from to by)) (declare (ignore from)) (sb-int:quasiquote (cond (#S(sb-impl::comma :expr ascending :kind 0) (incf #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr by :kind 0)) (when (< #S(sb-impl::comma :expr to :kind 0) #S(sb-impl::comma :expr var :kind 0)) (end-for))) (t (decf #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr by :kind 0)) (when (< #S(sb-impl::comma :expr var :kind 0) #S(sb-impl::comma :expr to :kind 0)) (end-for)))))))))


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

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

(as->* 'some-name)

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

;; macroexpand:
(as-> 'some-name)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-html-string (:li (:div :class "status col-xs-2 col-md-1" (:span :class "text-success" (:a :href "https://en.wikipedia.org/wiki/List_of_HTTP_status_codes#200" 200)))))

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

(with-html-string (:li (:div :class "status col-xs-2 col-md-1" (:span :class "text-success" (:a :href "https://en.wikipedia.org/wiki/List_of_HTTP_status_codes#200" 200)))))

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

;; macroexpand:
(with-output-to-string (*html*) (with-html (:li (:div :class "status col-xs-2 col-md-1" (:span :class "text-success" (:a :href "https://en.wikipedia.org/wiki/List_of_HTTP_status_codes#200" 200))))))


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

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

(iterate
  'some-name)

[Assistant]
(defmacro ITERATE ...)

;; macroexpand:
(iter
  'some-name)


[User]
Generate a defmacro form that transforms code like this:
(define-error if-form-type-mismatch () (test-form then-form then-type else-form else-type) "The result if ~a is true is ~a which has type ~a however the false case returns ~a which has type ~a This is incompatible" test-form then-form then-type else-form else-type)

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

(define-error if-form-type-mismatch () (test-form then-form then-type else-form else-type) "The result if ~a is true is ~a which has type ~a however the false case returns ~a which has type ~a This is incompatible" test-form then-form then-type else-form else-type)

[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 if-form-type-mismatch (:error-type varjo-error :prefix "Varjo") (test-form then-form then-type else-form else-type) "The result if ~a is true is ~a which has type ~a however the false case returns ~a which has type ~a This is incompatible" test-form then-form then-type else-form else-type)