[User]
Write a Common Lisp macro to handle this code pattern:
(let-gensyms (decoder validator value-handler key-handler pass) (let ((vars-tmp (loop repeat (length vars) collect (gensym)))) `(let (,@vars-tmp (,pass (constantly t))) (let ((,validator (custom-decoder :beginning-of-object ,pass :object-key ,pass :object-value ,pass :end-of-object ,pass :beginning-of-array ,pass :array-member ,pass :end-of-array ,pass :beginning-of-string ,pass :string-char ,pass :end-of-string ,pass :internal-decoder 'decode-json)) (,decoder (current-decoder)) (,key-handler *object-key-handler*) (,value-handler *object-value-handler*)) (declare (ignorable ,decoder ,key-handler ,value-handler)) ,(if (null vars) `(decode-json-from-source ,json-source ,validator) `(bind-custom-vars (,@(json-bind-level-customizations (loop for var in vars for var-tmp in vars-tmp collect (cons var-tmp (symbol-name var))) nil decoder validator key-handler value-handler pass) :aggregate-scope (union *aggregate-scope-variables* '(*object-key-handler* *object-value-handler* *internal-decoder*))) (decode-json-from-source ,json-source)))) (let ,(mapcar #'list vars vars-tmp) ,@body))))

Problem: Macro call that should be transformed by let-gensyms

(let-gensyms (decoder validator value-handler key-handler pass) (let ((vars-tmp (loop repeat (length vars) collect (gensym)))) `(let (,@vars-tmp (,pass (constantly t))) (let ((,validator (custom-decoder :beginning-of-object ,pass :object-key ,pass :object-value ,pass :end-of-object ,pass :beginning-of-array ,pass :array-member ,pass :end-of-array ,pass :beginning-of-string ,pass :string-char ,pass :end-of-string ,pass :internal-decoder 'decode-json)) (,decoder (current-decoder)) (,key-handler *object-key-handler*) (,value-handler *object-value-handler*)) (declare (ignorable ,decoder ,key-handler ,value-handler)) ,(if (null vars) `(decode-json-from-source ,json-source ,validator) `(bind-custom-vars (,@(json-bind-level-customizations (loop for var in vars for var-tmp in vars-tmp collect (cons var-tmp (symbol-name var))) nil decoder validator key-handler value-handler pass) :aggregate-scope (union *aggregate-scope-variables* '(*object-key-handler* *object-value-handler* *internal-decoder*))) (decode-json-from-source ,json-source)))) (let ,(mapcar #'list vars vars-tmp) ,@body))))

[Assistant]
(defmacro let-gensyms ((&rest names) &body body)
  `(let ,(loop for name in names collect `(,name (gensym)))
     ,@body))

;; macroexpand:
(let ((decoder (gensym)) (validator (gensym)) (value-handler (gensym)) (key-handler (gensym)) (pass (gensym))) (let ((vars-tmp (loop repeat (length vars) collect (gensym)))) (sb-int:quasiquote (let (#S(sb-impl::comma :expr vars-tmp :kind 2) (#S(sb-impl::comma :expr pass :kind 0) (constantly t))) (let ((#S(sb-impl::comma :expr validator :kind 0) (custom-decoder :beginning-of-object #S(sb-impl::comma :expr pass :kind 0) :object-key #S(sb-impl::comma :expr pass :kind 0) :object-value #S(sb-impl::comma :expr pass :kind 0) :end-of-object #S(sb-impl::comma :expr pass :kind 0) :beginning-of-array #S(sb-impl::comma :expr pass :kind 0) :array-member #S(sb-impl::comma :expr pass :kind 0) :end-of-array #S(sb-impl::comma :expr pass :kind 0) :beginning-of-string #S(sb-impl::comma :expr pass :kind 0) :string-char #S(sb-impl::comma :expr pass :kind 0) :end-of-string #S(sb-impl::comma :expr pass :kind 0) :internal-decoder (quote decode-json))) (#S(sb-impl::comma :expr decoder :kind 0) (current-decoder)) (#S(sb-impl::comma :expr key-handler :kind 0) *object-key-handler*) (#S(sb-impl::comma :expr value-handler :kind 0) *object-value-handler*)) (declare (ignorable #S(sb-impl::comma :expr decoder :kind 0) #S(sb-impl::comma :expr key-handler :kind 0) #S(sb-impl::comma :expr value-handler :kind 0))) #S(sb-impl::comma :expr (if (null vars) (sb-int:quasiquote (decode-json-from-source #S(sb-impl::comma :expr json-source :kind 0) #S(sb-impl::comma :expr validator :kind 0))) (sb-int:quasiquote (bind-custom-vars (#S(sb-impl::comma :expr (json-bind-level-customizations (loop for var in vars for var-tmp in vars-tmp collect (cons var-tmp (symbol-name var))) nil decoder validator key-handler value-handler pass) :kind 2) :aggregate-scope (union *aggregate-scope-variables* (quote (*object-key-handler* *object-value-handler* *internal-decoder*)))) (decode-json-from-source #S(sb-impl::comma :expr json-source :kind 0))))) :kind 0)) (let #S(sb-impl::comma :expr (mapcar (function list) vars vars-tmp) :kind 0) #S(sb-impl::comma :expr body :kind 2))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(dflet ((foo/inline () 42)) (is (eql 42 (foo/inline))))

Problem: Macro call that should be transformed by dflet

(dflet ((foo/inline () 42)) (is (eql 42 (foo/inline))))

[Assistant]
(defmacro dflet ((&rest definitions) &body body)
  "Like FLET, but dynamically sets the FDEFINITIONS during the duration of
the BODY."
  `(progf
       ',(mapcar #'car definitions)
       (list
        ,.(mapcar (lambda (definition)
                    `(lambda ,(cadr definition)
                       ,@(cddr definition)))
                  definitions))
     ,@body))

;; macroexpand:
(progf (quote (foo/inline)) (list (lambda nil 42)) (is (eql 42 (foo/inline))))


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

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

(with-attributes nil
    nil)

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

;; macroexpand:
(let ((#:unit160 nil))
  (symbol-macrolet ()))


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

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

(caching-types
  'some-name)

[Assistant]
(defmacro CACHING-TYPES ...)

;; macroexpand:
(call-with-disjoint-hash
 (lambda ()
   (call-with-subtype-hash
    (lambda ()
      (call-with-equiv-hash
       (lambda () (call-with-subtypep-cache (lambda () 'some-name))))))))


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

Issue: Macro call that should be transformed by CACHING-TYPES

(caching-types
  nil
  nil)

[Assistant]
(defmacro CACHING-TYPES ...)

;; macroexpand:
(call-with-disjoint-hash
 (lambda ()
   (call-with-subtype-hash
    (lambda ()
      (call-with-equiv-hash
       (lambda () (call-with-subtypep-cache (lambda () nil nil))))))))


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

Write a macro that addresses: Macro call that should be transformed by SPECIAL-SYMBOL-PROGV

(special-symbol-progv nil
    :key
  nil)

[Assistant]
(defmacro SPECIAL-SYMBOL-PROGV ...)

;; macroexpand:
(let (#:symbol-list180)
  (tagbody
   #:retry181
    (setq #:symbol-list180 nil)
    (unless (every #'special-symbol-p #:symbol-list180)
      (cerror "Retry to rebind the place(s)."
              "Attempt at rebinding one or more non-special places: ~S" 'nil)
      (go #:retry181)))
  (dynamic-progv #:symbol-list180
      :key
    nil))


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

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

(defsynonym initially :initially)

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(is (= 0 state))

Problem: Macro call that should be transformed by is

(is (= 0 state))

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

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

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

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

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

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


[User]
Generate a defmacro form that transforms code like this:
(define-element-maker :marker "marker" '(:id))

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

(define-element-maker :marker "marker" '(:id))

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

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


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

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

(defmethod* nil)

[Assistant]
(defmacro DEFMETHOD* ...)

;; macroexpand:
(let* ((#:nil123 (ensure-generic*-function 'nil))
       (temp-method (defmethod #:nil122))
       (actual-gf
        (ensure-generic*-function 'nil :lambda-list
                                  (sb-mop:generic-function-lambda-list
                                   (symbol-function '#:nil122))
                                  :special-variables 'nil))
       (actual-method
        (add-method* #:nil123
                     (make-instance 'method* :special-variables (list)
                                    :qualifiers 'nil :specializers
                                    (sb-mop:method-specializers temp-method)
                                    :lambda-list
                                    (sb-mop:method-lambda-list temp-method)
                                    :documentation
                                    (documentation temp-method t) :function
                                    (sb-mop:method-function temp-method)))))
  (declare (ignorable #:nil123)
           (ignore actual-gf))
  (setf (documentation actual-method t) (documentation temp-method t))
  actual-method)


[User]
Define a macro that eliminates this repetitive pattern:
(with-prepared-query query (conn sql) (and (dbi:fetch-all (execute-with-retry query binds) :format :plist) t))

Issue: Macro call that should be transformed by with-prepared-query

(with-prepared-query query (conn sql) (and (dbi:fetch-all (execute-with-retry query binds) :format :plist) t))

[Assistant]
(defmacro with-prepared-query (query (conn sql &key use-prepare-cached) &body body)
  `(call-with-prepared-query ,conn ,sql (lambda (,query) ,@body) :use-prepare-cached ,use-prepare-cached))

;; macroexpand:
(call-with-prepared-query conn sql (lambda (query) (and (dbi.driver:fetch-all (execute-with-retry query binds) :format :plist) t)) :use-prepare-cached nil)


[User]
Generate a defmacro form that transforms code like this:
;; Manual gensym binding is verbose
(let ((g1 (gensym))
      (g2 (gensym))
      (g3 (gensym)))
  `(let ((,g1 ,x)
         (,g2 ,y))
     (f ,g1 ,g2 ,g3)))
;; The let-bindings for gensyms obscure the macro logic

Pattern to recognize: Manual gensym creation with let-bindings is verbose — want concise declaration of gensym-intended symbols

;; Manual gensym binding is verbose
(let ((g1 (gensym))
      (g2 (gensym))
      (g3 (gensym)))
  `(let ((,g1 ,x)
         (,g2 ,y))
     (f ,g1 ,g2 ,g3)))
;; The let-bindings for gensyms obscure the macro logic

[Assistant]
(defmacro with-gensyms (syms &body body)
  `(let ,(mapcar #'(lambda (s)
                     `(,s (gensym)))
                 syms)
     ,@body))

;; macroexpand:
;; (with-gensyms (g1 g2 g3)
;;   `(let ((,g1 ,x)
;;          (,g2 ,y))
;;      (f ,g1 ,g2 ,g3)))
;; Expands to:
;; (LET ((G1 (GENSYM)) (G2 (GENSYM)) (G3 (GENSYM)))
;;   `(LET ((,G1 ,X) (,G2 ,Y)) (F ,G1 ,G2 ,G3)))
;;
;; Much cleaner than manual gensym let-bindings


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-html-string (:div.some-class (:pre "verbatim line one verbatim line two") (:p "Some following stuff")))

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

(with-html-string (:div.some-class (:pre "verbatim line one verbatim line two") (:p "Some following stuff")))

[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 (:div.some-class (:pre "verbatim line one verbatim line two") (:p "Some following stuff"))))


[User]
Define a macro that eliminates this repetitive pattern:
(define-custom-var (:end-of-string *end-of-string-handler*) (constantly "") "Designator for a function of no arguments (called at encountering a closing quote for a String).")

Issue: Macro call that should be transformed by define-custom-var

(define-custom-var (:end-of-string *end-of-string-handler*) (constantly "") "Designator for a function of no arguments (called at encountering a closing quote for a String).")

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

;; macroexpand:
(eval-when (:compile-toplevel :load-toplevel :execute) (progn (pushnew (quote (*end-of-string-handler* . :end-of-string)) *custom-vars* :test (function equal)) (defvar *end-of-string-handler* (constantly "") "Designator for a function of no arguments (called at encountering a closing quote for a String).")))


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

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

(ok nil)

[Assistant]
(defmacro ok (test &optional desc)
  (with-gensyms (duration result)
    (once-only (test desc)
      `(with-catching-errors (:expected T :description ,desc)
         (with-duration ((,duration ,result) ,test)
           (test ,result t ,desc
                 :duration ,duration
                 :test-fn (lambda (x y)
                            (eq (not (null x)) y))
                 :got-form ,test))))))

;; macroexpand:
(let ((#:test146 nil) (#:desc147 nil)) (with-catching-errors (:expected t :description #:desc147) (with-duration ((#:duration144 #:result145) #:test146) (test #:result145 t #:desc147 :duration #:duration144 :test-fn (lambda (x y) (eq (not (null x)) y)) :got-form #:test146))))


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

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

(dict-of 'some-name)

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

;; macroexpand:
(let ((#:dict134 (make-hash-table :test 'equal)))
  (do-for nil
    (multiple-value-call
        (lambda (#:k135 #:v136) (setf (gethash #:k135 #:dict134) #:v136))
      'some-name))
  #:dict134)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(action (:traverse node-let node new-subs) (loop :for (name . expr) :in (node-let-bindings node) :do (when (find name subs :key #'ast-substitution-from) (util:coalton-bug "Failure to apply ast substitution on variable ~A to node-let" name)) :do (when rename-bound-variables (push (make-ast-substitution :from name :to (make-node-variable :type (node-type expr) :value (gensym (symbol-name name)))) new-subs))) (make-node-let :type (node-type node) :bindings (loop :for (name . node) :in (node-let-bindings node) :collect (cons (if rename-bound-variables (node-variable-value (ast-substitution-to (find name new-subs :key #'ast-substitution-from))) name) (funcall *traverse* node new-subs))) :subexpr (funcall *traverse* (node-let-subexpr node) new-subs)))

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

(action (:traverse node-let node new-subs) (loop :for (name . expr) :in (node-let-bindings node) :do (when (find name subs :key #'ast-substitution-from) (util:coalton-bug "Failure to apply ast substitution on variable ~A to node-let" name)) :do (when rename-bound-variables (push (make-ast-substitution :from name :to (make-node-variable :type (node-type expr) :value (gensym (symbol-name name)))) new-subs))) (make-node-let :type (node-type node) :bindings (loop :for (name . node) :in (node-let-bindings node) :collect (cons (if rename-bound-variables (node-variable-value (ast-substitution-to (find name new-subs :key #'ast-substitution-from))) name) (funcall *traverse* node new-subs))) :subexpr (funcall *traverse* (node-let-subexpr node) new-subs)))

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

;; macroexpand:
(make-action (quote :traverse) (quote node-let) (lambda (node new-subs) (declare (type node-let node)) (loop :for (name . expr) :in (node-let-bindings node) :do (when (find name subs :key (function ast-substitution-from)) (util:coalton-bug "Failure to apply ast substitution on variable ~A to node-let" name)) :do (when rename-bound-variables (push (make-ast-substitution :from name :to (make-node-variable :type (node-type expr) :value (gensym (symbol-name name)))) new-subs))) (make-node-let :type (node-type node) :bindings (loop :for (name . node) :in (node-let-bindings node) :collect (cons (if rename-bound-variables (node-variable-value (ast-substitution-to (find name new-subs :key (function ast-substitution-from)))) name) (funcall *traverse* node new-subs))) :subexpr (funcall *traverse* (node-let-subexpr node) new-subs))))


[User]
Generate a defmacro form that transforms code like this:
(define-simple-type-map special-operator :special-operator)

Pattern to recognize: Macro call that should be transformed by define-simple-type-map

(define-simple-type-map special-operator :special-operator)

[Assistant]
(defmacro define-simple-type-map (class type)
  `(defmethod type ((,class ,class))
     ',type))

;; macroexpand:
(defmethod type ((special-operator special-operator)) (quote :special-operator))


[User]
Write a Common Lisp macro to handle this code pattern:
(some-<> (diamond-wand init (cddr exp) nil t))

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

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

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

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


[User]
Generate a defmacro form that transforms code like this:
(define-op (:not-null unary-op))

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

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

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

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


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

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

(collect-nth nil nil)

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

;; macroexpand:
(common-lisp:let* ((#:generator-398 (generator nil))
                   #:items-390
                   (#:counter-392 nil)
                   (#:item-393 nil))
  (declare (type generator #:generator-398)
           (type (null-or fixnum) #:counter-392)
           (type (null-or t) #:item-393))
  (tagbody
   #:ll-399
    (setq #:items-390 (next-in #:generator-398 (go end)))
    (when (zerop #:counter-392) (setq #:item-393 #:items-390) (go end))
    (decf #:counter-392)
    (go #:ll-399)
   end)
  #:item-393)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(with-gensyms (parent-type term type string current-mode position position-foobage mode-wait new-position advance) `(let ((,parent-type (or (find-coloring-type ,parent) (and ,parent (error "No such coloring type: ~S" ,parent))))) (setf (find-coloring-type ,name) (make-instance 'coloring-type :fancy-name ',fancy-name :modes (append ',modes (if ,parent-type (coloring-type-modes ,parent-type))) :default-mode (or ',default-mode (if ,parent-type (coloring-type-default-mode ,parent-type))) ,@(if autodetect `(:autodetect-function ,autodetect)) :parent-type ,parent-type :visible (not ,invisible) :formatter-initial-values (lambda nil (list* ,@(mapcar #'(lambda (e) `(cons ',(car e) ,(second e))) formatter-variables) (if ,parent-type (funcall (coloring-type-formatter-initial-values ,parent-type)) nil))) :formatter-after-hook (lambda nil (symbol-macrolet ,(mapcar #'(lambda (e) `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) formatter-variables) (concatenate 'string (funcall ,formatter-after-hook) (if ,parent-type (funcall (coloring-type-formatter-after-hook ,parent-type)) "")))) :term-formatter (symbol-macrolet ,(mapcar #'(lambda (e) `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) formatter-variables) (lambda (,term) (labels ((call-parent-formatter (&optional (,type (car ,term)) (,string (cdr ,term))) (if ,parent-type (funcall (coloring-type-term-formatter ,parent-type) (cons ,type ,string)))) (call-formatter (&optional (,type (car ,term)) (,string (cdr ,term))) (funcall (case (first ,type) ,@formatters (t (lambda (,type text) (call-parent-formatter ,type text)))) ,type ,string))) (call-formatter)))) :transition-functions (list ,@(loop for transition in transitions collect (destructuring-bind (mode &rest table) transition `(cons ',mode (lambda (,current-mode ,string ,position) (let ((,mode-wait (constantly nil)) (,position-foobage ,position)) (with-scanning-functions ,string ,position-foobage ,current-mode ,mode-wait (let ((*reset-position* ,position)) (cond ,@table)) (values ,position-foobage ,current-mode (lambda (,new-position) (setf ,position-foobage ,new-position) (let ((,advance (nth-value 1 (funcall ,mode-wait ,position-foobage)))) (values ,position-foobage ,advance))))) ))))))))))

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

(with-gensyms (parent-type term type string current-mode position position-foobage mode-wait new-position advance) `(let ((,parent-type (or (find-coloring-type ,parent) (and ,parent (error "No such coloring type: ~S" ,parent))))) (setf (find-coloring-type ,name) (make-instance 'coloring-type :fancy-name ',fancy-name :modes (append ',modes (if ,parent-type (coloring-type-modes ,parent-type))) :default-mode (or ',default-mode (if ,parent-type (coloring-type-default-mode ,parent-type))) ,@(if autodetect `(:autodetect-function ,autodetect)) :parent-type ,parent-type :visible (not ,invisible) :formatter-initial-values (lambda nil (list* ,@(mapcar #'(lambda (e) `(cons ',(car e) ,(second e))) formatter-variables) (if ,parent-type (funcall (coloring-type-formatter-initial-values ,parent-type)) nil))) :formatter-after-hook (lambda nil (symbol-macrolet ,(mapcar #'(lambda (e) `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) formatter-variables) (concatenate 'string (funcall ,formatter-after-hook) (if ,parent-type (funcall (coloring-type-formatter-after-hook ,parent-type)) "")))) :term-formatter (symbol-macrolet ,(mapcar #'(lambda (e) `(,(car e) (cdr (assoc ',(car e) *formatter-local-variables*)))) formatter-variables) (lambda (,term) (labels ((call-parent-formatter (&optional (,type (car ,term)) (,string (cdr ,term))) (if ,parent-type (funcall (coloring-type-term-formatter ,parent-type) (cons ,type ,string)))) (call-formatter (&optional (,type (car ,term)) (,string (cdr ,term))) (funcall (case (first ,type) ,@formatters (t (lambda (,type text) (call-parent-formatter ,type text)))) ,type ,string))) (call-formatter)))) :transition-functions (list ,@(loop for transition in transitions collect (destructuring-bind (mode &rest table) transition `(cons ',mode (lambda (,current-mode ,string ,position) (let ((,mode-wait (constantly nil)) (,position-foobage ,position)) (with-scanning-functions ,string ,position-foobage ,current-mode ,mode-wait (let ((*reset-position* ,position)) (cond ,@table)) (values ,position-foobage ,current-mode (lambda (,new-position) (setf ,position-foobage ,new-position) (let ((,advance (nth-value 1 (funcall ,mode-wait ,position-foobage)))) (values ,position-foobage ,advance))))) ))))))))))

[Assistant]
(defmacro with-gensyms ((&rest names) &body body)
  `(let ,(mapcar #'(lambda (name)
                     (list name `(make-symbol ,(symbol-name name)))) names)
    ,@body))

;; macroexpand:
(let ((parent-type (gensym #A((11) base-char . "PARENT-TYPE"))) (term (gensym #A((4) base-char . "TERM"))) (type (gensym #A((4) base-char . "TYPE"))) (string (gensym #A((6) base-char . "STRING"))) (current-mode (gensym #A((12) base-char . "CURRENT-MODE"))) (position (gensym #A((8) base-char . "POSITION"))) (position-foobage (gensym #A((16) base-char . "POSITION-FOOBAGE"))) (mode-wait (gensym #A((9) base-char . "MODE-WAIT"))) (new-position (gensym #A((12) base-char . "NEW-POSITION"))) (advance (gensym #A((7) base-char . "ADVANCE")))) (sb-int:quasiquote (let ((#S(sb-impl::comma :expr parent-type :kind 0) (or (find-coloring-type #S(sb-impl::comma :expr parent :kind 0)) (and #S(sb-impl::comma :expr parent :kind 0) (error "No such coloring type: ~S" #S(sb-impl::comma :expr parent :kind 0)))))) (setf (find-coloring-type #S(sb-impl::comma :expr name :kind 0)) (make-instance (quote coloring-type) :fancy-name (quote #S(sb-impl::comma :expr fancy-name :kind 0)) :modes (append (quote #S(sb-impl::comma :expr modes :kind 0)) (if #S(sb-impl::comma :expr parent-type :kind 0) (coloring-type-modes #S(sb-impl::comma :expr parent-type :kind 0)))) :default-mode (or (quote #S(sb-impl::comma :expr default-mode :kind 0)) (if #S(sb-impl::comma :expr parent-type :kind 0) (coloring-type-default-mode #S(sb-impl::comma :expr parent-type :kind 0)))) #S(sb-impl::comma :expr (if autodetect (sb-int:quasiquote (:autodetect-function #S(sb-impl::comma :expr autodetect :kind 0)))) :kind 2) :parent-type #S(sb-impl::comma :expr parent-type :kind 0) :visible (not #S(sb-impl::comma :expr invisible :kind 0)) :formatter-initial-values (lambda nil (list* #S(sb-impl::comma :expr (mapcar (function (lambda (e) (sb-int:quasiquote (cons (quote #S(sb-impl::comma :expr (car e) :kind 0)) #S(sb-impl::comma :expr (second e) :kind 0))))) formatter-variables) :kind 2) (if #S(sb-impl::comma :expr parent-type :kind 0) (funcall (coloring-type-formatter-initial-values #S(sb-impl::comma :expr parent-type :kind 0))) nil))) :formatter-after-hook (lambda nil (symbol-macrolet #S(sb-impl::comma :expr (mapcar (function (lambda (e) (sb-int:quasiquote (#S(sb-impl::comma :expr (car e) :kind 0) (cdr (assoc (quote #S(sb-impl::comma :expr (car e) :kind 0)) *formatter-local-variables*)))))) formatter-variables) :kind 0) (concatenate (quote string) (funcall #S(sb-impl::comma :expr formatter-after-hook :kind 0)) (if #S(sb-impl::comma :expr parent-type :kind 0) (funcall (coloring-type-formatter-after-hook #S(sb-impl::comma :expr parent-type :kind 0))) "")))) :term-formatter (symbol-macrolet #S(sb-impl::comma :expr (mapcar (function (lambda (e) (sb-int:quasiquote (#S(sb-impl::comma :expr (car e) :kind 0) (cdr (assoc (quote #S(sb-impl::comma :expr (car e) :kind 0)) *formatter-local-variables*)))))) formatter-variables) :kind 0) (lambda (#S(sb-impl::comma :expr term :kind 0)) (labels ((call-parent-formatter (&optional (#S(sb-impl::comma :expr type :kind 0) (car #S(sb-impl::comma :expr term :kind 0))) (#S(sb-impl::comma :expr string :kind 0) (cdr #S(sb-impl::comma :expr term :kind 0)))) (if #S(sb-impl::comma :expr parent-type :kind 0) (funcall (coloring-type-term-formatter #S(sb-impl::comma :expr parent-type :kind 0)) (cons #S(sb-impl::comma :expr type :kind 0) #S(sb-impl::comma :expr string :kind 0))))) (call-formatter (&optional (#S(sb-impl::comma :expr type :kind 0) (car #S(sb-impl::comma :expr term :kind 0))) (#S(sb-impl::comma :expr string :kind 0) (cdr #S(sb-impl::comma :expr term :kind 0)))) (funcall (case (first #S(sb-impl::comma :expr type :kind 0)) #S(sb-impl::comma :expr formatters :kind 2) (t (lambda (#S(sb-impl::comma :expr type :kind 0) text) (call-parent-formatter #S(sb-impl::comma :expr type :kind 0) text)))) #S(sb-impl::comma :expr type :kind 0) #S(sb-impl::comma :expr string :kind 0)))) (call-formatter)))) :transition-functions (list #S(sb-impl::comma :expr (loop for transition in transitions collect (destructuring-bind (mode &rest table) transition (sb-int:quasiquote (cons (quote #S(sb-impl::comma :expr mode :kind 0)) (lambda (#S(sb-impl::comma :expr current-mode :kind 0) #S(sb-impl::comma :expr string :kind 0) #S(sb-impl::comma :expr position :kind 0)) (let ((#S(sb-impl::comma :expr mode-wait :kind 0) (constantly nil)) (#S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr position :kind 0))) (with-scanning-functions #S(sb-impl::comma :expr string :kind 0) #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr current-mode :kind 0) #S(sb-impl::comma :expr mode-wait :kind 0) (let ((*reset-position* #S(sb-impl::comma :expr position :kind 0))) (cond #S(sb-impl::comma :expr table :kind 2))) (values #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr current-mode :kind 0) (lambda (#S(sb-impl::comma :expr new-position :kind 0)) (setf #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr new-position :kind 0)) (let ((#S(sb-impl::comma :expr advance :kind 0) (nth-value 1 (funcall #S(sb-impl::comma :expr mode-wait :kind 0) #S(sb-impl::comma :expr position-foobage :kind 0))))) (values #S(sb-impl::comma :expr position-foobage :kind 0) #S(sb-impl::comma :expr advance :kind 0)))))))))))) :kind 2)))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(defannotation ignore* (vars) (:alias ignore :inline t) "Shorthand for (DECLARE (IGNORE ...))." (%declare-list-or-symbol vars 'ignore))

Problem: Macro call that should be transformed by defannotation

(defannotation ignore* (vars) (:alias ignore :inline t) "Shorthand for (DECLARE (IGNORE ...))." (%declare-list-or-symbol vars 'ignore))

[Assistant]
(defmacro defannotation (name lambda-list options &body body)
  `(progn
     (set-annotation-options ',name ',options)
     (defmacro ,name ,lambda-list ,@body)))

;; macroexpand:
(progn (set-annotation-options (quote ignore*) (quote (:alias ignore :inline t))) (defmacro ignore* (vars) "Shorthand for (DECLARE (IGNORE ...))." (%declare-list-or-symbol vars (quote ignore))))


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

Problem: Macro call that should be transformed by DRELETF*

(dreletf* nil
  nil)

[Assistant]
(defmacro DRELETF* ...)

;; macroexpand:
(progn nil)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(signal-syntax-error "Too much choices in branch: ~S." parse-tree)

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

(signal-syntax-error "Too much choices in branch: ~S." parse-tree)

[Assistant]
(defmacro signal-syntax-error (format-control &rest format-arguments)
  `(signal-syntax-error* nil ,format-control ,@format-arguments))

;; macroexpand:
(signal-syntax-error* nil "Too much choices in branch: ~S." parse-tree)


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

Problem: Macro call that should be transformed by Ψ

(ψ nil nil)

[Assistant]
(defmacro Ψ ...)

;; macroexpand:
(mapcar (λ nil) nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(with-yield (dolist (x data) (yield x)))

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

(with-yield (dolist (x data) (yield x)))

[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 (#:g139 #:g140) (with-call/cc (labels ((yield (&rest values) (setf #:g140 values) (let/cc k (setf #:g139 k)))) (dolist (x data) (yield x)) (setf #:g139 nil))) (gen-lambda nil (cond ((null #:g139) (quote generator-stop)) (t (let ((current #:g140)) (funcall #:g139 nil) (apply (function values) (funcall values-handler current)))))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(ensure-getf options :special special)

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

(ensure-getf options :special special)

[Assistant]
(defmacro ensure-getf (place key &optional default)
  (once-only (key default)
    `(setf (getf ,place ,key) (getf ,place ,key ,default))))

;; macroexpand:
(let ((#:key177 :special) (#:default178 special)) (setf (getf options #:key177) (getf options #:key177 #:default178)))


[User]
Define a macro that eliminates this repetitive pattern:
(sif (car x) (setf it :oops) (setf it :yes!))

Issue: Macro call that should be transformed by sif

(sif (car x) (setf it :oops) (setf it :yes!))

[Assistant]
(defmacro sif (test then &optional else)
  "Like IF, except binds the test form to IT (via SYMBOL-MACROLET) for
the scope of the then and else expressions. IT can be set with SETF"
  `(symbolic if ,test ,then ,else))

;; macroexpand:
(symbolic if (car x) (setf it :oops) (setf it :yes!))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(draw scene (:rect :x 75 :y 75 :height 30 :width 30) :fill "purple")

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

(draw scene (:rect :x 75 :y 75 :height 30 :width 30) :fill "purple")

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

;; macroexpand:
(let ((#:g144 (funcall (function make-svg-element) :rect (append (list :x 75 :y 75 :height 30 :width 30) (list :fill "purple"))))) (add-element scene #:g144) #:g144)


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

What needs to change: Macro call that should be transformed by WITHOUT-DEPENDENCY-CAPTURE

(without-dependency-capture
  nil
  nil)

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

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


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

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

(list-of nil
  :key
  nil)

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(do-sequences! ((item1 seq1 :start start1 :end end1) (item2 seq2 :start start2 :end end2)) (setf item1 item2))

Problem: Macro call that should be transformed by do-sequences!

(do-sequences! ((item1 seq1 :start start1 :end end1) (item2 seq2 :start start2 :end end2)) (setf item1 item2))

[Assistant]
(defmacro do-sequences! (name/seqs &body forms &environment env)
  "Mutable version of DO-SEQUENCES.

   This is the same as DO-SEQUENCES however each NAME, is the name of
   a symbol-macro, that is introduced, which expands to the 'place',
   suitable for use with SETF, of the current sequence element, rather
   than a variable storing its value. This allows the elements of the
   sequence to be mutated.

   NOTE: This macro does not support destructuring of the sequence
   elements."

  (let-if ((name name/seqs)
           (seqs (first forms) name/seqs)
           (forms (rest forms) forms))
      (symbolp name/seqs)

    (let ((safety (cadr (assoc 'safety (declaration-information 'optimize env)))))
      `(,(if (> safety 2)
             'do-sequences!-safe%
             'do-sequences!-fast%)

         ,name
         ,seqs
         ,@forms))))

;; macroexpand:
(do-sequences!-fast% nil ((item1 seq1 :start start1 :end end1) (item2 seq2 :start start2 :end end2)) (setf item1 item2))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(alist-bind (type width) form `(,@(parse-type type (aval :tag type)) :bitfield-p t :bit-width ,width))

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

(alist-bind (type width) form `(,@(parse-type type (aval :tag type)) :bitfield-p t :bit-width ,width))

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

;; macroexpand:
(let ((#:alist237 form)) (let ((type (aval :type #:alist237)) (width (aval :width #:alist237))) (sb-int:quasiquote (#S(sb-impl::comma :expr (parse-type type (aval :tag type)) :kind 2) :bitfield-p t :bit-width #S(sb-impl::comma :expr width :kind 0)))))


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

Issue: Macro call that should be transformed by INCF

(incf nil (progn))

[Assistant]
(defmacro INCF ...)

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


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

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

(defsynonym in :in)

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

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


[User]
You are a Common Lisp macro expert. Given this code pattern:
(unwind-protect-case () (random 10) (:normal (push :normal result)) (:abort (push :abort result)) (:always (push :always result)))

Write a macro that addresses: Macro call that should be transformed by unwind-protect-case

(unwind-protect-case () (random 10) (:normal (push :normal result)) (:abort (push :abort result)) (:always (push :always result)))

[Assistant]
(defmacro unwind-protect-case ((&optional abort-flag) protected-form &body clauses)
  "Like CL:UNWIND-PROTECT, but you can specify the circumstances that
the cleanup CLAUSES are run.

  clauses ::= (:NORMAL form*)* | (:ABORT form*)* | (:ALWAYS form*)*

Clauses can be given in any order, and more than one clause can be
given for each circumstance. The clauses whose denoted circumstance
occured, are executed in the order the clauses appear.

ABORT-FLAG is the name of a variable that will be bound to T in
CLAUSES if the PROTECTED-FORM aborted preemptively, and to NIL
otherwise.

Examples:

  (unwind-protect-case ()
       (protected-form)
     (:normal (format t \"This is only evaluated if PROTECTED-FORM executed normally.~%\"))
     (:abort  (format t \"This is only evaluated if PROTECTED-FORM aborted preemptively.~%\"))
     (:always (format t \"This is evaluated in either case.~%\")))

  (unwind-protect-case (aborted-p)
       (protected-form)
     (:always (perform-cleanup-if aborted-p)))
"
  (check-type abort-flag (or null symbol))
  (let ((gflag (gensym "FLAG+")))
    `(let ((,gflag t))
       (unwind-protect (multiple-value-prog1 ,protected-form (setf ,gflag nil))
	 (let ,(and abort-flag `((,abort-flag ,gflag)))
	   ,@(loop for (cleanup-kind . forms) in clauses
		   collect (ecase cleanup-kind
			     (:normal `(when (not ,gflag) ,@forms))
			     (:abort  `(when ,gflag ,@forms))
			     (:always `(progn ,@forms)))))))))

;; macroexpand:
(let ((#:flag+123 t)) (unwind-protect (multiple-value-prog1 (random 10) (setf #:flag+123 nil)) (let nil (when (not #:flag+123) (push :normal result)) (when #:flag+123 (push :abort result)) (progn (push :always result)))))


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

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

(-<> 'some-name)

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

;; macroexpand:
'some-name


[User]
You are a Common Lisp macro expert. Given this code pattern:
(form &key key &aux (result NIL))

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

(form &key key &aux (result NIL))

[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 &key key &aux (result nil))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(yield-all generator)

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

(yield-all generator)

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

;; macroexpand:
(do-generator (#:g183 generator) (yield #:g183))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(lret* ((element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec) (fill out pad :start (length vec)) out)

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

(lret* ((element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec) (fill out pad :start (length vec)) out)

[Assistant]
(defmacro lret* ((&rest bindings) &body body)
  "Cf. `lret'."
  `(lret-aux let* ,bindings
     ,@body))

;; macroexpand:
(lret-aux let* ((element-type (array-element-type vec)) (out (make-array length :element-type element-type))) (replace out vec) (fill out pad :start (length vec)) out)


[User]
Write a Common Lisp macro to handle this code pattern:
(in-compile-time nil
  (progn))

Problem: Macro call that should be transformed by IN-COMPILE-TIME

(in-compile-time nil
  (progn))

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

;; macroexpand:
(macrolet ((#:macro143 (&environment ())
             (progn)))
  (#:macro143))


[User]
Generate a defmacro form that transforms code like this:
(with-output-to-file (file-stream pathname :if-exists if-exists :if-does-not-exist if-does-not-exist :external-format external-format) (write-sequence string file-stream))

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

(with-output-to-file (file-stream pathname :if-exists if-exists :if-does-not-exist if-does-not-exist :external-format external-format) (write-sequence string file-stream))

[Assistant]
(defmacro with-output-to-file ((stream-name file-name &rest args
                                            &key (direction nil direction-p)
                                            &allow-other-keys)
			       &body body)
  "Evaluate BODY with STREAM-NAME to an output stream on the file
FILE-NAME. ARGS is sent as is to the call to OPEN except EXTERNAL-FORMAT,
which is only sent to WITH-OPEN-FILE when it's not NIL."
  (declare (ignore direction))
  (when direction-p
    (error "Can't specify :DIRECTION for WITH-OUTPUT-TO-FILE."))
  `(with-open-file* (,stream-name ,file-name :direction :output ,@args)
     ,@body))

;; macroexpand:
(with-open-file* (file-stream pathname :direction :output :if-exists if-exists :if-does-not-exist if-does-not-exist :external-format external-format) (write-sequence string file-stream))


[User]
Generate a defmacro form that transforms code like this:
(>> (loop repeat 5 collecting (-> :p (a) (declare (type fixnum a)) (the fixnum (1+ a)))))

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

(>> (loop repeat 5 collecting (-> :p (a) (declare (type fixnum a)) (the fixnum (1+ a)))))

[Assistant]
(defmacro >> (&rest flow)
  "See flow:serially"
  `(serially ,@flow))

;; macroexpand:
(serially (loop repeat 5 collecting (-> :p (a) (declare (type fixnum a)) (the fixnum (1+ a)))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(>> (-> :p () 1) (-> :p (a) (+ a 1)) (-> :p (v) (setf result v) (mt:open-latch latch)))

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

(>> (-> :p () 1) (-> :p (a) (+ a 1)) (-> :p (v) (setf result v) (mt:open-latch latch)))

[Assistant]
(defmacro >> (&rest flow)
  "See flow:serially"
  `(serially ,@flow))

;; macroexpand:
(serially (-> :p nil 1) (-> :p (a) (+ a 1)) (-> :p (v) (setf result v) (cl-muth:open-latch latch)))


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

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

(define-op (:a> infix-op :sql-op-name "@>"))

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


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

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

(lambda-coro
  nil
  :key
  nil)

[Assistant]
(defmacro LAMBDA-CORO ...)

;; macroexpand:
(progn
 (defcoroutine #:name131
     (#:arg132)
   (macrolet ((yield (form)
                (let ((g!-it (gensym "IT")))
                  `(progn
                    (let ((,g!-it ,form))
                      (cl-coroutine:yield ,g!-it))
                    ,'#:arg132)))
              (last-yield-value ()
                '#:arg132))
     nil
     :key
     nil
     (coexit!)))
 (make-coroutine '#:name131))


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

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

(some->> nil)

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

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


[User]
Write a Common Lisp macro to handle this code pattern:
(signal-syntax-error "Illegal back-reference: ~S." parse-tree)

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

(signal-syntax-error "Illegal back-reference: ~S." parse-tree)

[Assistant]
(defmacro signal-syntax-error (format-control &rest format-arguments)
  `(signal-syntax-error* nil ,format-control ,@format-arguments))

;; macroexpand:
(signal-syntax-error* nil "Illegal back-reference: ~S." parse-tree)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(mvlet* ((left-cases right-cases (halves cases)) (split (caar right-cases))) `(if (< ,keyform ,split) ,(rec keyform left-cases) ,(rec keyform right-cases)))

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

(mvlet* ((left-cases right-cases (halves cases)) (split (caar right-cases))) `(if (< ,keyform ,split) ,(rec keyform left-cases) ,(rec keyform right-cases)))

[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:
(multiple-value-bind (left-cases right-cases) (halves cases) (mvlet* ((split (caar right-cases))) (sb-int:quasiquote (if (< #S(sb-impl::comma :expr keyform :kind 0) #S(sb-impl::comma :expr split :kind 0)) #S(sb-impl::comma :expr (rec keyform left-cases) :kind 0) #S(sb-impl::comma :expr (rec keyform right-cases) :kind 0)))))


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

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

(-<> nil)

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

;; macroexpand:
nil


[User]
Define a macro that eliminates this repetitive pattern:
(flow-lambda-macro (flow-context) (let ((fu-body `((flet ((continue-flow (&optional ,continue-arg) (capture-flow-value ,flow-context ,continue-arg) (dispatch-rest ,flow-context)) (interrupt-flow (&optional ,condi) (error ,condi))) (declare (ignorable (function continue-flow) (function interrupt-flow))) ,@body)))) (with-flow-function-macro (body-fu lambda-list fu-body) `(dispatch-asynchronously ,flow-context #',body-fu))))

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

(flow-lambda-macro (flow-context) (let ((fu-body `((flet ((continue-flow (&optional ,continue-arg) (capture-flow-value ,flow-context ,continue-arg) (dispatch-rest ,flow-context)) (interrupt-flow (&optional ,condi) (error ,condi))) (declare (ignorable (function continue-flow) (function interrupt-flow))) ,@body)))) (with-flow-function-macro (body-fu lambda-list fu-body) `(dispatch-asynchronously ,flow-context #',body-fu))))

[Assistant]
(defmacro flow-lambda-macro ((flow-context) &body body)
  `(with-gensyms (,flow-context)
     `(%flow-lambda (,,flow-context)
        ,,@body)))

;; macroexpand:
(with-gensyms (flow-context) (sb-int:quasiquote (%flow-lambda (#S(sb-impl::comma :expr flow-context :kind 0)) #S(sb-impl::comma :expr (let ((fu-body (sb-int:quasiquote ((flet ((continue-flow (&optional #S(sb-impl::comma :expr continue-arg :kind 0)) (capture-flow-value #S(sb-impl::comma :expr flow-context :kind 0) #S(sb-impl::comma :expr continue-arg :kind 0)) (dispatch-rest #S(sb-impl::comma :expr flow-context :kind 0))) (interrupt-flow (&optional #S(sb-impl::comma :expr condi :kind 0)) (error #S(sb-impl::comma :expr condi :kind 0)))) (declare (ignorable (function continue-flow) (function interrupt-flow))) #S(sb-impl::comma :expr body :kind 2)))))) (with-flow-function-macro (body-fu lambda-list fu-body) (sb-int:quasiquote (dispatch-asynchronously #S(sb-impl::comma :expr flow-context :kind 0) (function #S(sb-impl::comma :expr body-fu :kind 0)))))) :kind 0))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(define-dispatch dispatch-for-+ (args specific-hooks) (reduce #'+ (mapcar (lambda (f) (apply f args)) specific-hooks)))

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

(define-dispatch dispatch-for-+ (args specific-hooks) (reduce #'+ (mapcar (lambda (f) (apply f args)) specific-hooks)))

[Assistant]
(defmacro define-dispatch (name lambda-list &body body)
  "the lambda list should accept two arguments:
the list of arguments given by the current method call.
the specific hooks (as named or unamed functions) for the qualified method (that we will be dispatching from).

you should then use the arguments to dispatch the specific hooks as you wish in the body.
if the body returns a result, by default the method will also return that result, this can be overriden with finalize-dispatch-method.

See finalize-dispatch-method
See dispatch"
  `(let ((new-dispatch (make-dispatcher (lambda ,lambda-list ,@body))))
     (setf (gethash ',name *dispatch-table*)
           new-dispatch)))

;; macroexpand:
(let ((new-dispatch (make-dispatcher (lambda (args specific-hooks) (reduce (function +) (mapcar (lambda (f) (apply f args)) specific-hooks)))))) (setf (gethash (quote dispatch-for-+) *dispatch-table*) new-dispatch))


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

Problem: Macro call that should be transformed by WITH-READER-CASE

(with-reader-case nil
  :key
  nil)

[Assistant]
(defmacro WITH-READER-CASE ...)

;; macroexpand:
(let ()
  (let ((#:previous-case181 (readtable-case *readtable*)))
    (setf (readtable-case *readtable*) nil)
    (unwind-protect (progn :key nil)
      (setf (readtable-case *readtable*) #:previous-case181))))


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

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

(some-<>
  nil
  (progn))

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

;; macroexpand:
(let* ((#:var178 nil)
       (#:var179
        (if #:var178
            (progn #:var178)
            nil)))
  #:var179)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(draw scene (:use :xlink-href (xlink-href columns)) :x (- (random 750) 25) :y (- (random 700) 25) :height size :width size :stroke "rgb(232, 229, 148)" :stroke-width 0.3 :fill (one-of *sandy-test-colors*))

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

(draw scene (:use :xlink-href (xlink-href columns)) :x (- (random 750) 25) :y (- (random 700) 25) :height size :width size :stroke "rgb(232, 229, 148)" :stroke-width 0.3 :fill (one-of *sandy-test-colors*))

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

;; macroexpand:
(let ((#:g148 (funcall (function make-svg-element) :use (append (list :xlink-href (xlink-href columns)) (list :x (- (random 750) 25) :y (- (random 700) 25) :height size :width size :stroke "rgb(232, 229, 148)" :stroke-width 0.3 :fill (one-of *sandy-test-colors*)))))) (add-element scene #:g148) #:g148)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(quasiquote-expand-1 'list (append (butlast x) (mapcar 'kwote (and last (single-arg (car last))))))

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

(quasiquote-expand-1 'list (append (butlast x) (mapcar 'kwote (and last (single-arg (car last))))))

[Assistant]
(defmacro quasiquote (x) (quasiquote-expand x))

;; macroexpand:
(quasiquote-expand-1 (quote list) (append (butlast x) (mapcar (quote kwote) (and last (single-arg (car last))))))


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

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

(some->> 'some-name)

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

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


[User]
Generate a defmacro form that transforms code like this:
(define-value-binding repeating ((var 0) limit) (declare (type (integer 0) var limit)) `(when (< ,limit (incf ,var)) (end-for)))

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

(define-value-binding repeating ((var 0) limit) (declare (type (integer 0) var limit)) `(when (< ,limit (incf ,var)) (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 repeating (var limit) (let ((#:limit178 (gensym #A((5) base-char . "LIMIT")))) (values* (sb-int:quasiquote (with-interleaving (let* #S(sb-impl::comma :expr (list* (list #:limit178 limit) (loop for #:var177 in (lambda-fiddle:extract-lambda-vars (enlist var)) collect (list #:var177 0))) :kind 0) (declare (ignorable #S(sb-impl::comma :expr #:limit178 :kind 0))) #S(sb-impl::comma :expr (sb-int:quasiquote (declare (type #S(sb-impl::comma :expr (quote (integer 0)) :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 (integer 0)) :kind 0) #S(sb-impl::comma :expr #:limit178 :kind 0)))) :kind 0)) #S(sb-impl::comma :expr nil :kind 0))) (let ((limit #:limit178)) (declare (ignorable limit)) (sb-int:quasiquote (when (< #S(sb-impl::comma :expr limit :kind 0) (incf #S(sb-impl::comma :expr var :kind 0))) (end-for)))))))


[User]
Write a Common Lisp macro to handle this code pattern:
(define-simple-documentation-lookup compiler-macro cl:compiler-macro)

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

(define-simple-documentation-lookup compiler-macro cl:compiler-macro)

[Assistant]
(defmacro define-simple-documentation-lookup (class documentation-type)
  `(defmethod documentation ((,class ,class))
     ,(if (eql documentation-type T)
          `(cl:documentation (object ,class) 'T)
          `(cl:documentation (designator ,class) ',documentation-type))))

;; macroexpand:
(defmethod documentation ((compiler-macro compiler-macro)) (common-lisp:documentation (designator compiler-macro) (quote common-lisp:compiler-macro)))


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

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

(inext nil)

[Assistant]
(defmacro INEXT ...)

;; macroexpand:
(let ((vals (multiple-value-list (funcall (i-coro nil) nil))))
  (if (not vals)
      (coexit!)
      (car vals)))


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

Issue: Macro call that should be transformed by PS-PACKAGE-PREFIX

(ps-package-prefix 'some-name)

[Assistant]
(defmacro PS-PACKAGE-PREFIX ...)

;; macroexpand:
(gethash (find-package 'some-name) *package-prefix-table*)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(builder (:session :store (make-redis-store :namespace *namespace* :connection *connection*)) (lambda (env) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) `(200 (:content-type "text/plain") (,(format nil "Hello, you've been here for ~Ath times!" (incf (gethash :counter (getf env :lack.session))))))))

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

(builder (:session :store (make-redis-store :namespace *namespace* :connection *connection*)) (lambda (env) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) `(200 (:content-type "text/plain") (,(format nil "Hello, you've been here for ~Ath times!" (incf (gethash :counter (getf env :lack.session))))))))

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

;; macroexpand:
(reduce (function funcall) (remove-if (function null) (list (lambda (#:app238) (funcall (find-middleware :session) #:app238 :store (make-redis-store :namespace *namespace* :connection *connection*))))) :initial-value (to-app (lambda (env) (unless (gethash :counter (getf env :lack.session)) (setf (gethash :counter (getf env :lack.session)) 0)) (sb-int:quasiquote (200 (:content-type "text/plain") (#S(sb-impl::comma :expr (format nil "Hello, you've been here for ~Ath times!" (incf (gethash :counter (getf env :lack.session)))) :kind 0)))))) :from-end t)


[User]
You are a Common Lisp macro expert. Given this code pattern:
(signal-syntax-error "No choices in branch: ~S." parse-tree)

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

(signal-syntax-error "No choices in branch: ~S." parse-tree)

[Assistant]
(defmacro signal-syntax-error (format-control &rest format-arguments)
  `(signal-syntax-error* nil ,format-control ,@format-arguments))

;; macroexpand:
(signal-syntax-error* nil "No choices in branch: ~S." parse-tree)


[User]
Write a Common Lisp macro to handle this code pattern:
(-> :g (value) (put value) (error 'skipping-condition))

Problem: Macro call that should be transformed by ->

(-> :g (value) (put value) (error 'skipping-condition))

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

;; macroexpand:
(atomically :g (value) (put value) (error (quote skipping-condition)))


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

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

(as-> nil :key nil)

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

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


[User]
Define a macro that eliminates this repetitive pattern:
(make-float-converters encode-float32 decode-float32 8 23 nil)

Issue: Macro call that should be transformed by make-float-converters

(make-float-converters encode-float32 decode-float32 8 23 nil)

[Assistant]
(defmacro make-float-converters (encoder-name
                                 decoder-name
                                 exponent-bits
                                 significand-bits
                                 support-nan-and-infinity-p)
  "Writes an encoder and decoder function for floating point
numbers with the given amount of exponent and significand
bits (plus an extra sign bit). If support-nan-and-infinity-p is
true, the decoders will also understand these special cases. NaN
is represented as :not-a-number, and the infinities as
:positive-infinity and :negative-infinity. Note that this means
that the in- or output of these functions is not just floating
point numbers anymore, but also keywords."
  (let* ((total-bits (+ 1 exponent-bits significand-bits))
         (exponent-offset (1- (expt 2 (1- exponent-bits)))) ; (A)
         (sign-part `(ldb (byte 1 ,(1- total-bits)) bits))
         (exponent-part `(ldb (byte ,exponent-bits ,significand-bits) bits))
         (significand-part `(ldb (byte ,significand-bits 0) bits))
         (nan support-nan-and-infinity-p)
         (max-exponent (1- (expt 2 exponent-bits)))) ; (B)
    `(progn
       (defun ,encoder-name (float)
         ,@(unless nan `((declare (type float float))))
         (multiple-value-bind (sign significand exponent)
             (cond ,@(when nan `(((eq float :not-a-number)
                                  (values 0 1 ,max-exponent))
                                 ((eq float :positive-infinity)
                                  (values 0 0 ,max-exponent))
                                 ((eq float :negative-infinity)
                                  (values 1 0 ,max-exponent))))
                   ((zerop float)
                    (values 0 0 0))
                   (t
                    (multiple-value-bind (significand exponent sign)
                        (decode-float float)
                      (let ((exponent (+ (1- exponent) ,exponent-offset))
                            (sign (if (= sign 1.0) 0 1)))
                        (unless (< exponent ,(expt 2 exponent-bits))
                          (error "Floating point overflow when encoding ~A."
                                 float))
                        (if (< exponent 0) ; (C)
                            (values sign (ash (round (* ,(expt 2 significand-bits)
                                                        significand))
                                              exponent)
                                    0)
                            (values sign (round (* ,(expt 2 significand-bits)
                                                   (1- (* significand 2))))
                                    exponent))))))
           (let ((bits 0))
             (declare (type (unsigned-byte ,total-bits) bits))
             (setf ,sign-part sign
                   ,exponent-part exponent
                   ,significand-part significand)
             bits)))

       (defun ,decoder-name (bits)
         (declare (type (unsigned-byte ,total-bits) bits))
         (let* ((sign ,sign-part)
                (exponent ,exponent-part)
                (significand ,significand-part))
           ,@(when nan `((when (= exponent ,max-exponent)
                           (return-from ,decoder-name
                             (cond ((not (zerop significand)) :not-a-number)
                                   ((zerop sign) :positive-infinity)
                                   (t :negative-infinity))))))
           (if (zerop exponent) ; (D)
               (setf exponent 1)
               (setf (ldb (byte 1 ,significand-bits) significand) 1))
           (unless (zerop sign)
             (setf significand (- significand)))
           (scale-float (float significand ,(if (> total-bits 32) 1.0d0 1.0))
                        (- exponent ,(+ exponent-offset significand-bits))))))))

;; macroexpand:
(progn (defun encode-float32 (float) (declare (type float float)) (multiple-value-bind (sign significand exponent) (cond ((zerop float) (values 0 0 0)) (t (multiple-value-bind (significand exponent sign) (decode-float float) (let ((exponent (+ (1- exponent) 127)) (sign (if (= sign 1.0) 0 1))) (unless (< exponent 256) (error "Floating point overflow when encoding ~A." float)) (if (< exponent 0) (values sign (ash (round (* 8388608 significand)) exponent) 0) (values sign (round (* 8388608 (1- (* significand 2)))) exponent)))))) (let ((bits 0)) (declare (type (unsigned-byte 32) bits)) (setf (ldb (byte 1 31) bits) sign (ldb (byte 8 23) bits) exponent (ldb (byte 23 0) bits) significand) bits))) (defun decode-float32 (bits) (declare (type (unsigned-byte 32) bits)) (let* ((sign (ldb (byte 1 31) bits)) (exponent (ldb (byte 8 23) bits)) (significand (ldb (byte 23 0) bits))) (if (zerop exponent) (setf exponent 1) (setf (ldb (byte 1 23) significand) 1)) (unless (zerop sign) (setf significand (- significand))) (scale-float (float significand 1.0) (- exponent 150)))))


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

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

(iterate
  nil
  :key
  nil)

[Assistant]
(defmacro ITERATE ...)

;; macroexpand:
(iter
  nil
  :key
  nil)


[User]
Create a Common Lisp macro for the following transformation. Before code:
(do-notation bind-maybe ((sum (inc-maybe 1)) (str (maybe->string sum))) str)

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

(do-notation bind-maybe ((sum (inc-maybe 1)) (str (maybe->string sum))) str)

[Assistant]
(defmacro do-notation (bind-function expressions &body body)
  "Given a BIND-FUNCTION and all the bind expressions, evaluate BODY."
  `(progn
     ,@(reduce (lambda (acc do-binding)
		 (append `((,bind-function (lambda (,(car do-binding)) ,@acc)
					   ,@(cdr do-binding)))))
	       (reverse expressions)
	       :initial-value body)))

;; macroexpand:
(progn (bind-maybe (lambda (sum) (bind-maybe (lambda (str) str) (maybe->string sum))) (inc-maybe 1)))


[User]
Define a macro that eliminates this repetitive pattern:
(c-assert (listp (kid-values self)))

Issue: Macro call that should be transformed by c-assert

(c-assert (listp (kid-values 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 (listp (kid-values self)) (c-break "failed assertion: ~a" (quote (listp (kid-values self))))))


[User]
You are a Common Lisp macro expert. Given this code pattern:
(define-condition deprecation-warning (style-warning) ((name :initarg :name :reader deprecated-name) (replacements :initarg :replacement :reader deprecated-name-replacement) (since :initarg :since :reader deprecated-since)) (:report (lambda (condition stream) (format stream "~S is deprecated since CL-MUSTACHE version ~A. ~ Use ~S instead." (deprecated-name condition) (deprecated-since condition) (deprecated-name-replacement condition)))))

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

(define-condition deprecation-warning (style-warning) ((name :initarg :name :reader deprecated-name) (replacements :initarg :replacement :reader deprecated-name-replacement) (since :initarg :since :reader deprecated-since)) (:report (lambda (condition stream) (format stream "~S is deprecated since CL-MUSTACHE version ~A. ~ Use ~S instead." (deprecated-name condition) (deprecated-since condition) (deprecated-name-replacement condition)))))

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

;; macroexpand:
(progn (sb-kernel::%define-condition (quote deprecation-warning) (quote (style-warning)) (sb-kernel::find-condition-layout (quote deprecation-warning) (quote (style-warning))) (list (sb-kernel::make-condition-slot :name (quote name) :initargs (quote (:name)) :readers (quote (deprecated-name)) :writers (quote nil) :initform-p (quote nil) :documentation (quote nil) :initform nil :initfunction nil :allocation (quote :instance)) (sb-kernel::make-condition-slot :name (quote replacements) :initargs (quote (:replacement)) :readers (quote (deprecated-name-replacement)) :writers (quote nil) :initform-p (quote nil) :documentation (quote nil) :initform nil :initfunction nil :allocation (quote :instance)) (sb-kernel::make-condition-slot :name (quote since) :initargs (quote (:since)) :readers (quote (deprecated-since)) :writers (quote nil) :initform-p (quote nil) :documentation (quote nil) :initform nil :initfunction nil :allocation (quote :instance))) (list) (quote (deprecated-since deprecated-name-replacement deprecated-name)) (quote nil) (sb-c:source-location)) (sb-kernel::%set-condition-report (quote deprecation-warning) (function (sb-int:named-lambda (sb-kernel::condition-report deprecation-warning) (condition stream) (declare (type condition condition) (type stream stream)) (funcall (function (lambda (condition stream) (format stream "~S is deprecated since CL-MUSTACHE version ~A. ~ Use ~S instead." (deprecated-name condition) (deprecated-since condition) (deprecated-name-replacement condition)))) condition stream)))) (quote deprecation-warning))


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

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

(*let nil)

[Assistant]
(defmacro *LET ...)

;; macroexpand:
(let* ())


[User]
Define a macro that eliminates this repetitive pattern:
(lret* ((type `(integer ,start (,end))) (len (- end start)) (vector (make-array len :element-type type))) (nlet lp ((i 0) (n start)) (declare (type array-index i n)) (if (= i len) vector (progn (setf (aref vector i) n) (lp (1+ i) (1+ n))))))

Issue: Macro call that should be transformed by lret

(lret* ((type `(integer ,start (,end))) (len (- end start)) (vector (make-array len :element-type type))) (nlet lp ((i 0) (n start)) (declare (type array-index i n)) (if (= i len) vector (progn (setf (aref vector i) n) (lp (1+ i) (1+ n))))))

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

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

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

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

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

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

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

;; macroexpand:
(lret-aux let* ((type (sb-int:quasiquote (integer #S(sb-impl::comma :expr start :kind 0) (#S(sb-impl::comma :expr end :kind 0))))) (len (- end start)) (vector (make-array len :element-type type))) (nlet lp ((i 0) (n start)) (declare (type array-index i n)) (if (= i len) vector (progn (setf (aref vector i) n) (lp (1+ i) (1+ n))))))


[User]
Define a macro that eliminates this repetitive pattern:
(deferror "57P01" admin-shutdown server-shutdown)

Issue: Macro call that should be transformed by deferror

(deferror "57P01" admin-shutdown server-shutdown)

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

;; macroexpand:
(progn (define-condition admin-shutdown (server-shutdown) nil) (setf (gethash "57P01" *error-table*) (quote admin-shutdown)))


[User]
Define a macro that eliminates this repetitive pattern:
(is (some #'test-failure-p results))

Issue: Macro call that should be transformed by is

(is (some #'test-failure-p results))

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

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

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

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

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

;; macroexpand:
(let ((#:e232 (function test-failure-p)) (#:a233 results)) (if (progn (some #:e232 #:a233)) (add-result (quote test-passed) :test-expr (quote (some (function test-failure-p) results))) (process-failure (quote (some (function test-failure-p) results)) "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%" (quote results) #:a233 (quote some) #:e232)))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(do-subclasses (ctype content) (publish ctype))

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

(do-subclasses (ctype content) (publish ctype))

[Assistant]
(defmacro do-subclasses ((var class) &body body)
  "Iterate over the subclasses of CLASS performing BODY with VAR
lexically bound to the current subclass."
  (alexandria:with-gensyms (klasses)
    `(let ((,klasses (all-subclasses (find-class ',class))))
       (loop for ,var in ,klasses do ,@body))))

;; macroexpand:
(let ((#:klasses285 (all-subclasses (find-class (quote content))))) (loop for ctype in #:klasses285 do (publish ctype)))


[User]
Generate a defmacro form that transforms code like this:
(do-generator (g list-or-gen) (yield g) (push g accum))

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

(do-generator (g list-or-gen) (yield g) (push g accum))

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

;; macroexpand:
(let ((#:g156 list-or-gen)) (loop do (if-generator ((g) #:g156) (progn (yield g) (push g accum)) (return))))


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

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

(enable-reader-syntax)

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

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


[User]
You are a Common Lisp macro expert. Given this code pattern:
(*> +period+ +digit-chunks+)

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

(*> +period+ +digit-chunks+)

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

;; macroexpand:
(lambda (#:*>-offset245) (multiple-value-bind (#:*>-res246 #:*>-next247) (funcall +period+ #:*>-offset245) (if (ok? #:*>-res246) (funcall +digit-chunks+ #:*>-next247) (fail #:*>-next247))))


[User]
Generate a defmacro form that transforms code like this:
(with-cache ("none" :store storage) (error "SHOULD BE ERROR"))

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

(with-cache ("none" :store storage) (error "SHOULD BE ERROR"))

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

Example:

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

;; macroexpand:
(let ((#:key242 "none") (#:store243 storage) (#:expire244 nil)) (multiple-value-bind (#:value245 #:exists-p246) (getcache #:key242 #:store243) (if #:exists-p246 #:value245 (let ((#:value245 (progn (error "SHOULD BE ERROR")))) (setcache #:key242 #:value245 #:store243 :expire #:expire244) #:value245))))


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

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

(incf nil nil)

[Assistant]
(defmacro INCF ...)

;; macroexpand:
(setq nil (+ nil nil))


[User]
Write a Common Lisp macro to handle this code pattern:
(with-cache ((list x y z)) (if (<= x y) z (tak (tak/with-cache (1- x) y z) (tak/with-cache (1- y) z x) (tak/with-cache (1- z) x y))))

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

(with-cache ((list x y z)) (if (<= x y) z (tak (tak/with-cache (1- x) y z) (tak/with-cache (1- y) z x) (tak/with-cache (1- z) x y))))

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

Example:

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

;; macroexpand:
(let ((#:key227 (list x y z)) (#:store228 nil) (#:expire229 nil)) (multiple-value-bind (#:value230 #:exists-p231) (getcache #:key227 #:store228) (if #:exists-p231 #:value230 (let ((#:value230 (progn (if (<= x y) z (tak (tak/with-cache (1- x) y z) (tak/with-cache (1- y) z x) (tak/with-cache (1- z) x y)))))) (setcache #:key227 #:value230 #:store228 :expire #:expire229) #:value230))))


[User]
Create a Common Lisp macro for the following transformation. Before code:
(signal-syntax-error "Unknown flag token ~A." token)

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

(signal-syntax-error "Unknown flag token ~A." token)

[Assistant]
(defmacro signal-syntax-error (format-control &rest format-arguments)
  `(signal-syntax-error* nil ,format-control ,@format-arguments))

;; macroexpand:
(signal-syntax-error* nil "Unknown flag token ~A." token)